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

Commit 9095d45

Browse files
garybgaryb
authored
Merge pull request #46 from garyb/tweaks
Tweaks
2 parents 0e6fdf4 + da0f12b commit 9095d45

File tree

12 files changed

+187
-136
lines changed

12 files changed

+187
-136
lines changed

‎src/SqlSquared.purs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -22,10 +22,10 @@ import Data.Functor.Mu (Mu)
2222
import Data.Json.Extended as EJ
2323
import Data.Traversable (traverse)
2424
import Matryoshka (cata, anaM)
25-
import SqlSquared.Constructors (array, as, binop, bool, buildSelect, groupBy, having, hugeNum, ident, int, invokeFunction, let_, map_, match, null, num, pars, 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
25+
import SqlSquared.Constructors (array, as, as', binop, bool, buildSelect, groupBy, having, hugeNum, ident, ident', int, invokeFunction, invokeFunction', let', let_, map_, match, match', null, num, parens, projection, select, select', set, splice, string, switch, switch', then_, unop, var, when) as Constructors
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, _Var, _VarRelation, _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, VarRelR, 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: 34 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,8 @@ 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
18-
vari = embed ∘ Sig.Vari
17+
var ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t
18+
var = embed ∘ Sig.Var
1919

2020
bool ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Boolean → t
2121
bool = embed ∘ Sig.Literal ∘ Boolean
@@ -54,19 +54,34 @@ 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
60-
match expr cases else_ = embed $ Sig.Match { expr, cases, else_ }
63+
match expr cases else_ = match' { expr, cases, else_ }
64+
65+
match' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.MatchR t → t
66+
match' = embed ∘ Sig.Match
6167

6268
switch ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ L.List (Sig.Case t) → Maybe t → t
63-
switch cases else_ = embed $ Sig.Switch { cases, else_ }
69+
switch cases else_ = switch' { cases, else_ }
70+
71+
switch' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.SwitchR t → t
72+
switch' = embed ∘ Sig.Switch
6473

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

68-
invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → L.List t → t
69-
invokeFunction name args = embed $ Sig.InvokeFunction {name, args}
77+
let' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.LetR t → t
78+
let' = embed ∘ Sig.Let
79+
80+
invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → L.List t → t
81+
invokeFunction name args = invokeFunction' { name, args }
82+
83+
invokeFunction' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.InvokeFunctionR t → t
84+
invokeFunction' = embed ∘ Sig.InvokeFunction
7085

7186
-- when (bool true) # then_ (num 1.0) :P
7287
when ∷ ∀ t. t → (t → Sig.Case t)
@@ -87,8 +102,7 @@ select
87102
→ Maybe (Sig.OrderBy t)
88103
→ t
89104
select isDistinct projections relations filter gb orderBy =
90-
embed
91-
$ Sig.Select
105+
select'
92106
{ isDistinct
93107
, projections: L.fromFoldable projections
94108
, relations
@@ -97,14 +111,19 @@ select isDistinct projections relations filter gb orderBy =
97111
, orderBy
98112
}
99113

114+
select' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.SelectR t → t
115+
select' = embed ∘ Sig.Select
100116

101117
-- project (ident "foo") # as "bar"
102118
-- project (ident "foo")
103119
projection ∷ ∀ t. t → Sig.Projection t
104120
projection expr = Sig.Projection {expr, alias: Nothing}
105121

106122
as ∷ ∀ t. String → Sig.Projection t → Sig.Projection t
107-
as s (Sig.Projection r) = Sig.Projection r { alias = Just s }
123+
as = as' ∘ Sig.Ident
124+
125+
as' ∷ ∀ t. Sig.Ident → Sig.Projection t → Sig.Projection t
126+
as' s (Sig.Projection r) = Sig.Projection r { alias = Just s }
108127

109128
groupBy ∷ ∀ t f. F.Foldable f ⇒ f t → Sig.GroupBy t
110129
groupBy f = Sig.GroupBy { keys: L.fromFoldable f, having: Nothing }
@@ -114,15 +133,14 @@ having t (Sig.GroupBy r) = Sig.GroupBy r{ having = Just t }
114133

115134
buildSelect ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ (Sig.SelectR t → Sig.SelectR t) → t
116135
buildSelect f =
117-
embed
118-
$ Sig.Select
119-
$ f { isDistinct: false
136+
select' $
137+
f { isDistinct: false
120138
, projections: L.Nil
121139
, relations: Nothing
122140
, filter: Nothing
123141
, groupBy: Nothing
124142
, orderBy: Nothing
125143
}
126144

127-
pars ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t
128-
pars = embed ∘ Sig.Parens
145+
parens ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t
146+
parens = embed ∘ Sig.Parens

‎src/SqlSquared/Lenses.purs‎

Lines changed: 12 additions & 14 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)
@@ -38,9 +36,9 @@ _ExprRelation = prism' S.ExprRelation case _ of
3836
S.ExprRelation r → M.Just r
3937
_ → M.Nothing
4038

41-
_VariRelation ∷ ∀ a. Prism' (S.Relation a) S.VariRelR
42-
_VariRelation = prism' S.VariRelation case _ of
43-
S.VariRelation r → M.Just r
39+
_VarRelation ∷ ∀ a. Prism' (S.Relation a) S.VarRelR
40+
_VarRelation = prism' S.VarRelation case _ of
41+
S.VarRelation r → M.Just r
4442
_ → M.Nothing
4543

4644
_TableRelation ∷ ∀ a. Prism' (S.Relation a) S.TableRelR
@@ -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
@@ -283,13 +281,13 @@ _BoolLiteral = prism' (embed ∘ S.Literal ∘ EJ.Boolean) $ project ⋙ case _
283281
S.Literal (EJ.Boolean b) → M.Just b
284282
_ → M.Nothing
285283

286-
_Vari
284+
_Var
287285
∷ ∀ t f
288286
. Recursive t (S.SqlF f)
289287
⇒ Corecursive t (S.SqlF f)
290-
⇒ Prism' t String
291-
_Vari = prism' (embed ∘ S.Vari) $ project ⋙ case _ of
292-
S.Vari r → M.Just r
288+
⇒ Prism' t S.Ident
289+
_Var = prism' (embed ∘ S.Var) $ project ⋙ case _ of
290+
S.Var r → M.Just r
293291
_ → M.Nothing
294292

295293
_Select

‎src/SqlSquared/Parser.purs‎

Lines changed: 21 additions & 20 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
@@ -414,16 +415,16 @@ import_ = asErrorMessage "import declaration" do
414415
pure $ Sig.Import path
415416

416417
variable ∷ ∀ m t. SqlParser' m t
417-
variable = C.vari <$> variableString
418+
variable = C.var <$> 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
@@ -556,7 +557,7 @@ relation = do
556557
simpleRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
557558
simpleRelation =
558559
tableRelation
559-
<|> variRelation
560+
<|> varRelation
560561
<|> PC.try exprRelation
561562
<|> parenRelation
562563

@@ -570,19 +571,19 @@ parenRelation = do
570571
tableRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
571572
tableRelation = do
572573
i ← ident
573-
path ← Pt.parseAnyFilePath P.fail i
574+
path ← Pt.parseAnyPath P.fail i
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

579-
variRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
580-
variRelation = do
581-
vari ← variableString
580+
varRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
581+
varRelation = do
582+
var ← variableString
582583
a ← PC.optionMaybe do
583584
_ ← keyword "as"
584585
ident
585-
pure $ Sig.VariRelation { alias: a, vari }
586+
pure $ Sig.VarRelation { alias: Ident <$> a, var }
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,16 +683,16 @@ 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
694-
_NOT = C.unop Sig.Not ∘ C.pars
695+
_NOT = C.unop Sig.Not ∘ C.parens
695696

696697
_BINOP ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ t → Sig.BinaryOperator → t → t
697698
_BINOP = flip C.binop

‎src/SqlSquared/Path.purs‎

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,8 @@ module SqlSquared.Path
33
, printAnyFilePath
44
, parseAnyDirPath
55
, printAnyDirPath
6+
, parseAnyPath
7+
, printAnyPath
68
, genAnyFilePath
79
, genAnyDirPath
810
, module PathyTypeReexprts
@@ -20,7 +22,6 @@ import Pathy (AnyDir, AnyFile)
2022
import Pathy.Gen as PtGen
2123
import SqlSquared.Utils ((∘))
2224

23-
2425
printAnyDirPath :: AnyDir -> String
2526
printAnyDirPath = E.either
2627
(Pt.sandboxAny >>> Pt.unsafePrintPath Pt.posixPrinter)
@@ -47,6 +48,17 @@ parseAnyFilePath fail = Pt.parsePath Pt.posixParser
4748
(pure ∘ E.Left)
4849
(fail "Expected valid path")
4950

51+
printAnyPath :: E.Either AnyDir AnyFile -> String
52+
printAnyPath = E.either printAnyDirPath printAnyFilePath
53+
54+
parseAnyPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m (E.Either AnyDir AnyFile)
55+
parseAnyPath fail = Pt.parsePath Pt.posixParser
56+
(pure ∘ E.Left ∘ E.Right)
57+
(pure ∘ E.Left ∘ E.Left)
58+
(pure ∘ E.Right ∘ E.Right)
59+
(pure ∘ E.Right ∘ E.Left)
60+
(fail "Expected valid path")
61+
5062
genAnyFilePath :: forall m. Gen.MonadGen m => MonadRec m => m AnyFile
5163
genAnyFilePath = Gen.oneOf
5264
$ (E.Left <$> PtGen.genAbsFilePath)

0 commit comments

Comments
 (0)