mirror of
https://github.com/juspay/jrec.git
synced 2024-09-11 10:25:32 +03:00
Merge pull request #20 from kamoii/ord-instance
Implement Ord (Rec lts) instance
This commit is contained in:
commit
41fb875256
@ -114,6 +114,10 @@ instance RecEq lts lts => Eq (Rec lts) where
|
||||
(==) (a :: Rec lts) (b :: Rec lts) = recEq a b (Proxy :: Proxy lts)
|
||||
{-# INLINE (==) #-}
|
||||
|
||||
instance RecOrd lts lts => Ord (Rec lts) where
|
||||
compare (a :: Rec lts) (b :: Rec lts) = recOrd a b (Proxy :: Proxy lts)
|
||||
{-# INLINE compare #-}
|
||||
|
||||
#ifdef WITH_AESON
|
||||
instance
|
||||
( RecApply lts lts EncodeField
|
||||
@ -633,6 +637,30 @@ instance
|
||||
pNext = Proxy
|
||||
in res && recEq r1 r2 pNext
|
||||
|
||||
-- | Machinery to implement order
|
||||
class RecEq rts lts => RecOrd (rts :: [*]) (lts :: [*]) where
|
||||
recOrd :: Rec rts -> Rec rts -> Proxy lts -> Ordering
|
||||
|
||||
instance RecOrd rts '[] where
|
||||
recOrd _ _ _ = EQ
|
||||
|
||||
instance
|
||||
( RecOrd rts (RemoveAccessTo l lts),
|
||||
Has l rts v,
|
||||
Ord v
|
||||
) =>
|
||||
RecOrd rts (l := t ': lts)
|
||||
where
|
||||
recOrd r1 r2 (_ :: Proxy (l := t ': lts)) =
|
||||
let lbl :: FldProxy l
|
||||
lbl = FldProxy
|
||||
val1 = get lbl r1
|
||||
val2 = get lbl r2
|
||||
ord = compare val1 val2
|
||||
pNext :: Proxy (RemoveAccessTo l (l := t ': lts))
|
||||
pNext = Proxy
|
||||
in if ord == EQ then recOrd r1 r2 pNext else ord
|
||||
|
||||
-- TODO: this probably slows typechecking in euler-ps, and should not be needed
|
||||
type family RemoveAccessTo (l :: Symbol) (lts :: [*]) :: [*] where
|
||||
RemoveAccessTo l (l := t ': lts) = RemoveAccessTo l lts
|
||||
|
@ -25,6 +25,18 @@ spec = do
|
||||
Rec (#a := 1, #a := 2) `shouldNotBe` Rec (#a := 0, #a := 2)
|
||||
it "succeeds if first matching field compares" $ do
|
||||
Rec (#a := 1, #a := 2) `shouldBe` Rec (#a := 1, #a := 0)
|
||||
it "ord" $ do
|
||||
-- Same as eq when there is duplicated keys.
|
||||
-- Only the first occurence of that key is considered.
|
||||
compare (Rec (#a := 1, #a := 2)) (Rec (#a := 1, #a := 2)) `shouldBe` EQ
|
||||
compare (Rec (#a := 1, #a := 2)) (Rec (#a := 1, #a := 3)) `shouldBe` EQ
|
||||
compare (Rec (#a := 1, #a := 2)) (Rec (#a := 2, #a := 1)) `shouldBe` LT
|
||||
compare (Rec (#a := 1, #a := 2)) (Rec (#a := 0, #a := 3)) `shouldBe` GT
|
||||
compare (Rec (#a := 1, #b := 2)) (Rec (#a := 1, #b := 2)) `shouldBe` EQ
|
||||
compare (Rec (#a := 1, #b := 2)) (Rec (#a := 1, #b := 3)) `shouldBe` LT
|
||||
compare (Rec (#a := 1, #b := 2)) (Rec (#a := 2, #b := 1)) `shouldBe` LT
|
||||
compare (Rec (#a := 1, #b := 2)) (Rec (#a := 0, #b := 3)) `shouldBe` GT
|
||||
compare (Rec (#a := 1, #a := 2, #b := 3)) (Rec (#a := 1, #a := 3, #b := 2)) `shouldBe` GT
|
||||
it "show" $ do
|
||||
show (Rec ()) `shouldBe` "{}"
|
||||
show (Rec (#foo := True)) `shouldBe` "{foo = True}"
|
||||
|
Loading…
Reference in New Issue
Block a user