Skip to content

Commit

Permalink
Remove array allocation and local array ffi from the Show instance fo…
Browse files Browse the repository at this point in the history
…r records (#299)

* Don't allocate an array to show a record

* Update changelog

* Simplify the code
  • Loading branch information
ajnsit authored Aug 17, 2022
1 parent f411f34 commit 916e009
Show file tree
Hide file tree
Showing 6 changed files with 28 additions and 32 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ Bugfixes:

Other improvements:
- Documentation: Clarify relationship between `Ord` and `Eq` (#298 by @JamieBallingall)
- Remove array allocation and local array FFI from the `Show` instance for records. (#299 by @ajnsit)

## [v6.0.0](https://github.com/purescript/purescript-prelude/releases/tag/v6.0.0) - 2022-04-27

Expand Down
12 changes: 0 additions & 12 deletions src/Data/Show.js
Original file line number Diff line number Diff line change
Expand Up @@ -57,15 +57,3 @@ export const showArrayImpl = function (f) {
return "[" + ss.join(",") + "]";
};
};

export const cons = function (head) {
return function (tail) {
return [head].concat(tail);
};
};

export const intercalate = function (separator) {
return function (xs) {
return xs.join(separator);
};
};
33 changes: 24 additions & 9 deletions src/Data/Show.purs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,10 @@ module Data.Show
, showRecordFields
) where

import Data.Semigroup ((<>))
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Unit (Unit)
import Data.Void (Void, absurd)
import Prim.Row (class Nub)
import Prim.RowList as RL
import Record.Unsafe (unsafeGet)
Expand All @@ -20,6 +23,9 @@ import Type.Proxy (Proxy(..))
class Show a where
show :: a -> String

instance showUnit :: Show Unit where
show _ = "unit"

instance showBoolean :: Show Boolean where
show true = "true"
show false = "false"
Expand All @@ -42,32 +48,43 @@ instance showArray :: Show a => Show (Array a) where
instance showProxy :: Show (Proxy a) where
show _ = "Proxy"

instance showVoid :: Show Void where
show = absurd

instance showRecord ::
( Nub rs rs
, RL.RowToList rs ls
, ShowRecordFields ls rs
) =>
Show (Record rs) where
show record = case showRecordFields (Proxy :: Proxy ls) record of
[] -> "{}"
fields -> intercalate " " [ "{", intercalate ", " fields, "}" ]
show record = "{" <> showRecordFields (Proxy :: Proxy ls) record <> "}"

-- | A class for records where all fields have `Show` instances, used to
-- | implement the `Show` instance for records.
class ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint
class ShowRecordFields rowlist row where
showRecordFields :: Proxy rowlist -> Record row -> Array String
showRecordFields :: Proxy rowlist -> Record row -> String

instance showRecordFieldsNil :: ShowRecordFields RL.Nil row where
showRecordFields _ _ = []

showRecordFields _ _ = ""
else
instance showRecordFieldsConsNil ::
( IsSymbol key
, Show focus
) =>
ShowRecordFields (RL.Cons key focus RL.Nil) row where
showRecordFields _ record = " " <> key <> ": " <> show focus <> " "
where
key = reflectSymbol (Proxy :: Proxy key)
focus = unsafeGet key record :: focus
else
instance showRecordFieldsCons ::
( IsSymbol key
, ShowRecordFields rowlistTail row
, Show focus
) =>
ShowRecordFields (RL.Cons key focus rowlistTail) row where
showRecordFields _ record = cons (intercalate ": " [ key, show focus ]) tail
showRecordFields _ record = " " <> key <> ": " <> show focus <> "," <> tail
where
key = reflectSymbol (Proxy :: Proxy key)
focus = unsafeGet key record :: focus
Expand All @@ -78,5 +95,3 @@ foreign import showNumberImpl :: Number -> String
foreign import showCharImpl :: Char -> String
foreign import showStringImpl :: String -> String
foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String
foreign import cons :: forall a. a -> Array a -> Array a
foreign import intercalate :: String -> Array String -> String
5 changes: 0 additions & 5 deletions src/Data/Unit.purs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
module Data.Unit where

import Data.Show (class Show)

-- | The `Unit` type has a single inhabitant, called `unit`. It represents
-- | values with no computational content.
-- |
Expand All @@ -14,6 +12,3 @@ foreign import data Unit :: Type

-- | `unit` is the sole inhabitant of the `Unit` type.
foreign import unit :: Unit

instance showUnit :: Show Unit where
show _ = "unit"
5 changes: 0 additions & 5 deletions src/Data/Void.purs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
module Data.Void (Void, absurd) where

import Data.Show (class Show)

-- | An uninhabited data type. In other words, one can never create
-- | a runtime value of type `Void` because no such value exists.
-- |
Expand All @@ -21,9 +19,6 @@ import Data.Show (class Show)
-- | the `void` of C-family languages above.
newtype Void = Void Void

instance showVoid :: Show Void where
show = absurd

-- | Eliminator for the `Void` type.
-- | Useful for stating that some code branch is impossible because you've
-- | "acquired" a value of type `Void` (which you can't).
Expand Down
4 changes: 3 additions & 1 deletion test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,9 @@ testRecordInstances :: AlmostEff
testRecordInstances = do
assert "Record equality" $ { a: 1 } == { a: 1 }
assert "Record inequality" $ { a: 2 } /= { a: 1 }
assert "Record show" $ show { a: 1 } == "{ a: 1 }"
assert "Record show nil" $ show { } == "{}"
assert "Record show one" $ show { a: 1 } == "{ a: 1 }"
assert "Record show more" $ show { a: 1, b: 2 } == "{ a: 1, b: 2 }"
assert "Record +" $ ({ a: 1, b: 2.0 } + { a: 0, b: (-2.0) }) == { a: 1, b: 0.0 }
assert "Record *" $ ({ a: 1, b: 2.0 } * { a: 0, b: (-2.0) }) == { a: 0, b: -4.0 }
assert "Record one" $ one == { a: 1, b: 1.0 }
Expand Down

0 comments on commit 916e009

Please sign in to comment.