Merge pull request #46 from garyb/tweaks

Tweaks

src/SqlSquared.purs

@@ -22,10 +22,10 @@ import Data.Functor.Mu (Mu)
 import Data.Json.Extended as EJ
 import Data.Traversable (traverse)
 import Matryoshka (cata, anaM)
-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
-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
-import SqlSquared.Parser (Literal(..), PositionedToken, Token(..), TokenStream, parse, parseModule, parseQuery, prettyParse, printToken, tokenize) as Parser
-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
+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
+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
+import SqlSquared.Parser (Literal(..), PositionedToken, parse, parseModule, parseQuery, prettyParse) as Parser
+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
 
 type Sql = Mu (Sig.SqlF EJ.EJsonF)
 

src/SqlSquared/Constructors.purs

@@ -14,8 +14,8 @@ import Matryoshka (class Corecursive, embed)
 import SqlSquared.Signature as Sig
 import SqlSquared.Utils ((∘))
 
-vari ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t
-vari = embed ∘ Sig.Vari
+var ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t
+var = embed ∘ Sig.Var
 
 bool ∷ ∀ t. Corecursive t (Sig.SqlF EJsonF) ⇒ Boolean → t
 bool = embed ∘ Sig.Literal ∘ Boolean
@@ -54,19 +54,34 @@ splice ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Maybe t → t
 splice = embed ∘ Sig.Splice
 
 ident ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t
-ident = embed ∘ Sig.Ident
+ident = ident' ∘ Sig.Ident
+
+ident' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t
+ident' = embed ∘ Sig.Identifier
 
 match ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → L.List (Sig.Case t) → Maybe t → t
-match expr cases else_ = embed $ Sig.Match { expr, cases, else_ }
+match expr cases else_ = match' { expr, cases, else_ }
+
+match' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.MatchR t → t
+match' = embed ∘ Sig.Match
 
 switch ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ L.List (Sig.Case t) → Maybe t → t
-switch cases else_ = embed $ Sig.Switch { cases, else_ }
+switch cases else_ = switch' { cases, else_ }
+
+switch' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.SwitchR t → t
+switch' = embed ∘ Sig.Switch
 
-let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → t → t → t
+let_ ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → t → t → t
 let_ id bindTo in_ = embed $ Sig.Let { ident: id, bindTo, in_ }
 
-invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ String → L.List t → t
-invokeFunction name args = embed $ Sig.InvokeFunction {name, args}
+let' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.LetR t → t
+let' = embed ∘ Sig.Let
+
+invokeFunction ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.Ident → L.List t → t
+invokeFunction name args = invokeFunction' { name, args }
+
+invokeFunction' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.InvokeFunctionR t → t
+invokeFunction' = embed ∘ Sig.InvokeFunction
 
 -- when (bool true) # then_ (num 1.0) :P
 when ∷ ∀ t. t → (t → Sig.Case t)
@@ -87,8 +102,7 @@ select
   → Maybe (Sig.OrderBy t)
   → t
 select isDistinct projections relations filter gb orderBy =
-  embed
-  $ Sig.Select
+  select'
     { isDistinct
     , projections: L.fromFoldable projections
     , relations
@@ -97,14 +111,19 @@ select isDistinct projections relations filter gb orderBy =
     , orderBy
     }
 
+select' ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ Sig.SelectR t → t
+select' = embed ∘ Sig.Select
 
 -- project (ident "foo") # as "bar"
 -- project (ident "foo")
 projection ∷ ∀ t. t → Sig.Projection t
 projection expr = Sig.Projection {expr, alias: Nothing}
 
 as ∷ ∀ t. String → Sig.Projection t → Sig.Projection t
-as s (Sig.Projection r) = Sig.Projection r { alias = Just s }
+as = as' ∘ Sig.Ident
+
+as' ∷ ∀ t. Sig.Ident → Sig.Projection t → Sig.Projection t
+as' s (Sig.Projection r) = Sig.Projection r { alias = Just s }
 
 groupBy ∷ ∀ t f. F.Foldable f ⇒ f t → Sig.GroupBy t
 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 }
 
 buildSelect ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ (Sig.SelectR t → Sig.SelectR t) → t
 buildSelect f =
-  embed
-  $ Sig.Select
-  $ f { isDistinct: false
+  select' $
+    f { isDistinct: false
       , projections: L.Nil
       , relations: Nothing
       , filter: Nothing
       , groupBy: Nothing
       , orderBy: Nothing
       }
 
-pars ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t
-pars = embed ∘ Sig.Parens
+parens ∷ ∀ t f. Corecursive t (Sig.SqlF f) ⇒ t → t
+parens = embed ∘ Sig.Parens

src/SqlSquared/Lenses.purs

@@ -10,9 +10,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List as L
 import Data.Maybe as M
 import Data.NonEmpty as NE
-
 import Matryoshka (class Recursive, class Corecursive, embed, project)
-
 import SqlSquared.Signature as S
 import SqlSquared.Utils (type (×), (∘), (⋙))
 
@@ -25,7 +23,7 @@ _Case = _Newtype
 _OrderBy ∷ ∀ a. Iso' (S.OrderBy a) (NE.NonEmpty L.List (S.OrderType × a))
 _OrderBy = _Newtype
 
-_Projection ∷ ∀ a. Iso' (S.Projection a) { expr ∷ a, alias ∷ M.Maybe String }
+_Projection ∷ ∀ a. Iso' (S.Projection a) { expr ∷ a, alias ∷ M.Maybe S.Ident }
 _Projection = _Newtype
 
 _JoinRelation ∷ ∀ a. Prism' (S.Relation a) (S.JoinRelR a)
@@ -38,9 +36,9 @@ _ExprRelation = prism' S.ExprRelation case _ of
   S.ExprRelation r → M.Just r
   _ → M.Nothing
 
-_VariRelation ∷ ∀ a. Prism' (S.Relation a) S.VariRelR
-_VariRelation = prism' S.VariRelation case _ of
-  S.VariRelation r → M.Just r
+_VarRelation ∷ ∀ a. Prism' (S.Relation a) S.VarRelR
+_VarRelation = prism' S.VarRelation case _ of
+  S.VarRelation r → M.Just r
   _ → M.Nothing
 
 _TableRelation ∷ ∀ a. Prism' (S.Relation a) S.TableRelR
@@ -193,13 +191,13 @@ _Unop = prism' (embed ∘ S.Unop) $ project ⋙ case _ of
   S.Unop r → M.Just r
   _ → M.Nothing
 
-_Ident
+_Identifier
   ∷ ∀ t f
   . Recursive t (S.SqlF f)
   ⇒ Corecursive t (S.SqlF f)
-  ⇒ Prism' t String
-_Ident = prism' (embed ∘ S.Ident) $ project ⋙ case _ of
-  S.Ident s → M.Just s
+  ⇒ Prism' t S.Ident
+_Identifier = prism' (embed ∘ S.Identifier) $ project ⋙ case _ of
+  S.Identifier s → M.Just s
   _ → M.Nothing
 
 _InvokeFunction
@@ -283,13 +281,13 @@ _BoolLiteral = prism' (embed ∘ S.Literal ∘ EJ.Boolean) $ project ⋙ case _
   S.Literal (EJ.Boolean b) → M.Just b
   _ → M.Nothing
 
-_Vari
+_Var
   ∷ ∀ t f
   . Recursive t (S.SqlF f)
   ⇒ Corecursive t (S.SqlF f)
-  ⇒ Prism' t String
-_Vari = prism' (embed ∘ S.Vari) $ project ⋙ case _ of
-  S.Vari r → M.Just r
+  ⇒ Prism' t S.Ident
+_Var = prism' (embed ∘ S.Var) $ project ⋙ case _ of
+  S.Var r → M.Just r
   _ → M.Nothing
 
 _Select

src/SqlSquared/Parser.purs

@@ -30,6 +30,7 @@ import SqlSquared.Constructors as C
 import SqlSquared.Parser.Tokenizer (Token(..), TokenStream, PositionedToken, tokenize, Literal(..), printToken)
 import SqlSquared.Path as Pt
 import SqlSquared.Signature as Sig
+import SqlSquared.Signature.Ident (Ident(..))
 import SqlSquared.Utils ((∘), type (×), (×))
 import Text.Parsing.Parser as P
 import Text.Parsing.Parser.Combinators as PC
@@ -177,7 +178,7 @@ letExpr = do
   bindTo ← expr
   operator ";"
   in_ ← expr
-  pure $ C.let_ i bindTo in_
+  pure $ C.let_ (Ident i) bindTo in_
 
 queryExpr ∷ ∀ m t. SqlParser' m t
 queryExpr = prod (query <|> definedExpr) queryBinop _BINOP
@@ -310,7 +311,7 @@ primaryExpr = asErrorMessage "primary expression" $ PC.choice
   , wildcard
   , arrayLiteral
   , mapLiteral
-  , ident <#> embed ∘ Sig.Ident
+  , ident <#> embed ∘ Sig.Identifier ∘ Ident
   ]
 
 caseExpr ∷ ∀ m t. SqlParser' m t
@@ -385,7 +386,7 @@ functionExpr ∷ ∀ m t. SqlParser' m t
 functionExpr = PC.try do
   name ← ident <|> anyKeyword
   args ← parenList
-  pure $ C.invokeFunction (S.toUpper name) args
+  pure $ C.invokeFunction (Ident (S.toUpper name)) args
 
 functionDecl
   ∷ ∀ m a
@@ -401,7 +402,7 @@ functionDecl parseExpr = asErrorMessage "function declaration" do
   _ ← keyword "begin"
   body ← parseExpr
   _ ← keyword "end"
-  pure $ Sig.FunctionDecl { ident: name, args, body }
+  pure $ Sig.FunctionDecl { ident: Ident name, args, body }
 
 import_
   ∷ ∀ m a
@@ -414,16 +415,16 @@ import_ = asErrorMessage "import declaration" do
   pure $ Sig.Import path
 
 variable ∷ ∀ m t. SqlParser' m t
-variable = C.vari <$> variableString
+variable = C.var <$> variableString
 
-variableString ∷ ∀ m. Monad m ⇒ P.ParserT TokenStream m String
+variableString ∷ ∀ m. Monad m ⇒ P.ParserT TokenStream m Ident
 variableString = asErrorMessage "variable" $ PC.try do
   operator ":"
   PP.Position pos1 ← P.position
   s ← ident <|> anyKeyword
   PP.Position pos2 ← P.position
   guard (pos1.line == pos2.line && pos2.column == pos1.column + 1)
-  pure s
+  pure (Ident s)
 
 literal ∷ ∀ m t. SqlParser' m t
 literal = withToken "literal" case _ of
@@ -477,7 +478,7 @@ betweenSuffix = do
   lhs ← defaultExpr
   _ ← keyword "and"
   rhs ← defaultExpr
-  pure \e → C.invokeFunction "BETWEEN" (e : lhs : rhs : L.Nil)
+  pure \e → C.invokeFunction (Ident "BETWEEN") (e : lhs : rhs : L.Nil)
 
 inSuffix ∷ ∀ m t. SqlParser m t (t → t)
 inSuffix = do
@@ -556,7 +557,7 @@ relation = do
 simpleRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
 simpleRelation =
   tableRelation
-  <|> variRelation
+  <|> varRelation
   <|> PC.try exprRelation
   <|> parenRelation
 
@@ -570,19 +571,19 @@ parenRelation = do
 tableRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
 tableRelation = do
   i ← ident
-  path ← Pt.parseAnyFilePath P.fail i
+  path ← Pt.parseAnyPath P.fail i
   a ← PC.optionMaybe do
     _ ← keyword "as"
     ident
-  pure $ Sig.TableRelation { alias: a, path }
+  pure $ Sig.TableRelation { alias: Ident <$> a, path }
 
-variRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
-variRelation = do
-  vari ← variableString
+varRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
+varRelation = do
+  var ← variableString
   a ← PC.optionMaybe do
     _ ← keyword "as"
     ident
-  pure $ Sig.VariRelation { alias: a, vari }
+  pure $ Sig.VarRelation { alias: Ident <$> a, var }
 
 exprRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t)
 exprRelation = do
@@ -591,7 +592,7 @@ exprRelation = do
   operator ")"
   _ ← keyword "as"
   i ← ident
-  pure $ Sig.ExprRelation { aliasName: i, expr: e }
+  pure $ Sig.ExprRelation { alias: Ident i, expr: e }
 
 stdJoinRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t → Sig.Relation t)
 stdJoinRelation = do
@@ -682,16 +683,16 @@ projection ∷ ∀ m t. SqlParser m t (Sig.Projection t)
 projection = do
   e ← definedExpr
   a ← PC.optionMaybe (keyword "as" *> ident)
-  pure $ Sig.Projection { expr: e, alias: a }
+  pure $ Sig.Projection { expr: e, alias: Ident <$> a }
 
 _SEARCH ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ Boolean → t → t → t
-_SEARCH b lhs rhs = C.invokeFunction "SEARCH" $ lhs : rhs : (C.bool b) : L.Nil
+_SEARCH b lhs rhs = C.invokeFunction (Ident "SEARCH") $ lhs : rhs : (C.bool b) : L.Nil
 
 _LIKE ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ Maybe t → t → t → t
-_LIKE mbEsc lhs rhs = C.invokeFunction "LIKE" $ lhs : rhs : (fromMaybe (C.string "\\") mbEsc) : L.Nil
+_LIKE mbEsc lhs rhs = C.invokeFunction (Ident "LIKE") $ lhs : rhs : (fromMaybe (C.string "\\") mbEsc) : L.Nil
 
 _NOT ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ t → t
-_NOT = C.unop Sig.Not ∘ C.pars
+_NOT = C.unop Sig.Not ∘ C.parens
 
 _BINOP ∷ ∀ t. Corecursive t (Sig.SqlF EJ.EJsonF) ⇒ t → Sig.BinaryOperator → t → t
 _BINOP = flip C.binop

src/SqlSquared/Path.purs

@@ -3,6 +3,8 @@ module SqlSquared.Path
   , printAnyFilePath
   , parseAnyDirPath
   , printAnyDirPath
+  , parseAnyPath
+  , printAnyPath
   , genAnyFilePath
   , genAnyDirPath
   , module PathyTypeReexprts
@@ -20,7 +22,6 @@ import Pathy (AnyDir, AnyFile)
 import Pathy.Gen as PtGen
 import SqlSquared.Utils ((∘))
 
-
 printAnyDirPath :: AnyDir -> String
 printAnyDirPath = E.either
   (Pt.sandboxAny >>> Pt.unsafePrintPath Pt.posixPrinter)
@@ -47,6 +48,17 @@ parseAnyFilePath fail = Pt.parsePath Pt.posixParser
   (pure ∘ E.Left)
   (fail "Expected valid path")
 
+printAnyPath :: E.Either AnyDir AnyFile -> String
+printAnyPath = E.either printAnyDirPath printAnyFilePath
+
+parseAnyPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m (E.Either AnyDir AnyFile)
+parseAnyPath fail = Pt.parsePath Pt.posixParser
+  (pure ∘ E.Left ∘ E.Right)
+  (pure ∘ E.Left ∘ E.Left)
+  (pure ∘ E.Right ∘ E.Right)
+  (pure ∘ E.Right ∘ E.Left)
+  (fail "Expected valid path")
+
 genAnyFilePath :: forall m. Gen.MonadGen m => MonadRec m => m AnyFile
 genAnyFilePath = Gen.oneOf
   $ (E.Left <$> PtGen.genAbsFilePath)