git.iko.soy/jrec
on master help sign in
Implement Ord (Rec lts) instance
commita6371cc9dc00efa5092ec3b30345676e2501ce09 authorkamoii <> dateWed 28 Oct 2020, 03:54 (6 years ago) parent7877b7e
2 files changed+40
compare with master
unifiedsplit
src/JRec/Internal.hs+28 test/JRecSpec.hs+12
src/JRec/Internal.hs+28
@@ -114,6 +114,10 @@ instance RecEq lts lts => Eq (Rec lts) where
114114 (==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)
115115 {-# INLINE (==) #-}
116116
117+instance RecOrd lts lts => Ord (Rec lts) where
118+ compare (a :: Rec lts) (b :: Rec lts) = recOrd a b (Proxy :: Proxy lts)
119+ {-# INLINE compare #-}
120+
117121#ifdef WITH_AESON
118122instance
119123 ( RecApply lts lts EncodeField
@@ -633,6 +637,30 @@ instance
633637 pNext = Proxy
634638 in res && recEq r1 r2 pNext
635639
640+-- | Machinery to implement order
641+class RecEq rts lts => RecOrd (rts :: [*]) (lts :: [*]) where
642+ recOrd :: Rec rts -> Rec rts -> Proxy lts -> Ordering
643+
644+instance RecOrd rts '[] where
645+ recOrd _ _ _ = EQ
646+
647+instance
648+ ( RecOrd rts (RemoveAccessTo l lts),
649+ Has l rts v,
650+ Ord v
651+ ) =>
652+ RecOrd rts (l := t ': lts)
653+ where
654+ recOrd r1 r2 (_ :: Proxy (l := t ': lts)) =
655+ let lbl :: FldProxy l
656+ lbl = FldProxy
657+ val1 = get lbl r1
658+ val2 = get lbl r2
659+ ord = compare val1 val2
660+ pNext :: Proxy (RemoveAccessTo l (l := t ': lts))
661+ pNext = Proxy
662+ in if ord == EQ then recOrd r1 r2 pNext else ord
663+
636664-- TODO: this probably slows typechecking in euler-ps, and should not be needed
637665type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where
638666 RemoveAccessTo l (l := t ': lts) = RemoveAccessTo l lts
test/JRecSpec.hs+12
@@ -25,6 +25,18 @@ spec = do
2525 Rec (#a := 1, #a := 2) `shouldNotBe` Rec (#a := 0, #a := 2)
2626 it "succeeds if first matching field compares" $ do
2727 Rec (#a := 1, #a := 2) `shouldBe` Rec (#a := 1, #a := 0)
28+ it "ord" $ do
29+ -- Same as eq when there is duplicated keys.
30+ -- Only the first occurence of that key is considered.
31+ compare (Rec (#a := 1, #a := 2)) (Rec (#a := 1, #a := 2)) `shouldBe` EQ
32+ compare (Rec (#a := 1, #a := 2)) (Rec (#a := 1, #a := 3)) `shouldBe` EQ
33+ compare (Rec (#a := 1, #a := 2)) (Rec (#a := 2, #a := 1)) `shouldBe` LT
34+ compare (Rec (#a := 1, #a := 2)) (Rec (#a := 0, #a := 3)) `shouldBe` GT
35+ compare (Rec (#a := 1, #b := 2)) (Rec (#a := 1, #b := 2)) `shouldBe` EQ
36+ compare (Rec (#a := 1, #b := 2)) (Rec (#a := 1, #b := 3)) `shouldBe` LT
37+ compare (Rec (#a := 1, #b := 2)) (Rec (#a := 2, #b := 1)) `shouldBe` LT
38+ compare (Rec (#a := 1, #b := 2)) (Rec (#a := 0, #b := 3)) `shouldBe` GT
39+ compare (Rec (#a := 1, #a := 2, #b := 3)) (Rec (#a := 1, #a := 3, #b := 2)) `shouldBe` GT
2840 it "show" $ do
2941 show (Rec ()) `shouldBe` "{}"
3042 show (Rec (#foo := True)) `shouldBe` "{foo = True}"