Skip to content
This repository was archived by the owner on Oct 4, 2020. It is now read-only.

Commit d09cb16

Browse files
committed
Merge pull request #36 from purescript/unit
Add Unit handling
2 parents 698196f + fc57cb8 commit d09cb16

File tree

2 files changed

+30
-9
lines changed

2 files changed

+30
-9
lines changed

src/Data/Generic.purs

Lines changed: 24 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,12 @@ instance genericArray :: Generic a => Generic (Array a) where
7676
fromSpine (SArray x) = traverse (fromSpine <<< force) x
7777
fromSpine _ = Nothing
7878

79+
instance genericUnit :: Generic Unit where
80+
toSpine _ = SUnit
81+
toSignature _ = SigUnit
82+
fromSpine SUnit = Just unit
83+
fromSpine _ = Nothing
84+
7985
instance genericTuple :: (Generic a, Generic b) => Generic (Tuple a b) where
8086
toSpine (Tuple x y) =
8187
SProd "Data.Tuple.Tuple" [\_ -> toSpine x, \_ -> toSpine y]
@@ -169,6 +175,7 @@ data GenericSpine
169175
| SString String
170176
| SChar Char
171177
| SArray (Array (Unit -> GenericSpine))
178+
| SUnit
172179

173180
instance eqGenericSpine :: Eq GenericSpine where
174181
eq (SProd s1 arr1) (SProd s2 arr2) =
@@ -180,6 +187,7 @@ instance eqGenericSpine :: Eq GenericSpine where
180187
eq (SString x) (SString y) = x == y
181188
eq (SChar x) (SChar y) = x == y
182189
eq (SArray xs) (SArray ys) = length xs == length ys && zipAll eqThunk xs ys
190+
eq SUnit SUnit = true
183191
eq _ _ = false
184192

185193
instance ordGenericSpine :: Ord GenericSpine where
@@ -213,6 +221,9 @@ instance ordGenericSpine :: Ord GenericSpine where
213221
compare (SChar _) _ = LT
214222
compare _ (SChar _) = GT
215223
compare (SArray xs) (SArray ys) = compare 0 $ zipCompare compareThunk xs ys
224+
compare (SArray _) _ = LT
225+
compare _ (SArray _) = GT
226+
compare SUnit SUnit = EQ
216227

217228
-- | A GenericSignature is a universal representation of the structure of an
218229
-- | arbitrary data structure (that does not contain function arrows).
@@ -225,6 +236,7 @@ data GenericSignature
225236
| SigString
226237
| SigChar
227238
| SigArray (Unit -> GenericSignature)
239+
| SigUnit
228240

229241
instance eqGenericSignature :: Eq GenericSignature where
230242
eq (SigProd s1 arr1) (SigProd s2 arr2) =
@@ -236,6 +248,7 @@ instance eqGenericSignature :: Eq GenericSignature where
236248
eq SigString SigString = true
237249
eq SigChar SigChar = true
238250
eq (SigArray t1) (SigArray t2) = eqThunk t1 t2
251+
eq SigUnit SigUnit = true
239252
eq _ _ = false
240253

241254
instance showGenericSignature :: Show GenericSignature where
@@ -270,6 +283,7 @@ showSignature sig =
270283
SigString -> ["SigString"]
271284
SigChar -> ["SigChar"]
272285
SigArray sig' -> ["SigArray ", paren (force sig')]
286+
SigUnit -> ["SigUnit"]
273287

274288
where
275289
paren s
@@ -285,6 +299,7 @@ showSignature sig =
285299
SigString -> false
286300
SigChar -> false
287301
SigArray _ -> true
302+
SigUnit -> false
288303

289304
-- We use this instead of the default Show Array instance to avoid escaping
290305
-- strings twice.
@@ -321,6 +336,7 @@ isValidSpine (SigRecord fieldSigs) (SRecord fieldVals) =
321336
(\sig val -> isValidSpine (force sig.recValue) (force val.recValue))
322337
(sortBy (\a b -> compare a.recLabel b.recLabel) fieldSigs)
323338
(sortBy (\a b -> compare a.recLabel b.recLabel) fieldVals)
339+
isValidSpine SigUnit SUnit = true
324340
isValidSpine _ _ = false
325341

326342
-- ## Generic Functions
@@ -339,17 +355,18 @@ genericShowPrec d (SProd s arr)
339355
where
340356
showParen false x = x
341357
showParen true x = "(" <> x <> ")"
342-
genericShowPrec d (SRecord xs) =
358+
genericShowPrec _ (SRecord xs) =
343359
"{" <> joinWith ", " (map showLabelPart xs) <> "}"
344360
where
345361
showLabelPart x = x.recLabel <> ": " <> genericShowPrec 0 (force x.recValue)
346-
genericShowPrec d (SBoolean x) = show x
347-
genericShowPrec d (SInt x) = show x
348-
genericShowPrec d (SNumber x) = show x
349-
genericShowPrec d (SString x) = show x
350-
genericShowPrec d (SChar x) = show x
351-
genericShowPrec d (SArray xs) =
362+
genericShowPrec _ (SBoolean x) = show x
363+
genericShowPrec _ (SInt x) = show x
364+
genericShowPrec _ (SNumber x) = show x
365+
genericShowPrec _ (SString x) = show x
366+
genericShowPrec _ (SChar x) = show x
367+
genericShowPrec _ (SArray xs) =
352368
"[" <> joinWith ", " (map (\x -> genericShowPrec 0 (force x)) xs) <> "]"
369+
genericShowPrec _ SUnit = "unit"
353370

354371
-- | This function can be used as an implementation of the `eq` function of `Eq`
355372
-- | for any type with a `Generic` instance.

test/Main.purs

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,14 +18,18 @@ data Foo
1818
| Baz {a :: Maybe String, bq :: Number} String
1919
| Corge (Array Char)
2020

21+
derive instance genericFoo :: Generic Foo
22+
2123
data IntList
2224
= IntList Number IntList
2325
| NilIntList
2426

25-
derive instance genericFoo :: Generic Foo
26-
2727
derive instance genericIntList :: Generic IntList
2828

29+
data UnitPlus = UnitPlus Unit Unit
30+
31+
derive instance genericUnitPlus :: Generic UnitPlus
32+
2933
instance showFoo :: Show Foo where
3034
show = gShow
3135

0 commit comments

Comments
 (0)