Skip to content

Commit 4e192c8

Browse files
author
Tom Harding
committed
Add Monoid, Semiring and Ring for Record
Adding more and more type classes for records. We're getting somewhere!
1 parent 347b9a6 commit 4e192c8

File tree

9 files changed

+251
-39
lines changed

9 files changed

+251
-39
lines changed

‎src/Data/Eq.purs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,7 @@ instance eqRecordCons
8888
, IsSymbol key
8989
, Eq focus
9090
)
91-
=> EqRecord (RL.Cons key a rowlistTail) row a where
91+
=> EqRecord (RL.Cons key focus rowlistTail) row focus where
9292
eqRecordImpl _ ra rb
9393
= unsafeGet' key ra == unsafeGet key rb
9494
&& eqRecordImpl (RLProxy :: RLProxy rowlistTail) ra rb

‎src/Data/Monoid.purs‎

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,14 @@ module Data.Monoid
88
import Data.Boolean (otherwise)
99
import Data.Eq ((==))
1010
import Data.EuclideanRing (mod, (/))
11+
import Data.Internal.Record (unsafeInsert)
1112
import Data.Ord ((<=))
1213
import Data.Ordering (Ordering(..))
13-
import Data.Semigroup (class Semigroup, (<>))
14+
import Data.RowList (RLProxy(..))
15+
import Data.Semigroup (class Semigroup, class SemigroupRecord, (<>))
16+
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
1417
import Data.Unit (Unit, unit)
18+
import Prim.RowList as RL
1519

1620
-- | A `Monoid` is a `Semigroup` with a value `mempty`, which is both a
1721
-- | left and right unit for the associative operation `<>`:
@@ -41,6 +45,34 @@ instance monoidString :: Monoid String where
4145
instance monoidArray :: Monoid (Array a) where
4246
mempty = []
4347

48+
class MonoidRecord rowlist row focus | rowlist -> row focus where
49+
monoidRecordImpl :: RLProxy rowlist -> Record row
50+
51+
instance monoidRecordNil :: MonoidRecord RL.Nil () focus where
52+
monoidRecordImpl _ = {}
53+
54+
instance monoidRecordCons
55+
:: ( IsSymbol key
56+
, Monoid focus
57+
, MonoidRecord rowlistTail row subfocus
58+
)
59+
=> MonoidRecord (RL.Cons key focus rowlistTail) row focus where
60+
monoidRecordImpl _
61+
= unsafeInsert key
62+
(mempty :: focus)
63+
(monoidRecordImpl (RLProxy :: RLProxy rowlistTail))
64+
where
65+
key = reflectSymbol (SProxy :: SProxy key)
66+
67+
instance monoidRecord
68+
:: ( RL.RowToList row list
69+
, SemigroupRecord list row row focus
70+
, MonoidRecord list row focus
71+
)
72+
=> Monoid (Record row) where
73+
mempty = monoidRecordImpl (RLProxy :: RLProxy list)
74+
75+
4476
-- | Append a value to itself a certain number of times. For the
4577
-- | `Multiplicative` type, and for a non-negative power, this is the same as
4678
-- | normal number exponentiation.

‎src/Data/Ord.purs‎

Lines changed: 34 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -14,17 +14,12 @@ module Data.Ord
1414
, module Data.Ordering
1515
) where
1616

17-
import Data.Eq (class Eq, class Eq1, class EqRecord, (/=))
18-
import Data.Internal.Record (unsafeGet)
17+
import Data.Eq (class Eq, class Eq1)
1918
import Data.Ord.Unsafe (unsafeCompare)
2019
import Data.Ordering (Ordering(..))
2120
import Data.Ring (class Ring, zero, one, negate)
22-
import Data.RowList (RLProxy(..))
23-
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
2421
import Data.Unit (Unit)
2522
import Data.Void (Void)
26-
import Prim.Row as Row
27-
import Prim.RowList as RL
2823

2924
-- | The `Ord` type class represents types which support comparisons with a
3025
-- | _total order_.
@@ -174,31 +169,36 @@ class Eq1 f <= Ord1 f where
174169
instance ord1Array :: Ord1 Array where
175170
compare1 = compare
176171

177-
class EqRecord rowlist row focus <= OrdRecord rowlist row focus | rowlist -> focus where
178-
compareImpl :: RLProxy rowlist -> Record row -> Record row -> Ordering
179-
180-
instance ordRecordNil :: OrdRecord RL.Nil row focus where
181-
compareImpl _ _ _ = EQ
182-
183-
instance ordRecordCons
184-
:: ( OrdRecord rowlistTail row subfocus
185-
, Row.Cons key focus rowTail row
186-
, IsSymbol key
187-
, Ord focus
188-
)
189-
=> OrdRecord (RL.Cons key focus rowlistTail) row focus where
190-
compareImpl _ ra rb
191-
= if left /= EQ
192-
then left
193-
else compareImpl (RLProxy :: RLProxy rowlistTail) ra rb
194-
where
195-
key = reflectSymbol (SProxy :: SProxy key)
196-
unsafeGet' = unsafeGet :: String -> Record row -> focus
197-
left = unsafeGet' key ra `compare` unsafeGet' key rb
198-
199-
instance ordRecord
200-
:: ( RL.RowToList row list
201-
, OrdRecord list row focus
202-
)
203-
=> Ord (Record row) where
204-
compare = compareImpl (RLProxy :: RLProxy list)
172+
-- Ordering for records is currently unimplemented as there are outstanding
173+
-- questions around whether this implementation be useful. This is because it
174+
-- prioritises the keys alphabetically, and this behaviour isn't overridable.
175+
-- For now, we leave this unavailable, but the implementation is as follows:
176+
177+
-- class EqRecord rowlist row focus <= OrdRecord rowlist row focus | rowlist -> focus where
178+
-- compareImpl :: RLProxy rowlist -> Record row -> Record row -> Ordering
179+
--
180+
-- instance ordRecordNil :: OrdRecord RL.Nil row focus where
181+
-- compareImpl _ _ _ = EQ
182+
--
183+
-- instance ordRecordCons
184+
-- :: ( OrdRecord rowlistTail row subfocus
185+
-- , Row.Cons key focus rowTail row
186+
-- , IsSymbol key
187+
-- , Ord focus
188+
-- )
189+
-- => OrdRecord (RL.Cons key focus rowlistTail) row focus where
190+
-- compareImpl _ ra rb
191+
-- = if left /= EQ
192+
-- then left
193+
-- else compareImpl (RLProxy :: RLProxy rowlistTail) ra rb
194+
-- where
195+
-- key = reflectSymbol (SProxy :: SProxy key)
196+
-- unsafeGet' = unsafeGet :: String -> Record row -> focus
197+
-- left = unsafeGet' key ra `compare` unsafeGet' key rb
198+
--
199+
-- instance ordRecord
200+
-- :: ( RL.RowToList row list
201+
-- , OrdRecord list row focus
202+
-- )
203+
-- => Ord (Record row) where
204+
-- compare = compareImpl (RLProxy :: RLProxy list)

‎src/Data/Ring.purs‎

Lines changed: 34 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,8 +3,13 @@ module Data.Ring
33
, module Data.Semiring
44
) where
55

6-
import Data.Semiring (class Semiring, add, mul, one, zero, (*), (+))
6+
import Data.Internal.Record (unsafeGet, unsafeInsert)
7+
import Data.RowList (RLProxy(..))
8+
import Data.Semiring (class Semiring, class SemiringRecord, add, mul, one, zero, (*), (+))
9+
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
710
import Data.Unit (Unit, unit)
11+
import Prim.Row as Row
12+
import Prim.RowList as RL
813

914
-- | The `Ring` class is for types that support addition, multiplication,
1015
-- | and subtraction operations.
@@ -36,3 +41,31 @@ negate a = zero - a
3641

3742
foreign import intSub :: Int -> Int -> Int
3843
foreign import numSub :: Number -> Number -> Number
44+
45+
class RingRecord rowlist row subrow focus | rowlist -> subrow focus where
46+
subRecordImpl :: RLProxy rowlist -> Record row -> Record row -> Record subrow
47+
48+
instance ringRecordNil :: RingRecord RL.Nil row () focus where
49+
subRecordImpl _ _ _ = {}
50+
51+
instance ringRecordCons
52+
:: ( IsSymbol key
53+
, Row.Cons key focus subrowTail subrow
54+
, RingRecord rowlistTail row subrowTail subfocus
55+
, Ring focus
56+
)
57+
=> RingRecord (RL.Cons key focus rowlistTail) row subrow focus where
58+
subRecordImpl _ ra rb
59+
= unsafeInsert key
60+
(unsafeGet' key ra - unsafeGet' key rb)
61+
(subRecordImpl (RLProxy :: RLProxy rowlistTail) ra rb)
62+
where key = reflectSymbol (SProxy :: SProxy key)
63+
unsafeGet' = unsafeGet :: String -> Record row -> focus
64+
65+
instance ringRecord
66+
:: ( RL.RowToList row list
67+
, SemiringRecord list row row focus
68+
, RingRecord list row row focus
69+
)
70+
=> Ring (Record row) where
71+
sub = subRecordImpl (RLProxy :: RLProxy list)

‎src/Data/Semigroup.purs‎

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,11 @@
1-
module Data.Semigroup (class Semigroup, append, (<>)) where
1+
module Data.Semigroup
2+
( class Semigroup
3+
, append
4+
, (<>)
5+
6+
, class SemigroupRecord
7+
, semigroupRecordImpl
8+
) where
29

310
import Data.Internal.Record (unsafeGet, unsafeInsert)
411
import Data.RowList (RLProxy(..))

‎src/Data/Semiring.purs‎

Lines changed: 85 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,26 @@
1-
module Data.Semiring (class Semiring, add, (+), zero, mul, (*), one) where
1+
module Data.Semiring
2+
( class Semiring
3+
, add
4+
, (+)
5+
, zero
6+
, mul
7+
, (*)
8+
, one
29

10+
, class SemiringRecord
11+
, addRecordImpl
12+
, mulRecordImpl
13+
, oneRecordImpl
14+
, zeroRecordImpl
15+
) where
16+
17+
import Data.Internal.Record (unsafeGet, unsafeInsert)
18+
import Data.RowList (RLProxy(..))
19+
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
20+
import Type.Data.Row (RProxy(..))
321
import Data.Unit (Unit, unit)
22+
import Prim.Row as Row
23+
import Prim.RowList as RL
424

525
-- | The `Semiring` class is for types that support an addition and
626
-- | multiplication operation.
@@ -60,3 +80,67 @@ foreign import intAdd :: Int -> Int -> Int
6080
foreign import intMul :: Int -> Int -> Int
6181
foreign import numAdd :: Number -> Number -> Number
6282
foreign import numMul :: Number -> Number -> Number
83+
84+
class SemiringRecord rowlist row subrow focus | rowlist -> subrow focus where
85+
addRecordImpl :: RLProxy rowlist -> Record row -> Record row -> Record subrow
86+
mulRecordImpl :: RLProxy rowlist -> Record row -> Record row -> Record subrow
87+
oneRecordImpl :: RLProxy rowlist -> RProxy row -> Record subrow
88+
zeroRecordImpl :: RLProxy rowlist -> RProxy row -> Record subrow
89+
90+
instance semiringRecordNil :: SemiringRecord RL.Nil row () focus where
91+
addRecordImpl _ _ _ = {}
92+
mulRecordImpl _ _ _ = {}
93+
oneRecordImpl _ _ = {}
94+
zeroRecordImpl _ _ = {}
95+
96+
instance semiringRecordCons
97+
:: ( IsSymbol key
98+
, Row.Cons key focus subrowTail subrow
99+
, SemiringRecord rowlistTail row subrowTail subfocus
100+
, Semiring focus
101+
)
102+
=> SemiringRecord (RL.Cons key focus rowlistTail) row subrow focus where
103+
addRecordImpl _ ra rb
104+
= unsafeInsert key
105+
(unsafeGet' key ra + unsafeGet' key rb)
106+
(addRecordImpl (RLProxy :: RLProxy rowlistTail) ra rb)
107+
where key = reflectSymbol (SProxy :: SProxy key)
108+
unsafeGet' = unsafeGet :: String -> Record row -> focus
109+
110+
mulRecordImpl _ ra rb
111+
= unsafeInsert key
112+
(unsafeGet' key ra * unsafeGet' key rb)
113+
(mulRecordImpl (RLProxy :: RLProxy rowlistTail) ra rb)
114+
where
115+
key = reflectSymbol (SProxy :: SProxy key)
116+
unsafeGet' = unsafeGet :: String -> Record row -> focus
117+
118+
oneRecordImpl _ _
119+
= unsafeInsert key (one :: focus)
120+
( oneRecordImpl
121+
(RLProxy :: RLProxy rowlistTail)
122+
(RProxy :: RProxy row)
123+
)
124+
where
125+
key = reflectSymbol (SProxy :: SProxy key)
126+
unsafeGet' = unsafeGet :: String -> Record row -> focus
127+
128+
zeroRecordImpl _ _
129+
= unsafeInsert key (one :: focus)
130+
( zeroRecordImpl
131+
(RLProxy :: RLProxy rowlistTail)
132+
(RProxy :: RProxy row)
133+
)
134+
where
135+
key = reflectSymbol (SProxy :: SProxy key)
136+
unsafeGet' = unsafeGet :: String -> Record row -> focus
137+
138+
instance semiringRecord
139+
:: ( RL.RowToList row list
140+
, SemiringRecord list row row focus
141+
)
142+
=> Semiring (Record row) where
143+
add = addRecordImpl (RLProxy :: RLProxy list)
144+
mul = mulRecordImpl (RLProxy :: RLProxy list)
145+
one = oneRecordImpl (RLProxy :: RLProxy list) (RProxy :: RProxy row)
146+
zero = zeroRecordImpl (RLProxy :: RLProxy list) (RProxy :: RProxy row)

‎src/Data/Show.js‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,3 +59,15 @@ exports.showArrayImpl = function (f) {
5959
return "[" + ss.join(",") + "]";
6060
};
6161
};
62+
63+
exports.cons = function (head) {
64+
return function (tail) {
65+
return [head].concat(tail);
66+
};
67+
};
68+
69+
exports.join = function (separator) {
70+
return function (xs) {
71+
return xs.join(separator);
72+
};
73+
};

‎src/Data/Show.purs‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
module Data.Show (class Show, show) where
22

3+
import Data.Internal.Record (unsafeGet)
4+
import Data.RowList (RLProxy(..))
5+
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
6+
import Prim.RowList as RL
7+
38
-- | The `Show` type class represents those types which can be converted into
49
-- | a human-readable `String` representation.
510
-- |
@@ -28,8 +33,43 @@ instance showString :: Show String where
2833
instance showArray :: Show a => Show (Array a) where
2934
show = showArrayImpl show
3035

36+
class ShowRecordFields
37+
(rowlist :: RL.RowList)
38+
(row :: # Type)
39+
focus
40+
| rowlist -> focus where
41+
showRecordFieldsImpl :: (RLProxy rowlist) -> Record row -> Array String
42+
43+
instance showRecordFieldsNil
44+
:: ShowRecordFields RL.Nil row focus where
45+
showRecordFieldsImpl _ _ = []
46+
47+
instance showRecordFieldsCons
48+
:: ( IsSymbol key
49+
, ShowRecordFields rowlistTail row subfocus
50+
, Show focus
51+
)
52+
=> ShowRecordFields (RL.Cons key focus rowlistTail) row focus where
53+
showRecordFieldsImpl _ record = cons
54+
(join ": " [ key, show (unsafeGet' key record) ])
55+
(showRecordFieldsImpl (RLProxy :: RLProxy rowlistTail) record)
56+
where
57+
key = reflectSymbol (SProxy :: SProxy key)
58+
unsafeGet' = unsafeGet :: String -> Record row -> focus
59+
60+
instance showRecord
61+
:: ( RL.RowToList rs ls
62+
, ShowRecordFields ls rs focus
63+
)
64+
=> Show (Record rs) where
65+
show record = case showRecordFieldsImpl (RLProxy :: RLProxy ls) record of
66+
[] -> "{}"
67+
fields -> join " " [ "{", join ", " fields, "}" ]
68+
3169
foreign import showIntImpl :: Int -> String
3270
foreign import showNumberImpl :: Number -> String
3371
foreign import showCharImpl :: Char -> String
3472
foreign import showStringImpl :: String -> String
3573
foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String
74+
foreign import cons :: forall a. a -> Array a -> Array a
75+
foreign import join :: String -> Array String -> String

‎src/Type/Data/Row.purs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module Type.Data.Row where
2+
3+
data RProxy (row :: # Type)
4+
= RProxy

0 commit comments

Comments
 (0)