juspay/jrec
1
1
Fork 0
mirror of https://github.com/juspay/jrec.git synced 2024-09-11 10:25:32 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #20 from kamoii/ord-instance

Browse Source 
Implement Ord (Rec lts) instance
This commit is contained in:
Artyom Kazak 2020-10-27 21:20:00 +01:00 committed by GitHub
commit 41fb875256
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/JRec/Internal.hs
View File

@ -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

12
test/JRecSpec.hs
View File

@ -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}"