diff --git a/bower.json b/bower.json index 64771f5..b93f69e 100644 --- a/bower.json +++ b/bower.json @@ -26,12 +26,19 @@ "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": "^1.0.0", + "purescript-integers": "^1.0.0", + "purescript-datetime": "^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/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); 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.js b/src/Database/Postgres/SqlValue.js deleted file mode 100644 index 83b4cbc..0000000 --- a/src/Database/Postgres/SqlValue.js +++ /dev/null @@ -1,9 +0,0 @@ -'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 87b09fa..301eda8 100644 --- a/src/Database/Postgres/SqlValue.purs +++ b/src/Database/Postgres/SqlValue.purs @@ -4,9 +4,15 @@ module Database.Postgres.SqlValue , toSql ) where -import Prelude ((<<<)) +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 :: * @@ -14,18 +20,28 @@ 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 - toSql (Just x) = toSql x - -foreign import unsafeToSqlValue :: forall a. a -> SqlValue - -foreign import nullSqlValue :: SqlValue + toSql = unsafeCoerce <<< toNullable <<< (toSql <$> _) + +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 diff --git a/test/Main.purs b/test/Main.purs index 13a23aa..4d3565a 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,42 +1,42 @@ module Test.Main where -import Control.Monad.Eff.Console as C -import Control.Monad.Aff (Aff, apathize, attempt, runAff) -import Control.Monad.Aff.Console (log, print) +import Prelude +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 (canonicalDate) +import Data.DateTime (DateTime(..)) +import Data.Date.Component (Month(..)) +import Data.Enum (toEnum) +import Data.Time (Time(..)) import Data.Either (either) -import Data.Foldable (foldMap) +import Data.Foreign (Foreign) +import Data.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 Prelude (class Show, Unit, return, ($), bind, show, (<>), void, flip, (>>>), const) +import Node.Process (PROCESS) -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 <> "..." - 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 +45,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 - print (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,36 +130,16 @@ 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 $ print 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 y <- readProp "year" obj - return $ Artist { name: n, year: y } + pure $ Artist { name: n, year: y }