Merge pull request #180 from LiamGoodacre/feature/ord-record

Add/finish Ord instance for Records

Author: garyb

src/Data/Ord.purs

@@ -12,14 +12,20 @@ module Data.Ord
   , abs
   , signum
   , module Data.Ordering
+  , class OrdRecord, compareRecord
   ) where
 
-import Data.Eq (class Eq, class Eq1)
+import Data.Eq (class Eq, class Eq1, class EqRecord, (/=))
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Data.Ord.Unsafe (unsafeCompare)
 import Data.Ordering (Ordering(..))
 import Data.Ring (class Ring, zero, one, negate)
 import Data.Unit (Unit)
 import Data.Void (Void)
+import Prim.Row as Row
+import Prim.RowList as RL
+import Record.Unsafe (unsafeGet)
+import Type.Data.RowList (RLProxy(..))
 
 -- | The `Ord` type class represents types which support comparisons with a
 -- | _total order_.
@@ -169,36 +175,32 @@ class Eq1 f <= Ord1 f where
 instance ord1Array :: Ord1 Array where
   compare1 = compare
 
--- Ordering for records is currently unimplemented as there are outstanding
--- questions around whether this implementation be useful. This is because it
--- prioritises the keys alphabetically, and this behaviour isn't overridable.
--- For now, we leave this unavailable, but the implementation is as follows:
-
--- class EqRecord rowlist row focus <= OrdRecord rowlist row focus | rowlist -> focus where
---   compareImpl :: RLProxy rowlist -> Record row -> Record row -> Ordering
--- 
--- instance ordRecordNil :: OrdRecord RL.Nil row focus where
---   compareImpl _ _ _ = EQ
--- 
--- instance ordRecordCons
---     :: ( OrdRecord rowlistTail row subfocus
---        , Row.Cons key focus rowTail row
---        , IsSymbol key
---        , Ord focus
---        )
---     => OrdRecord (RL.Cons key focus rowlistTail) row focus where
---   compareImpl _ ra rb
---     = if left /= EQ
---         then left
---         else compareImpl (RLProxy :: RLProxy rowlistTail) ra rb
---     where
---       key = reflectSymbol (SProxy :: SProxy key)
---       unsafeGet' = unsafeGet :: String -> Record row -> focus
---       left = unsafeGet' key ra `compare` unsafeGet' key rb
--- 
--- instance ordRecord
---     :: ( RL.RowToList row list
---        , OrdRecord list row focus
---        )
---     => Ord (Record row) where
---   compare = compareImpl (RLProxy :: RLProxy list)
+class EqRecord rowlist row <= OrdRecord rowlist row where
+  compareRecord :: RLProxy rowlist -> Record row -> Record row -> Ordering
+
+instance ordRecordNil :: OrdRecord RL.Nil row where
+  compareRecord _ _ _ = EQ
+
+instance ordRecordCons
+    :: ( OrdRecord rowlistTail row
+       , Row.Cons key focus rowTail row
+       , IsSymbol key
+       , Ord focus
+       )
+    => OrdRecord (RL.Cons key focus rowlistTail) row where
+  compareRecord _ ra rb
+    = if left /= EQ
+        then left
+        else compareRecord (RLProxy :: RLProxy rowlistTail) ra rb
+    where
+      key = reflectSymbol (SProxy :: SProxy key)
+      unsafeGet' = unsafeGet :: String -> Record row -> focus
+      left = unsafeGet' key ra `compare` unsafeGet' key rb
+
+instance ordRecord
+    :: ( RL.RowToList row list
+       , OrdRecord list row
+       )
+    => Ord (Record row) where
+  compare = compareRecord (RLProxy :: RLProxy list)
+

test/Test/Main.purs

@@ -144,3 +144,9 @@ testRecordInstances = do
     { a: true, b: false, c: true, d: false }
     { a: true, b: true, c: false, d: false }
     == { a: true, b: true, c: false, d: true }
+  testOrd { a: 0, b: "hello" } { a: 42, b: "hello" } LT
+  testOrd { a: 42, b: "hello" } { a: 0, b: "hello" } GT
+  testOrd { a: 42, b: "hello" } { a: 42, b: "hello" } EQ
+  testOrd { a: 42, b: "hell" } { a: 42, b: "hello" } LT
+  testOrd { a: 42, b: "hello" } { a: 42, b: "hell" } GT
+