diff --git a/src/Database/PostgreSQL/Value.js b/src/Database/PostgreSQL/Value.js index a4b2dcb..40c5648 100644 --- a/src/Database/PostgreSQL/Value.js +++ b/src/Database/PostgreSQL/Value.js @@ -1,5 +1,12 @@ 'use strict'; +// pg does strange thing converting DATE +// value to js Date, so we have +// to prevent this craziness +var pg = require('pg'); +var DATE_OID = 1082; +pg.types.setTypeParser(DATE_OID, function(dateString) { return dateString; }); + exports['null'] = null; exports.instantToString = function(i) { diff --git a/src/Database/PostgreSQL/Value.purs b/src/Database/PostgreSQL/Value.purs index 54a467c..d12b603 100644 --- a/src/Database/PostgreSQL/Value.purs +++ b/src/Database/PostgreSQL/Value.purs @@ -8,14 +8,18 @@ import Control.Monad.Except (runExcept) import Data.Array as Array import Data.Bifunctor (lmap) import Data.ByteString (ByteString) +import Data.Date (Date, canonicalDate, day, month, year) import Data.DateTime.Instant (Instant, instant) import Data.Decimal (Decimal) import Data.Decimal as Decimal import Data.Either (Either(..), note) +import Data.Enum (fromEnum, toEnum) import Data.Foreign (Foreign, isNull, readArray, readBoolean, readChar, readInt, readNumber, readString, toForeign, unsafeFromForeign) +import Data.Int (fromString) import Data.List (List) import Data.List as List import Data.Maybe (Maybe(..)) +import Data.String (Pattern(..), split) import Data.Time.Duration (Milliseconds(..)) import Data.Traversable (traverse) @@ -82,9 +86,33 @@ instance toSQLValueInstant :: ToSQLValue Instant where instance fromSQLValueInstant :: FromSQLValue Instant where fromSQLValue v = do - t ← instantFromString Left Right v + t <- instantFromString Left Right v note ("Instant construction failed for given timestamp: " <> show t) $ instant (Milliseconds t) +instance toSQLValueDate :: ToSQLValue Date where + toSQLValue date = + let + y = fromEnum $ year date + m = fromEnum $ month date + d = fromEnum $ day date + in + toForeign $ show y <> "-" <> show m <> "-" <> show d + +instance fromSQLValueDate :: FromSQLValue Date where + fromSQLValue v = do + s <- lmap show $ runExcept (readString v) + let + msg = "Date parsing failed for value: " <> s + case split (Pattern "-") s of + [y, m, d] -> do + let + result = canonicalDate + <$> (toEnum =<< fromString y) + <*> (toEnum =<< fromString m) + <*> (toEnum =<< fromString d) + note msg result + _ -> Left msg + instance toSQLValueMaybe :: (ToSQLValue a) => ToSQLValue (Maybe a) where toSQLValue Nothing = null toSQLValue (Just x) = toSQLValue x @@ -104,10 +132,10 @@ instance toSQLValueDecimal :: ToSQLValue Decimal where instance fromSQLValueDecimal :: FromSQLValue Decimal where fromSQLValue v = do - s ← lmap show $ runExcept (readString v) + s <- lmap show $ runExcept (readString v) note ("Decimal literal parsing failed: " <> s) (Decimal.fromString s) foreign import null :: Foreign foreign import instantToString :: Instant -> Foreign -foreign import instantFromString :: (String → Either String Number) → (Number → Either String Number) → Foreign → Either String Number +foreign import instantFromString :: (String -> Either String Number) -> (Number -> Either String Number) -> Foreign -> Either String Number foreign import unsafeIsBuffer :: ∀ a. a -> Boolean diff --git a/test/Main.purs b/test/Main.purs index 991a0cf..0366557 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -12,19 +12,24 @@ import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Exception (EXCEPTION, error) import Control.Monad.Eff.Now (NOW) import Control.Monad.Error.Class (catchError, throwError, try) +import Data.Array (zip) +import Data.Date (Date, canonicalDate) import Data.DateTime.Instant (Instant, unInstant) import Data.Decimal as D -import Data.Foldable (all) +import Data.Enum (toEnum) +import Data.Foldable (all, length) import Data.JSDate (toInstant) import Data.JSDate as JSDate import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..)) import Database.PostgreSQL (Connection, POSTGRESQL, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), execute, newPool, query, scalar, withConnection, withTransaction) import Math ((%)) import Partial.Unsafe (unsafePartial) import Test.Assert (ASSERT, assert) import Test.Unit (suite) import Test.Unit as Test.Unit +import Test.Unit.Assert (equal) import Test.Unit.Console (TESTOUTPUT) import Test.Unit.Main (runTest) @@ -50,18 +55,32 @@ test conn t a = Test.Unit.test t (withRollback conn a) now :: ∀ eff. Eff (now :: NOW | eff) Instant now = unsafePartial $ (fromJust <<< toInstant) <$> JSDate.now -main :: ∀ eff. Eff (assert :: ASSERT, avar :: AVAR, console :: CONSOLE, exception :: EXCEPTION, now :: NOW, postgreSQL :: POSTGRESQL, testOutput :: TESTOUTPUT | eff) Unit +main + :: ∀ eff + . Eff + ( assert :: ASSERT + , avar :: AVAR + , console :: CONSOLE + , exception :: EXCEPTION + , now :: NOW + , postgreSQL :: POSTGRESQL + , testOutput :: TESTOUTPUT | eff + ) + Unit main = void $ launchAff do pool <- newPool config withConnection pool \conn -> do execute conn (Query """ - CREATE TEMPORARY TABLE foods ( - name text NOT NULL, - delicious boolean NOT NULL, - price NUMERIC(4,2) NOT NULL, - added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP, - PRIMARY KEY (name) - ) + CREATE TEMPORARY TABLE foods ( + name text NOT NULL, + delicious boolean NOT NULL, + price NUMERIC(4,2) NOT NULL, + added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP, + PRIMARY KEY (name) + ); + CREATE TEMPORARY TABLE dates ( + date date NOT NULL + ); """) Row0 liftEff $ runTest $ do @@ -115,7 +134,7 @@ main = void $ launchAff do """) Row0 liftEff <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true] - test conn "select default instant value" $ do + test conn "handling instant value" $ do before <- liftEff $ (unwrap <<< unInstant) <$> now insertFood added <- query conn (Query """ @@ -131,7 +150,7 @@ main = void $ launchAff do && after >= (unwrap $ unInstant t)) added - test conn "select decimal" $ do + test conn "handling decimal value" $ do insertFood sauerkrautPrice <- query conn (Query """ SELECT price @@ -140,6 +159,27 @@ main = void $ launchAff do """) Row0 liftEff <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")] + test conn "handling date value" $ do + let + date y m d = + canonicalDate <$> toEnum y <*> toEnum m <*> toEnum d + d1 = unsafePartial $ fromJust $ date 2010 2 31 + d2 = unsafePartial $ fromJust $ date 2017 2 1 + d3 = unsafePartial $ fromJust $ date 2020 6 31 + + execute conn (Query """ + INSERT INTO dates (date) + VALUES ($1), ($2), ($3) + """) (Row3 d1 d2 d3) + + (dates :: Array (Row1 Date)) <- query conn (Query """ + SELECT * + FROM dates + ORDER BY date ASC + """) Row0 + equal 3 (length dates) + liftEff <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) + config :: PoolConfiguration config =