Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Commit 3b26f41

Browse files
garybgaryb
committed
Use a type for identifiers rather than naked strings
1 parent 5b72100 commit 3b26f41

File tree

10 files changed

+99
-79
lines changed

10 files changed

+99
-79
lines changed

‎src/SqlSquared.purs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,9 @@ import Data.Json.Extended as EJ
2323
import Data.Traversable (traverse)
2424
import Matryoshka (cata, anaM)
2525
import SqlSquared.Constructors (array, as, binop, bool, buildSelect, groupBy, having, hugeNum, ident, int, invokeFunction, let_, map_, match, null, num, parens, projection, select, set, splice, string, switch, then_, unop, vari, when) as Constructors
26-
import SqlSquared.Lenses (_ArrayLiteral, _Binop, _BoolLiteral, _Case, _DecimalLiteral, _ExprRelation, _GroupBy, _Ident, _IntLiteral, _InvokeFunction, _JoinRelation, _Let, _Literal, _MapLiteral, _Match, _NullLiteral, _OrderBy, _Parens, _Projection, _Select, _SetLiteral, _Splice, _StringLiteral, _Switch, _TableRelation, _Unop, _Vari, _VariRelation, _alias, _aliasName, _args, _bindTo, _cases, _clause, _cond, _else, _expr, _filter, _groupBy, _having, _ident, _in, _isDistinct, _joinType, _keys, _left, _lhs, _name, _op, _orderBy, _projections, _relations, _rhs, _right, _tablePath) as Lenses
27-
import SqlSquared.Parser (Literal(..), PositionedToken, Token(..), TokenStream, parse, parseModule, parseQuery, prettyParse, printToken, tokenize) as Parser
28-
import SqlSquared.Signature (type (×), BinaryOperator(..), BinopR, Case(..), ExprRelR, FunctionDeclR, GroupBy(..), InvokeFunctionR, JoinRelR, JoinType(..), LetR, MatchR, OrderBy(..), OrderType(..), Projection(..), Relation(..), SelectR, SqlDeclF(..), SqlF(..), SqlModuleF(..), SqlQueryF(..), SwitchR, TableRelR, UnaryOperator(..), UnopR, VariRelR, binopFromString, binopToString, genBinaryOperator, genCase, genGroupBy, genJoinType, genOrderBy, genOrderType, genProjection, genRelation, genSqlDeclF, genSqlF, genSqlModuleF, genSqlQueryF, genUnaryOperator, joinTypeFromString, orderTypeFromString, printBinaryOperator, printCase, printGroupBy, printIdent, printJoinType, printOrderBy, printOrderType, printProjection, printRelation, printSqlDeclF, printSqlF, printSqlModuleF, printSqlQueryF, printUnaryOperator, unopFromString, unopToString, (×), (∘), (⋙)) as Sig
26+
import SqlSquared.Lenses (_ArrayLiteral, _Binop, _BoolLiteral, _Case, _DecimalLiteral, _ExprRelation, _GroupBy, _Identifier, _IntLiteral, _InvokeFunction, _JoinRelation, _Let, _Literal, _MapLiteral, _Match, _NullLiteral, _OrderBy, _Parens, _Projection, _Select, _SetLiteral, _Splice, _StringLiteral, _Switch, _TableRelation, _Unop, _Vari, _VariRelation, _alias, _aliasName, _args, _bindTo, _cases, _clause, _cond, _else, _expr, _filter, _groupBy, _having, _ident, _in, _isDistinct, _joinType, _keys, _left, _lhs, _name, _op, _orderBy, _projections, _relations, _rhs, _right, _tablePath) as Lenses
27+
import SqlSquared.Parser (Literal(..), PositionedToken, parse, parseModule, parseQuery, prettyParse) as Parser
28+
import SqlSquared.Signature (type (×), BinaryOperator(..), BinopR, Case(..), ExprRelR, FunctionDeclR, GroupBy(..), Ident(..), InvokeFunctionR, JoinRelR, JoinType(..), LetR, MatchR, OrderBy(..), OrderType(..), Projection(..), Relation(..), SelectR, SqlDeclF(..), SqlF(..), SqlModuleF(..), SqlQueryF(..), SwitchR, TableRelR, UnaryOperator(..), UnopR, VariRelR, binopFromString, binopToString, genBinaryOperator, genCase, genGroupBy, genJoinType, genOrderBy, genOrderType, genProjection, genRelation, genSqlDeclF, genSqlF, genSqlModuleF, genSqlQueryF, genUnaryOperator, joinTypeFromString, orderTypeFromString, printBinaryOperator, printCase, printGroupBy, printIdent, printJoinType, printOrderBy, printOrderType, printProjection, printRelation, printSqlDeclF, printSqlF, printSqlModuleF, printSqlQueryF, printUnaryOperator, unopFromString, unopToString, (×), (∘), (⋙)) as Sig
2929

3030
type Sql = Mu (Sig.SqlF EJ.EJsonF)
3131

‎src/SqlSquared/Constructors.purs‎

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Matryoshka (class Corecursive, embed)
1414
import SqlSquared.Signature as Sig
1515
import SqlSquared.Utils ((∘))
1616

17-
vari ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t
17+
vari ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t
1818
vari = embed ∘ Sig.Vari
1919

2020
bool ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Boolean → t
@@ -54,18 +54,21 @@ splice ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Maybe t → t
5454
splice = embed ∘ Sig.Splice
5555

5656
ident ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t
57-
ident = embed ∘ Sig.Ident
57+
ident = ident' ∘ Sig.Ident
58+
59+
ident' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t
60+
ident' = embed ∘ Sig.Identifier
5861

5962
match ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → L.List (Sig.Case t) → Maybe t → t
6063
match expr cases else_ = embed $ Sig.Match { expr, cases, else_ }
6164

6265
switch ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ L.List (Sig.Case t) → Maybe t → t
6366
switch cases else_ = embed $ Sig.Switch { cases, else_ }
6467

65-
let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t → t → t
68+
let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t → t → t
6669
let_ id bindTo in_ = embed $ Sig.Let { ident: id, bindTo, in_ }
6770

68-
invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → L.List t → t
71+
invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → L.List t → t
6972
invokeFunction name args = embed $ Sig.InvokeFunction {name, args}
7073

7174
-- when (bool true) # then_ (num 1.0) :P
@@ -104,7 +107,10 @@ projection ∷ ∀ t. t → Sig.Projection t
104107
projection expr = Sig.Projection {expr, alias: Nothing}
105108

106109
as ∷ ∀ t. String → Sig.Projection t → Sig.Projection t
107-
as s (Sig.Projection r) = Sig.Projection r { alias = Just s }
110+
as = as' ∘ Sig.Ident
111+
112+
as' ∷ ∀ t. Sig.Ident → Sig.Projection t → Sig.Projection t
113+
as' s (Sig.Projection r) = Sig.Projection r { alias = Just s }
108114

109115
groupBy ∷ ∀ t f. F.Foldable f ⇒ f t → Sig.GroupBy t
110116
groupBy f = Sig.GroupBy { keys: L.fromFoldable f, having: Nothing }

‎src/SqlSquared/Lenses.purs‎

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -10,9 +10,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
1010
import Data.List as L
1111
import Data.Maybe as M
1212
import Data.NonEmpty as NE
13-
1413
import Matryoshka (class Recursive, class Corecursive, embed, project)
15-
1614
import SqlSquared.Signature as S
1715
import SqlSquared.Utils (type (×), (∘), (⋙))
1816

@@ -25,7 +23,7 @@ _Case = _Newtype
2523
_OrderBy ∷ ∀ a. Iso' (S.OrderBy a) (NE.NonEmpty L.List (S.OrderType × a))
2624
_OrderBy = _Newtype
2725

28-
_Projection ∷ ∀ a. Iso' (S.Projection a) { expr ∷ a, alias ∷ M.Maybe String }
26+
_Projection ∷ ∀ a. Iso' (S.Projection a) { expr ∷ a, alias ∷ M.Maybe S.Ident }
2927
_Projection = _Newtype
3028

3129
_JoinRelation ∷ ∀ a. Prism' (S.Relation a) (S.JoinRelR a)
@@ -193,13 +191,13 @@ _Unop = prism' (embed ∘ S.Unop) $ project ⋙ case _ of
193191
S.Unop r → M.Just r
194192
_ → M.Nothing
195193

196-
_Ident
194+
_Identifier
197195
∷ ∀ t f
198196
. Recursive t (S.SqlF f)
199197
⇒ Corecursive t (S.SqlF f)
200-
⇒ Prism' t String
201-
_Ident = prism' (embed ∘ S.Ident) $ project ⋙ case _ of
202-
S.Ident s → M.Just s
198+
⇒ Prism' t S.Ident
199+
_Identifier = prism' (embed ∘ S.Identifier) $ project ⋙ case _ of
200+
S.Identifier s → M.Just s
203201
_ → M.Nothing
204202

205203
_InvokeFunction
@@ -287,7 +285,7 @@ _Vari
287285
∷ ∀ t f
288286
. Recursive t (S.SqlF f)
289287
⇒ Corecursive t (S.SqlF f)
290-
⇒ Prism' t String
288+
⇒ Prism' t S.Ident
291289
_Vari = prism' (embed ∘ S.Vari) $ project ⋙ case _ of
292290
S.Vari r → M.Just r
293291
_ → M.Nothing

‎src/SqlSquared/Parser.purs‎

Lines changed: 14 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import SqlSquared.Constructors as C
3030
import SqlSquared.Parser.Tokenizer (Token(..), TokenStream, PositionedToken, tokenize, Literal(..), printToken)
3131
import SqlSquared.Path as Pt
3232
import SqlSquared.Signature as Sig
33+
import SqlSquared.Signature.Ident (Ident(..))
3334
import SqlSquared.Utils ((∘), type (×), (×))
3435
import Text.Parsing.Parser as P
3536
import Text.Parsing.Parser.Combinators as PC
@@ -177,7 +178,7 @@ letExpr = do
177178
bindTo ← expr
178179
operator ";"
179180
in_ ← expr
180-
pure $ C.let_ i bindTo in_
181+
pure $ C.let_ (Ident i) bindTo in_
181182

182183
queryExpr ∷ ∀ m t. SqlParser' m t
183184
queryExpr = prod (query <|> definedExpr) queryBinop _BINOP
@@ -310,7 +311,7 @@ primaryExpr = asErrorMessage "primary expression" $ PC.choice
310311
, wildcard
311312
, arrayLiteral
312313
, mapLiteral
313-
, ident <#> embed ∘ Sig.Ident
314+
, ident <#> embed ∘ Sig.Identifier ∘ Ident
314315
]
315316

316317
caseExpr ∷ ∀ m t. SqlParser' m t
@@ -385,7 +386,7 @@ functionExpr ∷ ∀ m t. SqlParser' m t
385386
functionExpr = PC.try do
386387
name ← ident <|> anyKeyword
387388
args ← parenList
388-
pure $ C.invokeFunction (S.toUpper name) args
389+
pure $ C.invokeFunction (Ident (S.toUpper name)) args
389390

390391
functionDecl
391392
∷ ∀ m a
@@ -401,7 +402,7 @@ functionDecl parseExpr = asErrorMessage "function declaration" do
401402
_ ← keyword "begin"
402403
body ← parseExpr
403404
_ ← keyword "end"
404-
pure $ Sig.FunctionDecl { ident: name, args, body }
405+
pure $ Sig.FunctionDecl { ident: Ident name, args, body }
405406

406407
import_
407408
∷ ∀ m a
@@ -416,14 +417,14 @@ import_ = asErrorMessage "import declaration" do
416417
variable ∷ ∀ m t. SqlParser' m t
417418
variable = C.vari <$> variableString
418419

419-
variableString ∷ ∀ m. Monad m ⇒ P.ParserT TokenStream m String
420+
variableString ∷ ∀ m. Monad m ⇒ P.ParserT TokenStream m Ident
420421
variableString = asErrorMessage "variable" $ PC.try do
421422
operator ":"
422423
PP.Position pos1 ← P.position
423424
s ← ident <|> anyKeyword
424425
PP.Position pos2 ← P.position
425426
guard (pos1.line == pos2.line && pos2.column == pos1.column + 1)
426-
pure s
427+
pure (Ident s)
427428

428429
literal ∷ ∀ m t. SqlParser' m t
429430
literal = withToken "literal" case _ of
@@ -477,7 +478,7 @@ betweenSuffix = do
477478
lhs ← defaultExpr
478479
_ ← keyword "and"
479480
rhs ← defaultExpr
480-
pure \e → C.invokeFunction "BETWEEN" (e : lhs : rhs : L.Nil)
481+
pure \e → C.invokeFunction (Ident "BETWEEN") (e : lhs : rhs : L.Nil)
481482

482483
inSuffix ∷ ∀ m t. SqlParser m t (t → t)
483484
inSuffix = do
@@ -574,15 +575,15 @@ tableRelation = do
574575
a ← PC.optionMaybe do
575576
_ ← keyword "as"
576577
ident
577-
pure $ Sig.TableRelation { alias: a, path }
578+
pure $ Sig.TableRelation { alias: Ident <$> a, path }
578579

579580
variRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
580581
variRelation = do
581582
vari ← variableString
582583
a ← PC.optionMaybe do
583584
_ ← keyword "as"
584585
ident
585-
pure $ Sig.VariRelation { alias: a, vari }
586+
pure $ Sig.VariRelation { alias: Ident <$> a, vari }
586587

587588
exprRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
588589
exprRelation = do
@@ -591,7 +592,7 @@ exprRelation = do
591592
operator ")"
592593
_ ← keyword "as"
593594
i ← ident
594-
pure $ Sig.ExprRelation { aliasName: i, expr: e }
595+
pure $ Sig.ExprRelation { alias: Ident i, expr: e }
595596

596597
stdJoinRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t → Sig.Relation t)
597598
stdJoinRelation = do
@@ -682,13 +683,13 @@ projection ∷ ∀ m t. SqlParser m t (Sig.Projection t)
682683
projection = do
683684
e ← definedExpr
684685
a ← PC.optionMaybe (keyword "as" *> ident)
685-
pure $ Sig.Projection { expr: e, alias: a }
686+
pure $ Sig.Projection { expr: e, alias: Ident <$> a }
686687

687688
_SEARCH ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ Boolean → t → t → t
688-
_SEARCH b lhs rhs = C.invokeFunction "SEARCH" $ lhs : rhs : (C.bool b) : L.Nil
689+
_SEARCH b lhs rhs = C.invokeFunction (Ident "SEARCH") $ lhs : rhs : (C.bool b) : L.Nil
689690

690691
_LIKE ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ Maybe t → t → t → t
691-
_LIKE mbEsc lhs rhs = C.invokeFunction "LIKE" $ lhs : rhs : (fromMaybe (C.string "\\") mbEsc) : L.Nil
692+
_LIKE mbEsc lhs rhs = C.invokeFunction (Ident "LIKE") $ lhs : rhs : (fromMaybe (C.string "\\") mbEsc) : L.Nil
692693

693694
_NOT ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ t → t
694695
_NOT = C.unop Sig.Not ∘ C.parens

‎src/SqlSquared/Signature.purs‎

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ import SqlSquared.Path as Pt
5656
import SqlSquared.Signature.BinaryOperator (BinaryOperator(..), binopFromString, binopToString, genBinaryOperator, printBinaryOperator) as BO
5757
import SqlSquared.Signature.Case (Case(..), genCase, printCase) as CS
5858
import SqlSquared.Signature.GroupBy (GroupBy(..), genGroupBy, printGroupBy) as GB
59-
import SqlSquared.Signature.Ident (printIdent) as ID
59+
import SqlSquared.Signature.Ident (Ident(..), printIdent) as ID
6060
import SqlSquared.Signature.JoinType (JoinType(..), genJoinType, joinTypeFromString, printJoinType) as JT
6161
import SqlSquared.Signature.OrderBy (OrderBy(..), genOrderBy, printOrderBy) as OB
6262
import SqlSquared.Signature.OrderType (OrderType(..), genOrderType, orderTypeFromString, printOrderType) as OT
@@ -77,7 +77,7 @@ type UnopR a =
7777
}
7878

7979
type InvokeFunctionR a =
80-
{ name ∷ String
80+
{ name ∷ ID.Ident
8181
, args ∷ L.List a
8282
}
8383

@@ -93,7 +93,7 @@ type SwitchR a =
9393
}
9494

9595
type LetR a =
96-
{ ident ∷ String
96+
{ ident ∷ ID.Ident
9797
, bindTo ∷ a
9898
, in_ ∷ a
9999
}
@@ -108,8 +108,8 @@ type SelectR a =
108108
}
109109

110110
type FunctionDeclR a =
111-
{ ident ∷ String
112-
, args ∷ L.List String
111+
{ ident ∷ ID.Ident
112+
, args ∷ L.List ID.Ident
113113
, body ∷ a
114114
}
115115

@@ -119,12 +119,12 @@ data SqlF literal a
119119
| Splice (Maybe a)
120120
| Binop (BinopR a)
121121
| Unop (UnopR a)
122-
| Ident String
122+
| Identifier ID.Ident
123123
| InvokeFunction (InvokeFunctionR a)
124124
| Match (MatchR a)
125125
| Switch (SwitchR a)
126126
| Let (LetR a)
127-
| Vari String
127+
| Vari ID.Ident
128128
| Select (SelectR a)
129129
| Parens a
130130

@@ -166,7 +166,7 @@ derive instance functorSqlModuleF ∷ Functor SqlModuleF
166166

167167
instance foldableSqlF ∷ F.Foldable l ⇒ F.Foldable (SqlF l) where
168168
foldMap f = case _ of
169-
Ident _ → mempty
169+
Identifier _ → mempty
170170
SetLiteral lst → F.foldMap f lst
171171
Splice mbA → F.foldMap f mbA
172172
Binop { lhs, rhs } → f lhs <> f rhs
@@ -185,7 +185,7 @@ instance foldableSqlF ∷ F.Foldable l ⇒ F.Foldable (SqlF l) where
185185
Parens a → f a
186186
Literal l → F.foldMap f l
187187
foldl f a = case _ of
188-
Ident _ → a
188+
Identifier _ → a
189189
SetLiteral lst → F.foldl f a lst
190190
Splice mbA → F.foldl f a mbA
191191
Binop { lhs, rhs } → f (f a lhs) rhs
@@ -212,7 +212,7 @@ instance foldableSqlF ∷ F.Foldable l ⇒ F.Foldable (SqlF l) where
212212
Parens p → f a p
213213
Literal l → F.foldl f a l
214214
foldr f a = case _ of
215-
Ident _ → a
215+
Identifier _ → a
216216
SetLiteral lst → F.foldr f a lst
217217
Splice mbA → F.foldr f a mbA
218218
Binop { lhs, rhs } → f rhs $ f lhs a
@@ -269,7 +269,7 @@ instance traversableSqlF ∷ T.Traversable l ⇒ T.Traversable (SqlF l) where
269269
map Binop $ { lhs: _, rhs: _, op } <$> f lhs <*> f rhs
270270
Unop { op, expr } →
271271
map Unop $ { expr: _, op } <$> f expr
272-
Ident s → pure $ Ident s
272+
Identifier s → pure $ Identifier s
273273
InvokeFunction { name, args } →
274274
map InvokeFunction $ { name, args:_ } <$> T.traverse f args
275275
Match { expr, cases, else_ } →
@@ -331,10 +331,10 @@ printSqlF printLiteralF = case _ of
331331
BO.printBinaryOperator lhs rhs op
332332
Unop {expr, op} →
333333
UO.printUnaryOperator expr op
334-
Ident s →
334+
Identifier s →
335335
ID.printIdent s
336336
InvokeFunction {name, args} →
337-
name <> "(" <> F.intercalate ", " args <> ")"
337+
ID.printIdent name <> "(" <> F.intercalate ", " args <> ")"
338338
Match { expr, cases, else_ } →
339339
"CASE "
340340
<> expr
@@ -372,7 +372,7 @@ printSqlDeclF = case _ of
372372
<> body
373373
<> " END"
374374
Import path →
375-
"IMPORT " <> ID.printIdent (Pt.printAnyDirPath path)
375+
"IMPORT " <> ID.printIdent (ID.Ident (Pt.printAnyDirPath path))
376376

377377
printSqlQueryF ∷ Algebra SqlQueryF String
378378
printSqlQueryF (Query decls expr) = F.intercalate "; " $ L.snoc (printSqlDeclF <$> decls) expr
@@ -389,7 +389,7 @@ genSqlF
389389
genSqlF genLiteral n
390390
| n < 2 =
391391
Gen.oneOf $ (Literal <$> genLiteral n) :|
392-
[ map Ident genIdent
392+
[ map Identifier genIdent
393393
, map Vari genIdent
394394
, pure $ Splice Nothing
395395
, pure $ SetLiteral L.Nil
@@ -528,11 +528,11 @@ genFunctionDecl n = do
528528
genImport ∷ ∀ m a. Gen.MonadGen m ⇒ MonadRec m ⇒ m (SqlDeclF a)
529529
genImport = map Import Pt.genAnyDirPath
530530

531-
genIdent ∷ ∀ m. Gen.MonadGen m ⇒ m String
531+
genIdent ∷ ∀ m. Gen.MonadGen m ⇒ m ID.Ident
532532
genIdent = do
533533
start ← Gen.elements $ "a" :| S.split (S.Pattern "") "bcdefghijklmnopqrstuvwxyz"
534534
body ← map (Int.toStringAs Int.hexadecimal) (Gen.chooseInt 0 100000)
535-
pure $ start <> body
535+
pure $ ID.Ident (start <> body)
536536

537537
genDecls ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ Int → m (L.List (SqlDeclF Int))
538538
genDecls n = do
@@ -614,7 +614,7 @@ genPrimaryExprP n =
614614
, genArrayP n
615615
, genMapP n
616616
, genSpliceP n
617-
, map (embed ∘ Ident) genIdent
617+
, map (embed ∘ Identifier) genIdent
618618
]
619619

620620
genCaseP ∷ ∀ m t. Int → GenSql m t

0 commit comments

Comments
 (0)