@@ -1,186 +0,0 @@
1−module ProjectM36 where
8−import Data.Newtype (class Newtype)
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
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
26−type RelVarName = String
27−type Attribute = String
29−class RelVar :: forall k. k -> Constraint
30−class RelVar rel where
33−rel :: forall @rel fields. Newtype rel (Record fields) => RelVar rel => Rel fields
34−rel = Rel $ RelationVariable (relVar @rel)
36−newtype Rel (fields :: Row Type) = Rel Expr
38−union :: forall fields. Rel fields -> Rel fields -> Rel fields
39−union (Rel x) (Rel y) = Rel $ Union x y
41−difference :: forall fields. Rel fields -> Rel fields -> Rel fields
42−difference (Rel x) (Rel y) = Rel $ Difference x y
45− :: forall lhs rhs res lhs' rhs' res'
47− => RowToList lhs lhs'
48− => RowToList rhs rhs'
49− => AssertNoConflict lhs' res'
50− => AssertNoConflict rhs' res'
55−join (Rel lhs) (Rel rhs) = Rel $ Join lhs rhs
57−class AssertNoConflict :: forall k. RowList k -> Row k -> Constraint
58−class AssertNoConflict xs ys
60−instance AssertNoConflict Nil xs
61−instance (AssertNoConflict ys xs, Row.Cons l y xs' xs) => AssertNoConflict (RowList.Cons l y ys) xs
64− :: forall @rename rename' fields fields'
65− . RowList.RowToList rename rename'
66− => RenameRel rename' fields fields'
67− => ReifyRename rename'
70−rename (Rel x) = Rel $ Rename (reifyRename @rename') x
72−class ReifyRename :: RowList Symbol -> Constraint
73−class ReifyRename rename where
74− reifyRename :: Object Attribute
76−instance ReifyRename RowList.Nil where
77− reifyRename = Object.empty
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)
82−class RenameRel :: forall k. RowList Symbol -> Row k -> Row k -> Constraint
83−class RenameRel rename fields fields' | rename fields -> fields'
85−instance RenameRel RowList.Nil fields fields
87− ( Row.Cons from t fields' fields
88− , Row.Cons to t fields' fields''
90− RenameRel (RowList.Cons from to rest) fields fields''
93− :: forall @projection projection' fields fields'
94− . ProjectRel projection' fields fields'
95− => RowList.RowToList projection projection'
96− => ReifyFields projection'
99−project (Rel x) = Rel $ Project (reifyFields @projection') x
101−class ProjectRel :: forall k l. RowList k -> Row l -> Row l -> Constraint
102−class ProjectRel projection fields fields' | projection fields -> fields'
104−instance ProjectRel RowList.Nil fields ()
106− ( ProjectRel rest fields fields''
107− , Row.Cons field value f fields
108− , Row.Cons field value fields'' fields'
110− ProjectRel (RowList.Cons field v rest) fields fields'
112−class ReifyFields :: forall k. RowList k -> Constraint
113−class ReifyFields row where
114− reifyFields :: Set Attribute
116−instance ReifyFields RowList.Nil where
117− reifyFields = Set.empty
119−instance (IsSymbol field, ReifyFields rest) => ReifyFields (RowList.Cons field v rest) where
120− reifyFields = Set.insert (reflectSymbol @field Proxy) (reifyFields @rest)
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'
132−group (Rel x) = Rel $ Group (reifyFields @group') (reflectSymbol @field Proxy) x
134−class GroupRel :: forall k l. RowList l -> Row k -> Row k -> Constraint
135−class GroupRel group fields groupped | group fields -> groupped
137−instance GroupRel RowList.Nil fields ()
140− ( GroupRel rest fields fields''
141− , Row.Cons field t f fields
142− , Row.Cons field t fields'' fields'
144− GroupRel (RowList.Cons field u rest) fields fields'
146−class DropFields :: forall l k. RowList l -> Row k -> Row k -> Constraint
147−class DropFields drop fields fields' | drop fields -> fields'
149−instance DropFields RowList.Nil fields fields
151−instance (DropFields rest fields fields'', Row.Cons field t' fields' fields'') => DropFields (RowList.Cons field t rest) fields fields'
154− :: forall (@field :: Symbol) fields fields' fields'' group group'
156− => Row.Cons field (Rel group) fields'' fields
157− => Row.Union group fields'' fields'
158− => RowList.RowToList group group'
159− => AssertNoDuplicates group' fields''
162−ungroup (Rel x) = Rel $ Ungroup (reflectSymbol @field Proxy) x
164−class AssertNoDuplicates :: forall k. RowList k -> Row k -> Constraint
165−class AssertNoDuplicates xs ys
167−instance AssertNoDuplicates RowList.Nil ys
168−instance (AssertNoDuplicates rest ys, Row.Lacks field ys) => AssertNoDuplicates (RowList.Cons field t rest) ys
170−---------------------------------------------------------------------------------------------------
172−newtype Foo = Foo { a :: Int, b :: String, x :: Rel (a :: Int, d :: Number) }
174−derive instance Newtype Foo _
176−instance RelVar Foo where
179−newtype Bar = Bar { b :: String, c :: Boolean }
181−derive instance Newtype Bar _
183−instance RelVar Bar where
186−baz = ungroup @"x" (rel @Foo)