From e24e4457c17ad6bbe3e0b76dc808404a1730bc0b Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Mon, 6 Jun 2016 22:54:07 +0300 Subject: [PATCH 1/8] Add SqlValue instance for Date --- src/Database/Postgres/SqlValue.purs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Database/Postgres/SqlValue.purs b/src/Database/Postgres/SqlValue.purs index 87b09fa..dc5e579 100644 --- a/src/Database/Postgres/SqlValue.purs +++ b/src/Database/Postgres/SqlValue.purs @@ -7,6 +7,7 @@ module Database.Postgres.SqlValue import Prelude ((<<<)) import Data.Int (toNumber) import Data.Maybe (Maybe(..)) +import Data.Date as Date foreign import data SqlValue :: * @@ -26,6 +27,9 @@ instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a) where toSql Nothing = nullSqlValue toSql (Just x) = toSql x +instance isSqlValueDate :: IsSqlValue Date.Date where + toSql = unsafeToSqlValue + foreign import unsafeToSqlValue :: forall a. a -> SqlValue foreign import nullSqlValue :: SqlValue From e69de6c33d5f95f0e8c6db9eb6ced5b30ca1559b Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Mon, 13 Jun 2016 08:48:33 +0300 Subject: [PATCH 2/8] Updates deps for psc-0.9 --- bower.json | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/bower.json b/bower.json index 64771f5..d2185d1 100644 --- a/bower.json +++ b/bower.json @@ -26,12 +26,13 @@ "output" ], "dependencies": { - "purescript-arrays": "~0.4.0", - "purescript-either": "~0.2.0", - "purescript-foreign": "~0.7.0", - "purescript-foldable-traversable": "~0.4.0", - "purescript-transformers": "~0.8.0", - "purescript-aff": "~0.16.0", - "purescript-integers": "~0.2.0" + "purescript-arrays": "^1.0.0", + "purescript-either": "^1.0.0", + "purescript-foreign": "^1.0.0", + "purescript-foldable-traversable": "^1.0.0", + "purescript-transformers": "^1.0.0", + "purescript-aff": "~0.17.0", + "purescript-integers": "^1.0.0", + "purescript-datetime": "^1.0.0" } } From 9f8004da0b1fa37e70ef3fcaf6279092c23bbb41 Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Mon, 13 Jun 2016 08:49:02 +0300 Subject: [PATCH 3/8] Updates for psc 0.9 and add IsSqlValue instance for DateTime --- src/Database/Postgres.purs | 2 +- src/Database/Postgres/SqlValue.purs | 23 +++++++++++++++++++---- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs index 83a6541..3130a69 100644 --- a/src/Database/Postgres.purs +++ b/src/Database/Postgres.purs @@ -19,7 +19,7 @@ module Database.Postgres import Prelude import Control.Monad.Eff (Eff) import Data.Either (either) -import Data.Function (Fn2(), runFn2) +import Data.Function.Uncurried (Fn2(), runFn2) import Data.Array ((!!)) import Data.Foreign (Foreign, ForeignError) import Data.Foreign.Class (class IsForeign, read) diff --git a/src/Database/Postgres/SqlValue.purs b/src/Database/Postgres/SqlValue.purs index dc5e579..901db05 100644 --- a/src/Database/Postgres/SqlValue.purs +++ b/src/Database/Postgres/SqlValue.purs @@ -4,10 +4,13 @@ module Database.Postgres.SqlValue , toSql ) where -import Prelude ((<<<)) +import Prelude +import Data.Enum (fromEnum) import Data.Int (toNumber) import Data.Maybe (Maybe(..)) -import Data.Date as Date +import Data.Date (year, month, day) +import Data.DateTime (DateTime(DateTime)) +import Data.Time (hour, minute, second) foreign import data SqlValue :: * @@ -27,8 +30,20 @@ instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a) where toSql Nothing = nullSqlValue toSql (Just x) = toSql x -instance isSqlValueDate :: IsSqlValue Date.Date where - toSql = unsafeToSqlValue +instance isSqlValueDateTime :: IsSqlValue DateTime where + toSql = toSql <<< format + where + format (DateTime d t) + = show (fromEnum (year d)) <> "-" + <> zeroPad (fromEnum (month d)) <> "-" + <> zeroPad (fromEnum (day d)) <> " " + <> zeroPad (fromEnum (hour t)) <> ":" + <> zeroPad (fromEnum (minute t)) <> ":" + <> zeroPad (fromEnum (second t)) + + zeroPad :: Int -> String + zeroPad i | i < 10 = "0" <> (show i) + zeroPad i = show i foreign import unsafeToSqlValue :: forall a. a -> SqlValue From a9e9d4c77a3e9e2db780c164c993199336d729ff Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Mon, 13 Jun 2016 08:57:41 +0300 Subject: [PATCH 4/8] Get rid of unsafeToSqlValue and use unsafeCoerce, fix tests --- bower.json | 3 ++- src/Database/Postgres/SqlValue.js | 6 ------ src/Database/Postgres/SqlValue.purs | 9 ++++----- test/Main.purs | 14 +++++++------- 4 files changed, 13 insertions(+), 19 deletions(-) diff --git a/bower.json b/bower.json index d2185d1..ca1930c 100644 --- a/bower.json +++ b/bower.json @@ -33,6 +33,7 @@ "purescript-transformers": "^1.0.0", "purescript-aff": "~0.17.0", "purescript-integers": "^1.0.0", - "purescript-datetime": "^1.0.0" + "purescript-datetime": "^1.0.0", + "purescript-unsafe-coerce": "~1.0.0" } } diff --git a/src/Database/Postgres/SqlValue.js b/src/Database/Postgres/SqlValue.js index 83b4cbc..7a352cd 100644 --- a/src/Database/Postgres/SqlValue.js +++ b/src/Database/Postgres/SqlValue.js @@ -1,9 +1,3 @@ 'use strict'; -// module Database.Postgres.SqlValue - -exports.unsafeToSqlValue = function (x) { - return x; -} - exports.nullSqlValue = null; diff --git a/src/Database/Postgres/SqlValue.purs b/src/Database/Postgres/SqlValue.purs index 901db05..a3c09ec 100644 --- a/src/Database/Postgres/SqlValue.purs +++ b/src/Database/Postgres/SqlValue.purs @@ -11,6 +11,7 @@ import Data.Maybe (Maybe(..)) import Data.Date (year, month, day) import Data.DateTime (DateTime(DateTime)) import Data.Time (hour, minute, second) +import Unsafe.Coerce (unsafeCoerce) foreign import data SqlValue :: * @@ -18,13 +19,13 @@ class IsSqlValue a where toSql :: a -> SqlValue instance isSqlValueString :: IsSqlValue String where - toSql = unsafeToSqlValue + toSql = unsafeCoerce instance isSqlValueNumber :: IsSqlValue Number where - toSql = unsafeToSqlValue + toSql = unsafeCoerce instance isSqlValueInt :: IsSqlValue Int where - toSql = unsafeToSqlValue <<< toNumber + toSql = unsafeCoerce <<< toNumber instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a) where toSql Nothing = nullSqlValue @@ -45,6 +46,4 @@ instance isSqlValueDateTime :: IsSqlValue DateTime where zeroPad i | i < 10 = "0" <> (show i) zeroPad i = show i -foreign import unsafeToSqlValue :: forall a. a -> SqlValue - foreign import nullSqlValue :: SqlValue diff --git a/test/Main.purs b/test/Main.purs index 13a23aa..8abb777 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,8 +1,9 @@ module Test.Main where +import Prelude import Control.Monad.Eff.Console as C import Control.Monad.Aff (Aff, apathize, attempt, runAff) -import Control.Monad.Aff.Console (log, print) +import Control.Monad.Aff.Console (log, logShow) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE) @@ -15,11 +16,10 @@ import Data.Maybe (Maybe) import Database.Postgres (DB, Query(Query), queryOne_, execute_, withConnection, query, withClient, end, query_, connect, queryValue_, disconnect, mkConnectionString) import Database.Postgres.SqlValue (toSql) import Database.Postgres.Transaction (withTransaction) -import Prelude (class Show, Unit, return, ($), bind, show, (<>), void, flip, (>>>), const) main :: forall eff. Eff ( console :: CONSOLE , db :: DB | eff ) Unit -main = runAff C.print (const $ C.log "All ok") $ do - print $ "connecting to " <> mkConnectionString connectionInfo <> "..." +main = runAff C.logShow (const $ C.log "All ok") $ do + logShow $ "connecting to " <> mkConnectionString connectionInfo <> "..." exampleUsingWithConnection exampleLowLevel @@ -51,7 +51,7 @@ exampleUsingWithConnection = withConnection connectionInfo $ \c -> do execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c execute_ (Query "insert into artist values ('Deep Purple', 1968)") c year <- queryValue_ (Query "insert into artist values ('Fairport Convention', 1967) returning year" :: Query Number) c - print (show year) + logShow (show year) artists <- query_ (Query "select * from artist" :: Query Artist) c printRows artists @@ -83,7 +83,7 @@ exampleTransaction = withConnection connectionInfo $ \c -> do execute_ (Query "delete from artist") c apathize $ tryInsert c one <- queryOne_ (Query "select * from artist" :: Query Artist) c - void $ print one + void $ logShow one where tryInsert = withTransaction $ \c -> do execute_ (Query "insert into artist values ('Not there', 1999)") c @@ -100,4 +100,4 @@ instance artistIsForeign :: IsForeign Artist where read obj = do n <- readProp "name" obj y <- readProp "year" obj - return $ Artist { name: n, year: y } + pure $ Artist { name: n, year: y } From 6a39636e94ff7efd9add7ad212ebd6d9fff46af3 Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Sat, 18 Jun 2016 22:12:49 +0300 Subject: [PATCH 5/8] Define IsSqlValue Maybe instance in terms of Nullable --- src/Database/Postgres/SqlValue.js | 3 --- src/Database/Postgres/SqlValue.purs | 8 +++----- 2 files changed, 3 insertions(+), 8 deletions(-) delete mode 100644 src/Database/Postgres/SqlValue.js diff --git a/src/Database/Postgres/SqlValue.js b/src/Database/Postgres/SqlValue.js deleted file mode 100644 index 7a352cd..0000000 --- a/src/Database/Postgres/SqlValue.js +++ /dev/null @@ -1,3 +0,0 @@ -'use strict'; - -exports.nullSqlValue = null; diff --git a/src/Database/Postgres/SqlValue.purs b/src/Database/Postgres/SqlValue.purs index a3c09ec..301eda8 100644 --- a/src/Database/Postgres/SqlValue.purs +++ b/src/Database/Postgres/SqlValue.purs @@ -7,11 +7,12 @@ module Database.Postgres.SqlValue import Prelude import Data.Enum (fromEnum) import Data.Int (toNumber) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe) import Data.Date (year, month, day) import Data.DateTime (DateTime(DateTime)) import Data.Time (hour, minute, second) import Unsafe.Coerce (unsafeCoerce) +import Data.Nullable (toNullable) foreign import data SqlValue :: * @@ -28,8 +29,7 @@ instance isSqlValueInt :: IsSqlValue Int where toSql = unsafeCoerce <<< toNumber instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a) where - toSql Nothing = nullSqlValue - toSql (Just x) = toSql x + toSql = unsafeCoerce <<< toNullable <<< (toSql <$> _) instance isSqlValueDateTime :: IsSqlValue DateTime where toSql = toSql <<< format @@ -45,5 +45,3 @@ instance isSqlValueDateTime :: IsSqlValue DateTime where zeroPad :: Int -> String zeroPad i | i < 10 = "0" <> (show i) zeroPad i = show i - -foreign import nullSqlValue :: SqlValue From fd60b673afe94da1ef49e9e75370dce2689b5aeb Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Sat, 18 Jun 2016 22:13:32 +0300 Subject: [PATCH 6/8] Add new test suite using purescript-spec --- bower.json | 9 ++- test/Main.purs | 163 +++++++++++++++++++++++++++++++------------------ 2 files changed, 110 insertions(+), 62 deletions(-) diff --git a/bower.json b/bower.json index ca1930c..b93f69e 100644 --- a/bower.json +++ b/bower.json @@ -31,9 +31,14 @@ "purescript-foreign": "^1.0.0", "purescript-foldable-traversable": "^1.0.0", "purescript-transformers": "^1.0.0", - "purescript-aff": "~0.17.0", + "purescript-aff": "^1.0.0", "purescript-integers": "^1.0.0", "purescript-datetime": "^1.0.0", - "purescript-unsafe-coerce": "~1.0.0" + "purescript-unsafe-coerce": "^1.0.0", + "purescript-nullable": "^1.0.1" + }, + "devDependencies": { + "purescript-spec": "~0.8.0", + "purescript-generics": "~1.0.0" } } diff --git a/test/Main.purs b/test/Main.purs index 8abb777..9b34a6b 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,42 +1,43 @@ module Test.Main where import Prelude -import Control.Monad.Eff.Console as C -import Control.Monad.Aff (Aff, apathize, attempt, runAff) -import Control.Monad.Aff.Console (log, logShow) +import Control.Monad.Aff (Aff, apathize, attempt) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (error) import Control.Monad.Error.Class (throwError) +import Data.Array (length) +import Data.Date (Date, canonicalDate) +import Data.DateTime (DateTime(..)) +import Data.Date.Component (Day(..), Month(..), Year(..)) +import Data.Enum (toEnum) +import Data.Time (Time(..)) +import Data.Time.Component (Hour(..), Minute(..), Second(..)) import Data.Either (either) -import Data.Foldable (foldMap) +import Data.Foreign (Foreign) +import Data.JSDate (JSDate, toDateTime) +import Data.Maybe (Maybe(Nothing, Just), maybe) import Data.Foreign.Class (class IsForeign, readProp) -import Data.Maybe (Maybe) -import Database.Postgres (DB, Query(Query), queryOne_, execute_, withConnection, query, withClient, end, query_, connect, queryValue_, disconnect, mkConnectionString) +import Data.Generic (class Generic, gEq) +import Database.Postgres (DB, Query(Query), queryOne_, execute, execute_, withConnection, query, withClient, end, query_, connect, queryValue_, mkConnectionString) import Database.Postgres.SqlValue (toSql) import Database.Postgres.Transaction (withTransaction) +import Node.Process (PROCESS) -main :: forall eff. Eff ( console :: CONSOLE , db :: DB | eff ) Unit -main = runAff C.logShow (const $ C.log "All ok") $ do - logShow $ "connecting to " <> mkConnectionString connectionInfo <> "..." - exampleUsingWithConnection - exampleLowLevel +import Unsafe.Coerce (unsafeCoerce) - res <- attempt exampleError - either (const $ log "got an error, like we should") (const $ log "FAIL") res - - exampleQueries - - exampleTransaction - - liftEff $ disconnect +import Test.Spec (describe, it) +import Test.Spec.Runner (run) +import Test.Spec.Assertions (fail, shouldEqual) +import Test.Spec.Reporter.Console (consoleReporter) data Artist = Artist { name :: String , year :: Int } +connectionInfo :: { host :: String, db :: String, port :: Int, user :: String, password :: String } connectionInfo = { host: "localhost" , db: "test" @@ -45,22 +46,84 @@ connectionInfo = , password: "test" } -exampleUsingWithConnection :: forall eff. Aff (console :: C.CONSOLE, db :: DB | eff) Unit -exampleUsingWithConnection = withConnection connectionInfo $ \c -> do - execute_ (Query "delete from artist") c - execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c - execute_ (Query "insert into artist values ('Deep Purple', 1968)") c - year <- queryValue_ (Query "insert into artist values ('Fairport Convention', 1967) returning year" :: Query Number) c - logShow (show year) - artists <- query_ (Query "select * from artist" :: Query Artist) c - printRows artists - -exampleLowLevel :: forall eff. Aff (console :: C.CONSOLE, db :: DB | eff) Unit -exampleLowLevel = do - client <- connect connectionInfo - artists <- query_ (Query "select * from artist order by name desc" :: Query Artist) client - printRows artists - liftEff $ end client +main :: Eff (process :: PROCESS, console :: CONSOLE , db :: DB) Unit +main = run [consoleReporter] do + describe "connection string" do + it "should build one from the connection record" do + mkConnectionString connectionInfo `shouldEqual` "postgres://testuser:test@localhost:5432/test" + + describe "withConnection" do + it "Returns a connection" do + withConnection connectionInfo $ \c -> do + execute_ (Query "delete from artist") c + execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c + execute_ (Query "insert into artist values ('Deep Purple', 1968)") c + let + q :: Query Int + q = Query "insert into artist values ('Fairport Convention', 1967) returning year" + + year <- queryValue_ q c + year `shouldEqual` (Just 1967) + + artists <- query_ (Query "select * from artist" :: Query Artist) c + length artists `shouldEqual` 3 + + describe "Low level API" do + it "Can be used to manage connections manually" do + client <- connect connectionInfo + execute_ (Query "delete from artist") client + execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") client + + artists <- query_ (Query "select * from artist order by name desc" :: Query Artist) client + artists `shouldEqual` [Artist { name: "Led Zeppelin", year: 1968 }] + + liftEff $ end client + + describe "Error handling" do + it "When query cannot be converted to the requested data type we get an error" do + res <- attempt exampleError + either (const $ pure unit) (const $ fail "FAIL") res + + describe "Query params" do + it "Select using a query param" do + withClient connectionInfo $ \c -> do + execute_ (Query "delete from artist") c + execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c + execute_ (Query "insert into artist values ('Deep Purple', 1968)") c + execute_ (Query "insert into artist values ('Toto', 1977)") c + artists <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "Toto"] c + length artists `shouldEqual` 1 + + noRows <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "FAIL"] c + length noRows `shouldEqual` 0 + + describe "data types" do + it "datetimes can be inserted" do + withConnection connectionInfo \c -> do + execute_ (Query "delete from types") c + let date = canonicalDate <$> toEnum 2016 <*> Just January <*> toEnum 25 + time = Time <$> toEnum 23 <*> toEnum 1 <*> toEnum 59 <*> toEnum 0 + dt = DateTime <$> date <*> time + maybe (fail "Not a datetime") (\ts -> do + execute (Query "insert into types(timestamp_no_tz) VALUES ($1)") [toSql ts] c + ts' <- queryValue_ (Query "select timestamp_no_tz at time zone 'UTC' from types" :: Query Foreign) c + let res = unsafeCoerce <$> ts' >>= toDateTime + res `shouldEqual` (Just ts) + ) dt + + + describe "transactions" do + it "does not commit after an error inside a transation" do + withConnection connectionInfo $ \c -> do + execute_ (Query "delete from artist") c + apathize $ tryInsert c + one <- queryOne_ (Query "select * from artist" :: Query Artist) c + + one `shouldEqual` Nothing + where + tryInsert = withTransaction $ \c -> do + execute_ (Query "insert into artist values ('Not there', 1999)") c + throwError $ error "fail" exampleError :: forall eff. Aff (db :: DB | eff) (Maybe Artist) exampleError = withConnection connectionInfo $ \c -> do @@ -68,34 +131,14 @@ exampleError = withConnection connectionInfo $ \c -> do execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c queryOne_ (Query "select year from artist") c -exampleQueries :: forall eff. Aff (console :: C.CONSOLE, db :: DB | eff) Unit -exampleQueries = withClient connectionInfo $ \c -> do - log "Example queries with params:" - execute_ (Query "delete from artist") c - execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c - execute_ (Query "insert into artist values ('Deep Purple', 1968)") c - execute_ (Query "insert into artist values ('Toto', 1977)") c - artists <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "Toto"] c - printRows artists - -exampleTransaction :: forall eff. Aff (console :: C.CONSOLE, db :: DB | eff) Unit -exampleTransaction = withConnection connectionInfo $ \c -> do - execute_ (Query "delete from artist") c - apathize $ tryInsert c - one <- queryOne_ (Query "select * from artist" :: Query Artist) c - void $ logShow one - where - tryInsert = withTransaction $ \c -> do - execute_ (Query "insert into artist values ('Not there', 1999)") c - throwError $ error "fail" - -printRows :: forall a eff. (Show a) => Array a -> Aff (console :: C.CONSOLE | eff) Unit -printRows rows = void $ log $ "result:\n" <> foldMap stringify rows - where stringify = show >>> flip (<>) "\n" - instance artistShow :: Show Artist where show (Artist p) = "Artist (" <> p.name <> ", " <> show p.year <> ")" +derive instance genericArtist :: Generic Artist + +instance eqArtist :: Eq Artist where + eq = gEq + instance artistIsForeign :: IsForeign Artist where read obj = do n <- readProp "name" obj From e6b104dcb8c6f8f600328842e89fb7cd20772724 Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Sat, 18 Jun 2016 22:16:55 +0300 Subject: [PATCH 7/8] Add a new test table --- schema.sql | 2 ++ 1 file changed, 2 insertions(+) diff --git a/schema.sql b/schema.sql index 42f979e..3fa6ae6 100644 --- a/schema.sql +++ b/schema.sql @@ -4,3 +4,5 @@ CREATE TABLE artist ( name text NOT NULL, year int NOT NULL ); + +CREATE table types (timestamp_no_tz timestamp without time zone); From 41e5adfebf3b4a3e89df728a8b52fb4b91e56aca Mon Sep 17 00:00:00 2001 From: Antti Holvikari Date: Thu, 14 Jul 2016 23:13:38 +0300 Subject: [PATCH 8/8] Fix imports --- test/Main.purs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index 9b34a6b..4d3565a 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,15 +8,14 @@ import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (error) import Control.Monad.Error.Class (throwError) import Data.Array (length) -import Data.Date (Date, canonicalDate) +import Data.Date (canonicalDate) import Data.DateTime (DateTime(..)) -import Data.Date.Component (Day(..), Month(..), Year(..)) +import Data.Date.Component (Month(..)) import Data.Enum (toEnum) import Data.Time (Time(..)) -import Data.Time.Component (Hour(..), Minute(..), Second(..)) import Data.Either (either) import Data.Foreign (Foreign) -import Data.JSDate (JSDate, toDateTime) +import Data.JSDate (toDateTime) import Data.Maybe (Maybe(Nothing, Just), maybe) import Data.Foreign.Class (class IsForeign, readProp) import Data.Generic (class Generic, gEq)