This repository has been archived by the owner on Mar 25, 2021. It is now read-only.
/
Ord.purs
45 lines (34 loc) · 1.69 KB
/
Ord.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
module Data.Generic.Rep.Ord
( class GenericOrd
, genericCompare'
, genericCompare
) where
import Prelude (class Ord, compare, Ordering(..))
import Data.Generic.Rep
class GenericOrd a where
genericCompare' :: a -> a -> Ordering
instance genericOrdNoConstructors :: GenericOrd NoConstructors where
genericCompare' _ _ = EQ
instance genericOrdNoArguments :: GenericOrd NoArguments where
genericCompare' _ _ = EQ
instance genericOrdSum :: (GenericOrd a, GenericOrd b) => GenericOrd (Sum a b) where
genericCompare' (Inl a1) (Inl a2) = genericCompare' a1 a2
genericCompare' (Inr b1) (Inr b2) = genericCompare' b1 b2
genericCompare' (Inl b1) (Inr b2) = LT
genericCompare' (Inr b1) (Inl b2) = GT
instance genericOrdProduct :: (GenericOrd a, GenericOrd b) => GenericOrd (Product a b) where
genericCompare' (Product a1 b1) (Product a2 b2) =
case genericCompare' a1 a2 of
EQ -> genericCompare' b1 b2
other -> other
instance genericOrdConstructor :: GenericOrd a => GenericOrd (Constructor name a) where
genericCompare' (Constructor a1) (Constructor a2) = genericCompare' a1 a2
instance genericOrdArgument :: Ord a => GenericOrd (Argument a) where
genericCompare' (Argument a1) (Argument a2) = compare a1 a2
instance genericOrdRec :: GenericOrd a => GenericOrd (Rec a) where
genericCompare' (Rec a1) (Rec a2) = genericCompare' a1 a2
instance genericOrdField :: Ord a => GenericOrd (Field name a) where
genericCompare' (Field a1) (Field a2) = compare a1 a2
-- | A `Generic` implementation of the `compare` member from the `Ord` type class.
genericCompare :: forall a rep. Generic a rep => GenericOrd rep => a -> a -> Ordering
genericCompare x y = genericCompare' (from x) (from y)