Scope as backend with new pg client (#52)

* backend-dependent lit; remove top-level scope alias S; internal: drop Some constructor in Literal

* Fix captial letter handling in column names

* Fix warnings

* Add testing db config loader

* Add dotenv and polyform deps

* Don't escape sql from `Any`

* Bump postgresql client version

* Bump pg client version

* Add Pg.Aff version of query1

* improve error message: Aggr where Col expected

* upgrade spago package-set

* replace prettyprinter with dodo-printer

* prettier query output

* fix warnings

Co-authored-by: Tomasz Rybarczyk <paluho@gmail.com>

.env-ci

@@ -0,0 +1,5 @@
+PG_DB="purspg"
+PG_PORT=5432
+PG_IDLE_TIMEOUT_MILLISECONDS=1000
+PG_USER="init"
+PG_PASSWORD="qwerty"

.github/workflows/ci.yml

@@ -24,6 +24,9 @@ jobs:
       - name: Start postgres db for PG test
         run: docker-compose up -d
 
+      - name: Setup env
+        run: cp .env-ci .env
+
       - run: npm install
       - run: npm run-script lit
       - run: npm run-script build

.gitignore

@@ -9,6 +9,8 @@
 /.psa*
 /.spago/
 
+.env
+
 package-lock.json
 
 test/db.sqlite3

guide/Custom.md

@@ -380,9 +380,9 @@ main = Guide.launchWithConnectionPG \conn → do
     DROP TABLE IF EXISTS bank_accounts;
     CREATE TABLE bank_accounts (
       id SERIAL PRIMARY KEY,
-      personId INTEGER NOT NULL,
+      "personId" INTEGER NOT NULL,
       balance INTEGER NOT NULL DEFAULT 100,
-      accountType TEXT NOT NULL
+      "accountType" TEXT NOT NULL
     );""" conn
 
   runSelda conn app >>= either logShow pure

guide/SimpleE2E.md

@@ -43,25 +43,24 @@ import Selda.Col (class GetCols)
 import Selda.PG (showPG)
 import Selda.PG.Class (insert_, query)
 import Selda.Table.Constraint (Auto, Default)
+import Test.Selda.PG.Config (load) as Config
 import Type.Proxy (Proxy(..))
 ```
 ## Setup
 
-First we have to setup the database. Make sure that:
-- a database named `purspg` exists
-- a user called `init` with password `qwerty` has been created
+- To run the examples below we need a postgresql db.
+  Set it up with the following command:
 
-We include this information in a record below.
-We will need it later to execute our queries.
+  ```bash
+  docker-compose up -d
+  ```
+  Or do it manually - check [docker-compose.yml](../docker-compose.yml)
 
-```purescript
-dbconfig ∷ PostgreSQL.Configuration
-dbconfig = (PostgreSQL.defaultConfiguration "purspg")
-  { user = Just "init"
-  , password = Just $ "qwerty"
-  , idleTimeoutMillis = Just $ 1000
-  }
-```
+- prepare `.env` file
+
+  ```bash
+  cp .env-ci .env
+  ```
 
 ### Table definition
 
@@ -131,7 +130,7 @@ createBankAccounts = execute """
   DROP TABLE IF EXISTS bank_accounts;
   CREATE TABLE bank_accounts (
     id SERIAL PRIMARY KEY,
-    personId INTEGER NOT NULL,
+    "personId" INTEGER NOT NULL,
     balance INTEGER NOT NULL DEFAULT 100
   );"""
 
@@ -436,7 +435,9 @@ We can also get SQL string literal from a query using the `str` helper function.
 ```
 
 Now we will finally write the `main` that will interpret our `app`.
-We start by preparing a connection to the database.
+We start by preparing a connection to the database (We use here predefined test `Config.load` helper
+which reads the environment (or `.env` file) for pg connection info and builds a pool for us).
+
 
 ```purescript
 main ∷ Effect Unit
@@ -450,8 +451,8 @@ When we've got the connection we can create the database tables and then run our
 
 launchWithConnectionPG ∷ (PostgreSQL.Connection → Aff Unit) → Effect Unit
 launchWithConnectionPG m = do
-  pool ← PostgreSQL.new dbconfig
   launchAff_ do
+    pool ← Config.load
     PostgreSQL.withConnection pool case _ of
       Left pgError → logShow ("PostgreSQL connection error: " <> show pgError)
       Right conn → do

package.json

@@ -8,6 +8,7 @@
   },
   "scripts": {
     "lit": "rm -rf guide/src/ && paluh-litps --input guide/ --output guide/src/ && cp guide/Custom.js guide/src/Custom.js",
+    "env": "[ -f .env-ci ] && export $(cat .env-ci | xargs)",
     "build": "npm run-script lit && spago build",
     "test:guide:simpleE2E": "npm run-script lit && spago test --main Test.Guide.SimpleE2E",
     "test:guide:custom": "npm run-script lit && spago test --main Test.Guide.Custom",

packages.dhall

@@ -2,27 +2,6 @@ let upstream =
       https://github.com/purescript/package-sets/releases/download/psc-0.14.1-20210506/packages.dhall sha256:d199e142515f9cc15838d8e6d724a98cd0ca776ceb426b7b36e841311643e3ef
 
 in upstream
-    with prettyprinter =
-      { dependencies =
-        [ "ansi"
-        , "arrays"
-        , "console"
-        , "control"
-        , "effect"
-        , "foldable-traversable"
-        , "lists"
-        , "maybe"
-        , "nonempty"
-        , "partial"
-        , "prelude"
-        , "random"
-        , "strings"
-        , "tuples"
-        , "unfoldable"
-        ]
-      , repo = "https://github.com/jordanmartinez/purescript-prettyprinter.git"
-      , version = "updateTov0.14.1"
-      }
     with postgresql-client =
       { dependencies =
         [ "aff"
@@ -140,3 +119,4 @@ in upstream
         , repo = "https://github.com/jordanmartinez/batteries-env.git"
         , version = "updateTov0.14.1"
         }
+-- >>>>>>> master

spago.dhall

@@ -11,23 +11,30 @@ You can edit this file as you like.
   , "bifunctors"
   , "console"
   , "datetime"
+  , "dodo-printer"
+  , "dotenv"
   , "effect"
   , "either"
   , "enums"
   , "exceptions"
   , "exists"
   , "foldable-traversable"
   , "foreign"
+  , "foreign-object"
   , "heterogeneous"
   , "leibniz"
   , "lists"
   , "maybe"
   , "newtype"
+  , "node-process"
   , "node-sqlite3"
+  , "ordered-collections"
   , "partial"
+  , "polyform"
+  , "polyform-batteries-core"
+  , "polyform-batteries-env"
   , "postgresql-client"
   , "prelude"
-  , "prettyprinter"
   , "record"
   , "simple-json"
   , "strings"
@@ -36,6 +43,7 @@ You can edit this file as you like.
   , "tuples"
   , "typelevel-prelude"
   , "unsafe-coerce"
+  , "validation"
   , "variant"
   ]
 , packages = ./packages.dhall

src/Selda.purs

@@ -5,7 +5,6 @@ module Selda
   , module ShowStatement
   , module Query
   , module Table
-  , S
   , module Expr.Ord
   , in_
   , count
@@ -25,22 +24,20 @@ import Prelude
 import Data.Exists (mkExists)
 import Data.Maybe (Maybe)
 import Data.Newtype (unwrap)
+import Dodo as Dodo
 import Selda.Aggr (Aggr(..))
 import Selda.Col (Col(..)) as Col
 import Selda.Col (Col(..), showCol)
 import Selda.Expr (Expr(..), Fn(..), InArray(..), UnExp(..), UnOp(..))
 import Selda.Expr.Ord ((.==), (./=), (.>), (.>=), (.<), (.<=)) as Expr.Ord
 import Selda.Lit (lit, class Lit) as Lit
 import Selda.Query (crossJoin, crossJoin_, innerJoin, innerJoin_, restrict, having, notNull, notNull_, union, unionAll, intersect, except, leftJoin, leftJoin_, distinct, aggregate, groupBy, groupBy', selectFrom, selectFrom_, limit, orderBy) as Query
+import Selda.Query.PrettyPrint (dodoPrint)
 import Selda.Query.ShowStatement (ppQuery)
 import Selda.Query.ShowStatement (showQuery, showDeleteFrom, showUpdate) as ShowStatement
 import Selda.Query.Type (Order(..), FullQuery)
 import Selda.Query.Type (Query(..), FullQuery(..)) as Query.Type
 import Selda.Table (Table(..)) as Table
-import Text.Pretty as PP
-
--- | Top-level scope of a query
-type S = Unit
 
 asc ∷ Order
 asc = Asc
@@ -62,7 +59,7 @@ in_
 in_ col subQ = Col $ Any do
   c ← showCol col
   doc ← ppQuery subQ
-  let q = PP.render 0 $ PP.nest 2 $ PP.line <> doc <> PP.line
+  let q = dodoPrint $ Dodo.indent $ Dodo.break <> doc <> Dodo.break
   pure $ c <> " IN (" <> q <> ")"
 
 count ∷ ∀ s a. Col s a → Aggr s Int

src/Selda/Col.purs

@@ -72,3 +72,5 @@ instance extractcols
 
 binOp ∷ ∀ s o i. BinOp i o → Col s i → Col s i → Col s o
 binOp op (Col e1) (Col e2) = Col $ EBinOp $ mkExists $ BinExp op e1 e2
+
+

src/Selda/Expr.purs

@@ -4,7 +4,6 @@ module Selda.Expr
   -- internal AST for expressions
   , Expr(..)
   , Literal(..)
-  , Some(..)
   , None(..)
   , BinOp(..)
   , UnOp(..)
@@ -35,7 +34,7 @@ import Data.String.CodeUnits (fromCharArray, toCharArray)
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
 import Foreign (Foreign)
-import Selda.Table (Column(..))
+import Selda.Table (Column, showColumn)
 
 -- | AST for SQL expressions:
 -- | 
@@ -65,9 +64,6 @@ data Literal a
   | LString String (String ~ a)
   | LInt Int (Int ~ a)
   | LNull (Exists (None a))
-  | LJust (Exists (Some a))
-
-data Some a b = Some (Literal b) (Maybe b ~ a)
 
 data None a b = None (Maybe b ~ a)
 
@@ -142,18 +138,12 @@ showForeign x = do
   put $ s { nextIndex = 1 + s.nextIndex, invertedParams = x : s.invertedParams }
   pure $ mkPlaceholder s.nextIndex
 
-showColumn ∷ ∀ a. Column a → String
-showColumn (Column { namespace, name })
-  | namespace == "" = name
-  | otherwise = namespace <> "." <> name
-
 showLiteral ∷ ∀ a. Literal a → String
 showLiteral = case _ of
   LBoolean b _ → show b
   LString s _ → "'" <> primPGEscape s <> "'"
   LInt i _ → show i
   LNull _ → "null"
-  LJust x → runExists (\(Some l _) → showLiteral l) x
 
 showBinOp ∷ ∀ i o. BinOp i o → String
 showBinOp = case _ of
@@ -174,7 +164,7 @@ showExpr = case _ of
   EFn fn → runExists showFn fn
   EInArray e → runExists showInArray e
   EForeign x → showForeign x
-  Any m → primPGEscape <$> m
+  Any m → m
 
 showBinExp ∷ ∀ o i. BinExp o i → ShowM
 showBinExp (BinExp op e1 e2) = do

src/Selda/Inner.purs

@@ -15,9 +15,9 @@ data Inner s
 
 data OuterCols = OuterCols
 instance failOuterCols
-    ∷ Fail (Text "Nested query with an `Aggr` column: "
+    ∷ Fail (Text "Error in the nested query: column \""
         <:> Text sym
-        <:> Text ", expected `Col`")
+        <:> Text "\" has type `Aggr`, but `Col` was expected.")
     ⇒ MappingWithIndex OuterCols (Proxy sym) (Aggr s a) c
   where
   mappingWithIndex _ _ _ = unsafeCoerce "failed with error message"

src/Selda/Lit.purs

@@ -4,29 +4,52 @@ import Prelude
 
 import Data.Exists (mkExists)
 import Data.Maybe (Maybe(..))
+import Database.PostgreSQL (class ToSQLValue)
 import Selda.Aggr (class Coerce, unsafeFromCol)
 import Selda.Col (Col(..))
-import Selda.Expr (Expr(..), Literal(..), None(..), Some(..))
-
--- | Lift a value `a` to a column expression using `Lit a` typeclass.
--- | Defined only for basic literals: Boolean, String, Int and Maybe.
--- | To handle more cases refer to the function `litPG`.
-lit ∷ ∀ col s a. Lit a ⇒ Coerce col ⇒ a → col s a
-lit = unsafeFromCol <<< Col <<< ELit <<< literal
-
-class Lit a where
-  literal ∷ a → Literal a
-
-instance litBoolean ∷ Lit Boolean where
-  literal x = LBoolean x identity
-
-instance litString ∷ Lit String where
-  literal x = LString x identity
-
-instance litInt ∷ Lit Int where
-  literal x = LInt x identity
-
-instance litMaybe ∷ Lit a ⇒ Lit (Maybe a) where
-  literal = case _ of
-    Nothing → LNull $ mkExists $ None identity
-    Just l → LJust $ mkExists $ Some (literal l) identity
+import Selda.Expr (Expr(..), Literal(..), None(..))
+import Selda.Inner (Inner)
+import Selda.PG (litPG)
+import Selda.PG.Class (BackendPGClass)
+import Selda.SQLite3 (litSQLite3)
+import Selda.SQLite3.Class (BackendSQLite3Class)
+import Simple.JSON (class WriteForeign)
+import Unsafe.Coerce (unsafeCoerce)
+
+-- | Lift a value `a` to a column expression using `Lit s a` typeclass.
+lit
+  ∷ ∀ col s a
+  . Lit s a
+  ⇒ Coerce col
+  ⇒ a → col s a
+lit = unsafeFromCol <<< litImpl
+
+class Lit ∷ ∀ k. k → Type → Constraint
+class Lit s a where
+  litImpl ∷ a → Col s a
+
+instance litInner ∷ Lit s a ⇒ Lit (Inner s) a where
+  litImpl a = case (litImpl a ∷ Col s a) of Col e → Col e
+
+else instance litBoolean ∷ Lit b Boolean where
+  litImpl x = Col $ ELit $ LBoolean x identity
+
+else instance litString ∷ Lit b String where
+  litImpl x = Col $ ELit $ LString x identity
+
+else instance litInt ∷ Lit b Int where
+  litImpl x = Col $ ELit $ LInt x identity
+
+else instance litMaybe ∷ Lit b a ⇒ Lit b (Maybe a) where
+  litImpl = case _ of
+    Nothing → Col $ ELit $ LNull $ mkExists $ None identity
+    Just l → liftJust $ litImpl l
+      where
+        liftJust ∷ Col b a → Col b (Maybe a)
+        liftJust = unsafeCoerce
+
+else instance ilitPG ∷ ToSQLValue a ⇒ Lit BackendPGClass a where
+  litImpl = litPG
+
+else instance ilitSQLite3 ∷ WriteForeign a ⇒ Lit BackendSQLite3Class a where
+  litImpl = litSQLite3