@@ -76,6 +76,12 @@ instance genericArray :: Generic a => Generic (Array a) where
76
76
fromSpine (SArray x) = traverse (fromSpine <<< force) x
77
77
fromSpine _ = Nothing
78
78
79
+ instance genericUnit :: Generic Unit where
80
+ toSpine _ = SUnit
81
+ toSignature _ = SigUnit
82
+ fromSpine SUnit = Just unit
83
+ fromSpine _ = Nothing
84
+
79
85
instance genericTuple :: (Generic a , Generic b ) => Generic (Tuple a b ) where
80
86
toSpine (Tuple x y) =
81
87
SProd " Data.Tuple.Tuple" [\_ -> toSpine x, \_ -> toSpine y]
@@ -169,6 +175,7 @@ data GenericSpine
169
175
| SString String
170
176
| SChar Char
171
177
| SArray (Array (Unit -> GenericSpine ))
178
+ | SUnit
172
179
173
180
instance eqGenericSpine :: Eq GenericSpine where
174
181
eq (SProd s1 arr1) (SProd s2 arr2) =
@@ -180,6 +187,7 @@ instance eqGenericSpine :: Eq GenericSpine where
180
187
eq (SString x) (SString y) = x == y
181
188
eq (SChar x) (SChar y) = x == y
182
189
eq (SArray xs) (SArray ys) = length xs == length ys && zipAll eqThunk xs ys
190
+ eq SUnit SUnit = true
183
191
eq _ _ = false
184
192
185
193
instance ordGenericSpine :: Ord GenericSpine where
@@ -213,6 +221,9 @@ instance ordGenericSpine :: Ord GenericSpine where
213
221
compare (SChar _) _ = LT
214
222
compare _ (SChar _) = GT
215
223
compare (SArray xs) (SArray ys) = compare 0 $ zipCompare compareThunk xs ys
224
+ compare (SArray _) _ = LT
225
+ compare _ (SArray _) = GT
226
+ compare SUnit SUnit = EQ
216
227
217
228
-- | A GenericSignature is a universal representation of the structure of an
218
229
-- | arbitrary data structure (that does not contain function arrows).
@@ -225,6 +236,7 @@ data GenericSignature
225
236
| SigString
226
237
| SigChar
227
238
| SigArray (Unit -> GenericSignature )
239
+ | SigUnit
228
240
229
241
instance eqGenericSignature :: Eq GenericSignature where
230
242
eq (SigProd s1 arr1) (SigProd s2 arr2) =
@@ -236,6 +248,7 @@ instance eqGenericSignature :: Eq GenericSignature where
236
248
eq SigString SigString = true
237
249
eq SigChar SigChar = true
238
250
eq (SigArray t1) (SigArray t2) = eqThunk t1 t2
251
+ eq SigUnit SigUnit = true
239
252
eq _ _ = false
240
253
241
254
instance showGenericSignature :: Show GenericSignature where
@@ -270,6 +283,7 @@ showSignature sig =
270
283
SigString -> [" SigString" ]
271
284
SigChar -> [" SigChar" ]
272
285
SigArray sig' -> [" SigArray " , paren (force sig')]
286
+ SigUnit -> [" SigUnit" ]
273
287
274
288
where
275
289
paren s
@@ -285,6 +299,7 @@ showSignature sig =
285
299
SigString -> false
286
300
SigChar -> false
287
301
SigArray _ -> true
302
+ SigUnit -> false
288
303
289
304
-- We use this instead of the default Show Array instance to avoid escaping
290
305
-- strings twice.
@@ -321,6 +336,7 @@ isValidSpine (SigRecord fieldSigs) (SRecord fieldVals) =
321
336
(\sig val -> isValidSpine (force sig.recValue) (force val.recValue))
322
337
(sortBy (\a b -> compare a.recLabel b.recLabel) fieldSigs)
323
338
(sortBy (\a b -> compare a.recLabel b.recLabel) fieldVals)
339
+ isValidSpine SigUnit SUnit = true
324
340
isValidSpine _ _ = false
325
341
326
342
-- ## Generic Functions
@@ -339,17 +355,18 @@ genericShowPrec d (SProd s arr)
339
355
where
340
356
showParen false x = x
341
357
showParen true x = " (" <> x <> " )"
342
- genericShowPrec d (SRecord xs) =
358
+ genericShowPrec _ (SRecord xs) =
343
359
" {" <> joinWith " , " (map showLabelPart xs) <> " }"
344
360
where
345
361
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) =
352
368
" [" <> joinWith " , " (map (\x -> genericShowPrec 0 (force x)) xs) <> " ]"
369
+ genericShowPrec _ SUnit = " unit"
353
370
354
371
-- | This function can be used as an implementation of the `eq` function of `Eq`
355
372
-- | for any type with a `Generic` instance.
0 commit comments