@@ -1,186 +0,0 @@
1−module ProjectM36 where
2−
3−import Prelude
4−import Prim.Row
5−import Prim.RowList
6−import Type.Prelude
7−
8−import Data.Newtype (class Newtype)
9−import Data.Set (Set)
10−import Data.Set as Set
11−import Foreign.Object (Object)
12−import Foreign.Object as Object
13−import Prim.Row as Row
14−import Prim.RowList as RowList
15−
16−data Expr
17− = Join Expr Expr
18− | Union Expr Expr
19− | Project (Set Attribute) Expr
20− | Rename (Object Attribute) Expr
21− | Difference Expr Expr
22− | Group (Set Attribute) Attribute Expr
23− | Ungroup Attribute Expr
24− | RelationVariable RelVarName
25−
26−type RelVarName = String
27−type Attribute = String
28−
29−class RelVar :: forall k. k -> Constraint
30−class RelVar rel where
31− relVar :: String
32−
33−rel :: forall @rel fields. Newtype rel (Record fields) => RelVar rel => Rel fields
34−rel = Rel $ RelationVariable (relVar @rel)
35−
36−newtype Rel (fields :: Row Type) = Rel Expr
37−
38−union :: forall fields. Rel fields -> Rel fields -> Rel fields
39−union (Rel x) (Rel y) = Rel $ Union x y
40−
41−difference :: forall fields. Rel fields -> Rel fields -> Rel fields
42−difference (Rel x) (Rel y) = Rel $ Difference x y
43−
44−join
45− :: forall lhs rhs res lhs' rhs' res'
46− . Union lhs rhs res
47− => RowToList lhs lhs'
48− => RowToList rhs rhs'
49− => AssertNoConflict lhs' res'
50− => AssertNoConflict rhs' res'
51− => Nub res res'
52− => Rel lhs
53− -> Rel rhs
54− -> Rel res'
55−join (Rel lhs) (Rel rhs) = Rel $ Join lhs rhs
56−
57−class AssertNoConflict :: forall k. RowList k -> Row k -> Constraint
58−class AssertNoConflict xs ys
59−
60−instance AssertNoConflict Nil xs
61−instance (AssertNoConflict ys xs, Row.Cons l y xs' xs) => AssertNoConflict (RowList.Cons l y ys) xs
62−
63−rename
64− :: forall @rename rename' fields fields'
65− . RowList.RowToList rename rename'
66− => RenameRel rename' fields fields'
67− => ReifyRename rename'
68− => Rel fields
69− -> Rel fields'
70−rename (Rel x) = Rel $ Rename (reifyRename @rename') x
71−
72−class ReifyRename :: RowList Symbol -> Constraint
73−class ReifyRename rename where
74− reifyRename :: Object Attribute
75−
76−instance ReifyRename RowList.Nil where
77− reifyRename = Object.empty
78−
79−instance (ReifyRename rest, IsSymbol from, IsSymbol to) => ReifyRename (RowList.Cons from to rest) where
80− reifyRename = Object.insert (reflectSymbol @from Proxy) (reflectSymbol @to Proxy) (reifyRename @rest)
81−
82−class RenameRel :: forall k. RowList Symbol -> Row k -> Row k -> Constraint
83−class RenameRel rename fields fields' | rename fields -> fields'
84−
85−instance RenameRel RowList.Nil fields fields
86−instance
87− ( Row.Cons from t fields' fields
88− , Row.Cons to t fields' fields''
89− ) =>
90− RenameRel (RowList.Cons from to rest) fields fields''
91−
92−project
93− :: forall @projection projection' fields fields'
94− . ProjectRel projection' fields fields'
95− => RowList.RowToList projection projection'
96− => ReifyFields projection'
97− => Rel fields
98− -> Rel fields'
99−project (Rel x) = Rel $ Project (reifyFields @projection') x
100−
101−class ProjectRel :: forall k l. RowList k -> Row l -> Row l -> Constraint
102−class ProjectRel projection fields fields' | projection fields -> fields'
103−
104−instance ProjectRel RowList.Nil fields ()
105−instance
106− ( ProjectRel rest fields fields''
107− , Row.Cons field value f fields
108− , Row.Cons field value fields'' fields'
109− ) =>
110− ProjectRel (RowList.Cons field v rest) fields fields'
111−
112−class ReifyFields :: forall k. RowList k -> Constraint
113−class ReifyFields row where
114− reifyFields :: Set Attribute
115−
116−instance ReifyFields RowList.Nil where
117− reifyFields = Set.empty
118−
119−instance (IsSymbol field, ReifyFields rest) => ReifyFields (RowList.Cons field v rest) where
120− reifyFields = Set.insert (reflectSymbol @field Proxy) (reifyFields @rest)
121−
122−group
123− :: forall @group (@field :: Symbol) group' groupped fields fields' fields''
124− . RowList.RowToList group group'
125− => GroupRel group' fields groupped
126− => Row.Cons field (Rel groupped) fields'' fields'
127− => DropFields group' fields fields''
128− => ReifyFields group'
129− => IsSymbol field
130− => Rel fields
131− -> Rel fields'
132−group (Rel x) = Rel $ Group (reifyFields @group') (reflectSymbol @field Proxy) x
133−
134−class GroupRel :: forall k l. RowList l -> Row k -> Row k -> Constraint
135−class GroupRel group fields groupped | group fields -> groupped
136−
137−instance GroupRel RowList.Nil fields ()
138−
139−instance
140− ( GroupRel rest fields fields''
141− , Row.Cons field t f fields
142− , Row.Cons field t fields'' fields'
143− ) =>
144− GroupRel (RowList.Cons field u rest) fields fields'
145−
146−class DropFields :: forall l k. RowList l -> Row k -> Row k -> Constraint
147−class DropFields drop fields fields' | drop fields -> fields'
148−
149−instance DropFields RowList.Nil fields fields
150−
151−instance (DropFields rest fields fields'', Row.Cons field t' fields' fields'') => DropFields (RowList.Cons field t rest) fields fields'
152−
153−ungroup
154− :: forall (@field :: Symbol) fields fields' fields'' group group'
155− . IsSymbol field
156− => Row.Cons field (Rel group) fields'' fields
157− => Row.Union group fields'' fields'
158− => RowList.RowToList group group'
159− => AssertNoDuplicates group' fields''
160− => Rel fields
161− -> Rel fields'
162−ungroup (Rel x) = Rel $ Ungroup (reflectSymbol @field Proxy) x
163−
164−class AssertNoDuplicates :: forall k. RowList k -> Row k -> Constraint
165−class AssertNoDuplicates xs ys
166−
167−instance AssertNoDuplicates RowList.Nil ys
168−instance (AssertNoDuplicates rest ys, Row.Lacks field ys) => AssertNoDuplicates (RowList.Cons field t rest) ys
169−
170−---------------------------------------------------------------------------------------------------
171−
172−newtype Foo = Foo { a :: Int, b :: String, x :: Rel (a :: Int, d :: Number) }
173−
174−derive instance Newtype Foo _
175−
176−instance RelVar Foo where
177− relVar = "foo"
178−
179−newtype Bar = Bar { b :: String, c :: Boolean }
180−
181−derive instance Newtype Bar _
182−
183−instance RelVar Bar where
184− relVar = "bar"
185−
186−baz = ungroup @"x" (rel @Foo)