|
1 | | -module SqlSquared.Constructors where |
2 | | - |
3 | | -import Prelude |
4 | | - |
5 | | -import Data.Array as Arr |
6 | | -import Data.Json.Extended.Signature (EJsonF(..), EJsonMap(..)) |
7 | | -import Data.Foldable as F |
8 | | -import Data.HugeNum as HN |
9 | | -import Data.List as L |
10 | | -import Data.Map as Map |
11 | | -import Data.Maybe (Maybe(..)) |
12 | | - |
13 | | -import Matryoshka (class Corecursive, embed) |
14 | | - |
15 | | -import SqlSquared.Signature as Sig |
16 | | -import SqlSquared.Utils ((∘)) |
17 | | - |
18 | | -vari ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t |
19 | | -vari = embed ∘ Sig.Vari |
20 | | - |
21 | | -bool ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Boolean → t |
22 | | -bool = embed ∘ Sig.Literal ∘ Boolean |
23 | | - |
24 | | -null ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ t |
25 | | -null = embed $ Sig.Literal Null |
26 | | - |
27 | | -int ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Int → t |
28 | | -int = embed ∘ Sig.Literal ∘ Integer |
29 | | - |
30 | | -num ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Number → t |
31 | | -num = embed ∘ Sig.Literal ∘ Decimal ∘ HN.fromNumber |
32 | | - |
33 | | -hugeNum ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ HN.HugeNum → t |
34 | | -hugeNum = embed ∘ Sig.Literal ∘ Decimal |
35 | | - |
36 | | -string ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ String → t |
37 | | -string = embed ∘ Sig.Literal ∘ String |
38 | | - |
39 | | -unop ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.UnaryOperator → t → t |
40 | | -unop op expr = embed $ Sig.Unop { op, expr } |
41 | | - |
42 | | -binop ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.BinaryOperator → t → t → t |
43 | | -binop op lhs rhs = embed $ Sig.Binop { op, lhs, rhs } |
44 | | - |
45 | | -set ∷ ∀ t f g. Corecursive t (Sig.SqlF g) ⇒ F.Foldable f ⇒ f t → t |
46 | | -set = embed ∘ Sig.SetLiteral ∘ L.fromFoldable |
47 | | - |
48 | | -array ∷ ∀ t f. Corecursive t (Sig.SqlF EJsonF) ⇒ F.Foldable f ⇒ f t → t |
49 | | -array = embed ∘ Sig.Literal ∘ Array ∘ Arr.fromFoldable |
50 | | - |
51 | | -map_ ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Ord t ⇒ Map.Map t t → t |
52 | | -map_ = embed ∘ Sig.Literal ∘ Map ∘ EJsonMap ∘ Map.toUnfoldable |
53 | | - |
54 | | -splice ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Maybe t → t |
55 | | -splice = embed ∘ Sig.Splice |
56 | | - |
57 | | -ident ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t |
58 | | -ident = embed ∘ Sig.Ident |
59 | | - |
60 | | -match ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → L.List (Sig.Case t) → Maybe t → t |
61 | | -match expr cases else_ = embed $ Sig.Match { expr, cases, else_ } |
62 | | - |
63 | | -switch ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ L.List (Sig.Case t) → Maybe t → t |
64 | | -switch cases else_ = embed $ Sig.Switch { cases, else_ } |
65 | | - |
66 | | -let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t → t → t |
67 | | -let_ id bindTo in_ = embed $ Sig.Let { ident: id, bindTo, in_ } |
68 | | - |
69 | | -invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → L.List t → t |
70 | | -invokeFunction name args = embed $ Sig.InvokeFunction {name, args} |
71 | | - |
72 | | --- when (bool true) # then_ (num 1.0) :P |
73 | | -when ∷ ∀ t. t → (t → Sig.Case t) |
74 | | -when cond = Sig.Case ∘ { cond, expr: _ } |
75 | | - |
76 | | -then_ ∷ ∀ t. t → (t → Sig.Case t) → Sig.Case t |
77 | | -then_ t f = f t |
78 | | - |
79 | | -select |
80 | | - ∷ ∀ t f |
81 | | - . Corecursive t (Sig.SqlF EJsonF) |
82 | | - ⇒ F.Foldable f |
83 | | - ⇒ Boolean |
84 | | - → f (Sig.Projection t) |
85 | | - → Maybe (Sig.Relation t) |
86 | | - → Maybe t |
87 | | - → Maybe (Sig.GroupBy t) |
88 | | - → Maybe (Sig.OrderBy t) |
89 | | - → t |
90 | | -select isDistinct projections relations filter gb orderBy = |
91 | | - embed |
92 | | - $ Sig.Select |
93 | | - { isDistinct |
94 | | - , projections: L.fromFoldable projections |
95 | | - , relations |
96 | | - , filter |
97 | | - , groupBy: gb |
98 | | - , orderBy |
99 | | - } |
100 | | - |
101 | | - |
102 | | --- project (ident "foo") # as "bar" |
103 | | --- project (ident "foo") |
104 | | -projection ∷ ∀ t. t → Sig.Projection t |
105 | | -projection expr = Sig.Projection {expr, alias: Nothing} |
106 | | - |
107 | | -as ∷ ∀ t. String → Sig.Projection t → Sig.Projection t |
108 | | -as s (Sig.Projection r) = Sig.Projection r { alias = Just s } |
109 | | - |
110 | | -groupBy ∷ ∀ t f. F.Foldable f ⇒ f t → Sig.GroupBy t |
111 | | -groupBy f = Sig.GroupBy { keys: L.fromFoldable f, having: Nothing } |
112 | | - |
113 | | -having ∷ ∀ t. t → Sig.GroupBy t → Sig.GroupBy t |
114 | | -having t (Sig.GroupBy r) = Sig.GroupBy r{ having = Just t } |
115 | | - |
116 | | -buildSelect ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ (Sig.SelectR t → Sig.SelectR t) → t |
117 | | -buildSelect f = |
118 | | - embed |
119 | | - $ Sig.Select |
120 | | - $ f { isDistinct: false |
121 | | - , projections: L.Nil |
122 | | - , relations: Nothing |
123 | | - , filter: Nothing |
124 | | - , groupBy: Nothing |
125 | | - , orderBy: Nothing |
126 | | - } |
127 | | - |
128 | | -pars ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t |
129 | | -pars = embed ∘ Sig.Parens |
| 1 | +module SqlSquared.Constructors where |
| 2 | + |
| 3 | +import Prelude |
| 4 | + |
| 5 | +import Data.Array as Arr |
| 6 | +import Data.Json.Extended.Signature (EJsonF(..), EJsonMap(..)) |
| 7 | +import Data.Foldable as F |
| 8 | +import Data.HugeNum as HN |
| 9 | +import Data.List as L |
| 10 | +import Data.Map as Map |
| 11 | +import Data.Maybe (Maybe(..)) |
| 12 | + |
| 13 | +import Matryoshka (class Corecursive, embed) |
| 14 | + |
| 15 | +import SqlSquared.Signature as Sig |
| 16 | +import SqlSquared.Utils ((∘)) |
| 17 | + |
| 18 | +vari ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t |
| 19 | +vari = embed ∘ Sig.Vari |
| 20 | + |
| 21 | +bool ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Boolean → t |
| 22 | +bool = embed ∘ Sig.Literal ∘ Boolean |
| 23 | + |
| 24 | +null ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ t |
| 25 | +null = embed $ Sig.Literal Null |
| 26 | + |
| 27 | +int ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Int → t |
| 28 | +int = embed ∘ Sig.Literal ∘ Integer |
| 29 | + |
| 30 | +num ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Number → t |
| 31 | +num = embed ∘ Sig.Literal ∘ Decimal ∘ HN.fromNumber |
| 32 | + |
| 33 | +hugeNum ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ HN.HugeNum → t |
| 34 | +hugeNum = embed ∘ Sig.Literal ∘ Decimal |
| 35 | + |
| 36 | +string ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ String → t |
| 37 | +string = embed ∘ Sig.Literal ∘ String |
| 38 | + |
| 39 | +unop ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.UnaryOperator → t → t |
| 40 | +unop op expr = embed $ Sig.Unop { op, expr } |
| 41 | + |
| 42 | +binop ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.BinaryOperator → t → t → t |
| 43 | +binop op lhs rhs = embed $ Sig.Binop { op, lhs, rhs } |
| 44 | + |
| 45 | +set ∷ ∀ t f g. Corecursive t (Sig.SqlF g) ⇒ F.Foldable f ⇒ f t → t |
| 46 | +set = embed ∘ Sig.SetLiteral ∘ L.fromFoldable |
| 47 | + |
| 48 | +array ∷ ∀ t f. Corecursive t (Sig.SqlF EJsonF) ⇒ F.Foldable f ⇒ f t → t |
| 49 | +array = embed ∘ Sig.Literal ∘ Array ∘ Arr.fromFoldable |
| 50 | + |
| 51 | +map_ ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Ord t ⇒ Map.Map t t → t |
| 52 | +map_ = embed ∘ Sig.Literal ∘ Map ∘ EJsonMap ∘ Map.toUnfoldable |
| 53 | + |
| 54 | +splice ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Maybe t → t |
| 55 | +splice = embed ∘ Sig.Splice |
| 56 | + |
| 57 | +ident ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t |
| 58 | +ident = embed ∘ Sig.Ident |
| 59 | + |
| 60 | +match ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → L.List (Sig.Case t) → Maybe t → t |
| 61 | +match expr cases else_ = embed $ Sig.Match { expr, cases, else_ } |
| 62 | + |
| 63 | +switch ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ L.List (Sig.Case t) → Maybe t → t |
| 64 | +switch cases else_ = embed $ Sig.Switch { cases, else_ } |
| 65 | + |
| 66 | +let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t → t → t |
| 67 | +let_ id bindTo in_ = embed $ Sig.Let { ident: id, bindTo, in_ } |
| 68 | + |
| 69 | +invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → L.List t → t |
| 70 | +invokeFunction name args = embed $ Sig.InvokeFunction {name, args} |
| 71 | + |
| 72 | +-- when (bool true) # then_ (num 1.0) :P |
| 73 | +when ∷ ∀ t. t → (t → Sig.Case t) |
| 74 | +when cond = Sig.Case ∘ { cond, expr: _ } |
| 75 | + |
| 76 | +then_ ∷ ∀ t. t → (t → Sig.Case t) → Sig.Case t |
| 77 | +then_ t f = f t |
| 78 | + |
| 79 | +select |
| 80 | + ∷ ∀ t f |
| 81 | + . Corecursive t (Sig.SqlF EJsonF) |
| 82 | + ⇒ F.Foldable f |
| 83 | + ⇒ Boolean |
| 84 | + → f (Sig.Projection t) |
| 85 | + → Maybe (Sig.Relation t) |
| 86 | + → Maybe t |
| 87 | + → Maybe (Sig.GroupBy t) |
| 88 | + → Maybe (Sig.OrderBy t) |
| 89 | + → t |
| 90 | +select isDistinct projections relations filter gb orderBy = |
| 91 | + embed |
| 92 | + $ Sig.Select |
| 93 | + { isDistinct |
| 94 | + , projections: L.fromFoldable projections |
| 95 | + , relations |
| 96 | + , filter |
| 97 | + , groupBy: gb |
| 98 | + , orderBy |
| 99 | + } |
| 100 | + |
| 101 | + |
| 102 | +-- project (ident "foo") # as "bar" |
| 103 | +-- project (ident "foo") |
| 104 | +projection ∷ ∀ t. t → Sig.Projection t |
| 105 | +projection expr = Sig.Projection {expr, alias: Nothing} |
| 106 | + |
| 107 | +as ∷ ∀ t. String → Sig.Projection t → Sig.Projection t |
| 108 | +as s (Sig.Projection r) = Sig.Projection r { alias = Just s } |
| 109 | + |
| 110 | +groupBy ∷ ∀ t f. F.Foldable f ⇒ f t → Sig.GroupBy t |
| 111 | +groupBy f = Sig.GroupBy { keys: L.fromFoldable f, having: Nothing } |
| 112 | + |
| 113 | +having ∷ ∀ t. t → Sig.GroupBy t → Sig.GroupBy t |
| 114 | +having t (Sig.GroupBy r) = Sig.GroupBy r{ having = Just t } |
| 115 | + |
| 116 | +buildSelect ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ (Sig.SelectR t → Sig.SelectR t) → t |
| 117 | +buildSelect f = |
| 118 | + embed |
| 119 | + $ Sig.Select |
| 120 | + $ f { isDistinct: false |
| 121 | + , projections: L.Nil |
| 122 | + , relations: Nothing |
| 123 | + , filter: Nothing |
| 124 | + , groupBy: Nothing |
| 125 | + , orderBy: Nothing |
| 126 | + } |
| 127 | + |
| 128 | +pars ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t |
| 129 | +pars = embed ∘ Sig.Parens |
0 commit comments