Merge pull request #49 from slamdata/ps-0.14

Update for GH actions, PS 0.14, support escaped slash

Author: garyb

.github/workflows/ci.yml

@@ -0,0 +1,31 @@
+name: CI
+
+on:
+  - push
+  - pull_request
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: purescript-contrib/setup-purescript@main
+
+      - uses: actions/setup-node@v1
+        with:
+          node-version: "12"
+
+      - name: Install dependencies
+        run: |
+          npm install -g bower
+          npm install
+          bower install --production
+
+      - name: Build source
+        run: npm run-script build
+
+      - name: Run tests
+        run: |
+          bower install
+          npm run-script test --if-present

.gitignore

@@ -1,7 +1,7 @@
+/.*
+!/.gitignore
+!/.github
 /bower_components/
 /node_modules/
-/.pulp-cache/
 /output/
-/.psc*
-/.psa*
-/.purs-repl
+package-lock.json

.travis.yml

@@ -1,7 +1,7 @@
 # purescript-sql-squared
 
 [![Latest release](http://img.shields.io/github/release/slamdata/purescript-sql-squared.svg)](https://github.com/slamdata/purescript-sql-squared/releases)
-[![Build status](https://travis-ci.org/slamdata/purescript-sql-squared.svg?branch=master)](https://travis-ci.org/slamdata/purescript-sql-squared)
+![Build Status](https://github.com/slamdata/purescript-sql-squared/actions/workflows/ci.yml/badge.svg)
 
 AST and printer for SQL² -- query language used by [quasar](https://github.com/quasar-analytics/quasar).
 

README.md

@@ -15,15 +15,15 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-prelude": "^4.0.1",
-    "purescript-matryoshka": "^0.4.0",
-    "purescript-pathy": "^7.0.0",
-    "purescript-profunctor-lenses": "^6.1.0",
-    "purescript-ejson": "^12.0.0"
+    "purescript-prelude": "^5.0.1",
+    "purescript-matryoshka": "^0.5.0",
+    "purescript-pathy": "^8.1.0",
+    "purescript-profunctor-lenses": "^7.0.1",
+    "purescript-ejson": "^13.0.0"
   },
   "devDependencies": {
-    "purescript-quickcheck": "^6.1.0",
-    "purescript-argonaut": "^6.0.0",
-    "purescript-assert": "^4.1.0"
+    "purescript-quickcheck": "^7.1.0",
+    "purescript-argonaut": "^8.0.0",
+    "purescript-assert": "^5.0.0"
   }
 }

bower.json

@@ -5,8 +5,8 @@
     "test": "pulp test"
   },
   "dependencies": {
-    "pulp": "^12.2.0",
-    "purescript": "^0.12.0",
-    "purescript-psa": "^0.6.0"
+    "pulp": "^15.0.0",
+    "purescript": "^0.14.1",
+    "purescript-psa": "^0.8.2"
   }
 }

package.json

@@ -8,8 +8,8 @@ import Data.Json.Extended as EJ
 import Data.Lens (Prism', prism', Lens', lens, Iso')
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.List as L
+import Data.List.NonEmpty as NEL
 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 (×), (∘), (⋙))
@@ -20,7 +20,7 @@ _GroupBy = _Newtype
 _Case ∷ ∀ a. Iso' (S.Case a) { cond ∷ a, expr ∷ a }
 _Case = _Newtype
 
-_OrderBy ∷ ∀ a. Iso' (S.OrderBy a) (NE.NonEmpty L.List (S.OrderType × a))
+_OrderBy ∷ ∀ a. Iso' (S.OrderBy a) (NEL.NonEmptyList (S.OrderType × a))
 _OrderBy = _Newtype
 
 _Projection ∷ ∀ a. Iso' (S.Projection a) { expr ∷ a, alias ∷ M.Maybe S.Ident }

src/SqlSquared/Lenses.purs

@@ -20,8 +20,8 @@ import Data.Foldable as F
 import Data.Json.Extended as EJ
 import Data.List ((:))
 import Data.List as L
+import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..), fromMaybe, isJust)
-import Data.NonEmpty ((:|))
 import Data.String as S
 import Data.String.CodeUnits as SCU
 import Data.Tuple (Tuple(..), uncurry)
@@ -77,17 +77,18 @@ prettyParse parser input =
     SCU.fromCharArray (A.replicate (n - S.length s) ' ') <> s
 
   printError parseError =
-    let
-      message = P.parseErrorMessage parseError
-      PP.Position pos = P.parseErrorPosition parseError
-      lines = S.split (S.Pattern "\n") input
-      pre = A.drop (pos.line - 3) $ A.take (pos.line - 1) lines
-      line = A.take 1 $ A.drop (pos.line - 1) lines
-      post = A.take 3 $ A.drop pos.line lines
-      nums = A.mapWithIndex (\n l → padLeft 4 (show (n + pos.line - (A.length pre))) <> " | " <> l) (pre <> line <> post)
-      pointer = pure $ SCU.fromCharArray (A.replicate (pos.column - 1 + 7) '-') <> "^ " <> message
-    in
-      S.joinWith "\n" $ A.take (A.length pre + 1) nums <> pointer <> A.drop 3 nums
+    case P.parseErrorPosition parseError of
+      PP.Position pos →
+        let
+          message = P.parseErrorMessage parseError
+          lines = S.split (S.Pattern "\n") input
+          pre = A.drop (pos.line - 3) $ A.take (pos.line - 1) lines
+          line = A.take 1 $ A.drop (pos.line - 1) lines
+          post = A.take 3 $ A.drop pos.line lines
+          nums = A.mapWithIndex (\n l → padLeft 4 (show (n + pos.line - (A.length pre))) <> " | " <> l) (pre <> line <> post)
+          pointer = pure $ SCU.fromCharArray (A.replicate (pos.column - 1 + 7) '-') <> "^ " <> message
+        in
+          S.joinWith "\n" $ A.take (A.length pre + 1) nums <> pointer <> A.drop 3 nums
 
 parse
   ∷ ∀ t
@@ -111,7 +112,7 @@ parseModule
 parseModule = tokenize >=> flip P.runParser (moduleTop <* eof)
 
 queryTop ∷ ∀ m t. SqlParser m t (Sig.SqlQueryF t)
-queryTop = defer \_ → Sig.Query <$> (PC.sepEndBy decl $ operator ";") <*> expr
+queryTop = defer \_ → Sig.Query <$> PC.sepEndBy decl (operator ";") <*> expr
 
 moduleTop ∷ ∀ m t. SqlParser m t (Sig.SqlModuleF t)
 moduleTop = defer \_ → Sig.Module <$> PC.sepBy decl (operator ";")
@@ -639,7 +640,7 @@ groupBy ∷ ∀ m t. SqlParser m t (Sig.GroupBy t)
 groupBy = do
   _ ← keyword "group"
   _ ← keyword "by"
-  keys ← PC.sepBy1 definedExpr $ operator ","
+  keys ← NEL.toList <$> PC.sepBy1 definedExpr (operator ",")
   having ← PC.optionMaybe do
     _ ← keyword "having"
     definedExpr
@@ -655,10 +656,7 @@ orderBy prs = do
   _ ← keyword "order"
   _ ← keyword "by"
   pos ← P.position
-  lst ← flip PC.sepBy1 (operator ",") $ sortClause pos
-  case lst of
-    L.Nil → P.fail "incorrect order by"
-    x : xs → pure $ Sig.OrderBy (x :| xs)
+  Sig.OrderBy <$> flip PC.sepBy1 (operator ",") (sortClause pos)
   where
   sortPart = PC.choice
     [ keyword "asc" $> Sig.ASC

src/SqlSquared/Parser.purs

@@ -54,11 +54,6 @@ type PositionedToken =
 
 type TokenStream = Array PositionedToken
 
-isKeyword ∷ Token → Boolean
-isKeyword = case _ of
-  Kw _ → true
-  _ → false
-
 isComment ∷ Token → Boolean
 isComment = case _ of
   Comment _ → true
@@ -72,7 +67,7 @@ printToken = case _ of
   Lit (String _) → "string literal"
   Lit (Integer _) → "integer literal"
   Lit (Decimal _) → "decimal literal"
-  Comment str → "comment"
+  Comment _ → "comment"
 
 op ∷ ∀ m. Monad m ⇒ P.ParserT String m Token
 op = map Op $ PC.choice $ map PS.string operators
@@ -181,9 +176,6 @@ keywords = Set.fromFoldable
   , "all"
   ]
 
-digits ∷ Array Char
-digits = ['0','1','2','3','4','5','6','7','8','9' ]
-
 identOrKeyword ∷ ∀ m. Monad m ⇒ P.ParserT String m Token
 identOrKeyword = quotedIdent <|> notQuotedIdentOrKeyword
 
@@ -215,9 +207,10 @@ quotedIdent =
     $ map S.fromCharArray
     $ A.some (PC.asErrorMessage "identifier character" identChar)
   where
-  identChar = identEscape <|> identLetter
+  identChar = identSlash <|> identEscape <|> identLetter
   identLetter = PS.satisfy (not ∘ eq '`')
   identEscape = PS.string "\\`" $> '`'
+  identSlash = PS.string "\\\\" $> '\\'
 
 notQuotedIdentOrKeyword ∷ ∀ m. Monad m ⇒ P.ParserT String m Token
 notQuotedIdentOrKeyword = do

src/SqlSquared/Parser/Tokenizer.purs

@@ -588,24 +588,24 @@ genLetP n = do
 
 genQueryExprP ∷ ∀ m t. Int → GenSql m t
 genQueryExprP n
-  | n < 2 = Gen.oneOf $ genQueryP n :| [ genDefinedExprP n ]
+  | n < 2 = Gen.oneOf $ genQueryP :| [ genDefinedExprP n ]
   | otherwise = do
     op ←
       Gen.elements $ BO.Limit :|
         [ BO.Offset, BO.Sample, BO.Union
         , BO.UnionAll, BO.Intersect, BO.IntersectAll
         , BO.Except
         ]
-    lhs ← Gen.oneOf $ genQueryP n :| [ genDefinedExprP n ]
-    rhs ← Gen.oneOf $ genQueryP n :| [ genDefinedExprP n ]
+    lhs ← Gen.oneOf $ genQueryP :| [ genDefinedExprP n ]
+    rhs ← Gen.oneOf $ genQueryP :| [ genDefinedExprP n ]
     pure $ embed $ Binop { op, lhs, rhs }
 
 genDefinedExprP ∷ ∀ m t. Int → GenSql m t
 genDefinedExprP n = do
   binops ← Gen.resize (const n) $ Gen.unfoldable BO.genBinaryOperator
   unops ← Gen.resize (const n) $ Gen.unfoldable UO.genUnaryOperator
-  start ← genPrimaryExprP n
-  adds ← Gen.resize (const n) $ Gen.unfoldable $ genPrimaryExprP n
+  start ← genPrimaryExprP
+  adds ← Gen.resize (const n) $ Gen.unfoldable $ genPrimaryExprP
   pure $ F.foldl foldFn start $ A.zip binops $ A.zip unops adds
   where
   foldFn acc (binop × unop × rhs) =
@@ -617,39 +617,39 @@ genDefinedExprP n = do
       , expr: embed $ Binop { lhs: acc, rhs, op:binop }
       }
 
-genPrimaryExprP ∷ ∀ m t. Int → GenSql m t
-genPrimaryExprP n =
+genPrimaryExprP ∷ ∀ m t. GenSql m t
+genPrimaryExprP =
   Gen.oneOf $ genLeaf :|
-    [ genCaseP n
-    , genUnaryP n
-    , genFunctionP n
-    , genSetP n
-    , genArrayP n
-    , genMapP n
-    , genSpliceP n
+    [ genCaseP
+    , genUnaryP
+    , genFunctionP
+    , genSetP
+    , genArrayP
+    , genMapP
+    , genSpliceP
     , map (embed ∘ Identifier) ID.genIdent
     ]
 
-genCaseP ∷ ∀ m t. Int → GenSql m t
-genCaseP n = genLeaf
+genCaseP ∷ ∀ m t. GenSql m t
+genCaseP = genLeaf
 
-genUnaryP ∷ ∀ m t. Int → GenSql m t
-genUnaryP n = genLeaf
+genUnaryP ∷ ∀ m t. GenSql m t
+genUnaryP = genLeaf
 
-genFunctionP ∷ ∀ m t. Int → GenSql m t
-genFunctionP n = genLeaf
+genFunctionP ∷ ∀ m t. GenSql m t
+genFunctionP = genLeaf
 
-genSetP ∷ ∀ m t. Int → GenSql m t
-genSetP n = genLeaf
+genSetP ∷ ∀ m t. GenSql m t
+genSetP = genLeaf
 
-genArrayP ∷ ∀ m t. Int → GenSql m t
-genArrayP n = genLeaf
+genArrayP ∷ ∀ m t. GenSql m t
+genArrayP = genLeaf
 
-genMapP ∷ ∀ m t. Int → GenSql m t
-genMapP n = genLeaf
+genMapP ∷ ∀ m t. GenSql m t
+genMapP = genLeaf
 
-genSpliceP ∷ ∀ m t. Int → GenSql m t
-genSpliceP n = pure $ embed $ Splice Nothing
+genSpliceP ∷ ∀ m t. GenSql m t
+genSpliceP = pure $ embed $ Splice Nothing
 
-genQueryP ∷ ∀ m t. Int → GenSql m t
-genQueryP n = genLeaf
+genQueryP ∷ ∀ m t. GenSql m t
+genQueryP = genLeaf

src/SqlSquared/Signature.purs

@@ -16,7 +16,7 @@ derive instance eqCase ∷ Eq a ⇒ Eq (Case a)
 derive instance ordCase ∷ Ord a ⇒ Ord (Case a)
 
 instance foldableCase ∷ F.Foldable Case where
-  foldMap f (Case { cond, expr }) = f expr
+  foldMap f (Case { expr }) = f expr
   foldl f a (Case { cond, expr }) = f (f a cond) expr
   foldr f a (Case { cond, expr }) = f cond $ f expr a
 

src/SqlSquared/Signature/Case.purs

@@ -8,11 +8,11 @@ import Prelude
 
 import Control.Monad.Gen as Gen
 import Data.Generic.Rep (class Generic)
-import Data.Generic.Rep.Show (genericShow)
 import Data.Int as Int
 import Data.Newtype (class Newtype)
 import Data.NonEmpty ((:|))
 import Data.Set as Set
+import Data.Show.Generic (genericShow)
 import Data.String as S
 import Data.String.Regex as RX
 import Data.String.Regex.Flags as RXF
@@ -31,14 +31,17 @@ printIdent ∷ Ident → String
 printIdent (Ident ident) =
   if RX.test identifier ident && not (Set.member (S.toLower ident) keywords)
   then ident
-  else "`" <> RX.replace tick ("\\`") ident <> "`"
+  else "`" <> RX.replace slash ("\\\\") (RX.replace tick ("\\`") ident) <> "`"
 
 identifier ∷ RX.Regex
 identifier = RXU.unsafeRegex "^[a-z][_a-z0-9]*$" RXF.ignoreCase
 
 tick ∷ RX.Regex
 tick = RXU.unsafeRegex "`" RXF.global
 
+slash ∷ RX.Regex
+slash = RXU.unsafeRegex "\\\\" RXF.global
+
 genIdent ∷ ∀ m. Gen.MonadGen m ⇒ m Ident
 genIdent = do
   start ← Gen.elements $ "a" :| S.split (S.Pattern "") "bcdefghijklmnopqrstuvwxyz"