hasql-postgres 0.1.0 → 0.1.1

raw patch · 8 files changed

+229/−101 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hasql-postgres.cabal +1/−2
• library/Hasql/Postgres.hs +83/−29
• library/Hasql/Postgres/Connector.hs +2/−1
• library/Hasql/Postgres/OID.hs +51/−47
• library/Hasql/Postgres/Parser.hs +27/−1
• library/Hasql/Postgres/Prelude.hs +7/−4
• library/Hasql/Postgres/Renderer.hs +7/−15
• tests/Main.hs +51/−2

@@ -1,7 +1,7 @@ name:   hasql-postgres version:-  0.1.0+  0.1.1 synopsis:   A "PostgreSQL" driver for the "hasql" library description:@@ -69,7 +69,6 @@     old-locale == 1.0.*,     time == 1.4.*,     hashtables == 1.1.*,-    Decimal == 0.4.*,     scientific == 0.3.*,     text >= 1 && < 1.3,     bytestring >= 0.10.4.0 && < 0.11,

@@ -1,4 +1,8 @@-module Hasql.Postgres (Postgres(..)) where+module Hasql.Postgres +(+  Postgres(..), +)+where  import Hasql.Postgres.Prelude import qualified Database.PostgreSQL.LibPQ as PQ@@ -138,6 +142,8 @@ -- * Mappings ------------------------- +-- | Maps to the same type as the underlying value, +-- encoding the 'Nothing' as /NULL/. instance Backend.Mapping Postgres a => Backend.Mapping Postgres (Maybe a) where   renderValue =     \case@@ -148,85 +154,133 @@         Backend.renderValue v   parseResult = traverse (Backend.parseResult . Result . Just) . unpackResult +-- | Maps to \"bool\". instance Backend.Mapping Postgres Bool where-  renderValue = mkRenderValue OID.bool Renderer.bool+  renderValue = mkRenderValue PQ.Text OID.bool Renderer.bool   parseResult = mkParseResult Parser.bool -instance Backend.Mapping Postgres Char where-  renderValue = mkRenderValue OID.varchar Renderer.char-  parseResult = mkParseResult Parser.utf8Char--instance Backend.Mapping Postgres Text where-  renderValue = mkRenderValue OID.text Renderer.text-  parseResult = mkParseResult Parser.utf8Text-+-- | Maps to \"int8\". instance Backend.Mapping Postgres Int where-  renderValue = mkRenderValue OID.int8 Renderer.int+  renderValue = mkRenderValue PQ.Text OID.int8 Renderer.int   parseResult = mkParseResult Parser.integral +-- | Maps to \"int2\". instance Backend.Mapping Postgres Int8 where-  renderValue = mkRenderValue OID.int2 Renderer.int8+  renderValue = mkRenderValue PQ.Text OID.int2 Renderer.int8   parseResult = mkParseResult Parser.integral +-- | Maps to \"int2\". instance Backend.Mapping Postgres Int16 where-  renderValue = mkRenderValue OID.int2 Renderer.int16+  renderValue = mkRenderValue PQ.Text OID.int2 Renderer.int16   parseResult = mkParseResult Parser.integral +-- | Maps to \"int4\". instance Backend.Mapping Postgres Int32 where-  renderValue = mkRenderValue OID.int4 Renderer.int32+  renderValue = mkRenderValue PQ.Text OID.int4 Renderer.int32   parseResult = mkParseResult Parser.integral +-- | Maps to \"int8\". instance Backend.Mapping Postgres Int64 where-  renderValue = mkRenderValue OID.int8 Renderer.int64+  renderValue = mkRenderValue PQ.Text OID.int8 Renderer.int64   parseResult = mkParseResult Parser.integral +-- | Maps to \"int8\". instance Backend.Mapping Postgres Word where-  renderValue = mkRenderValue OID.int8 Renderer.word+  renderValue = mkRenderValue PQ.Text OID.int8 Renderer.word   parseResult = mkParseResult Parser.unsignedIntegral +-- | Maps to \"int2\". instance Backend.Mapping Postgres Word8 where-  renderValue = mkRenderValue OID.int2 Renderer.word8+  renderValue = mkRenderValue PQ.Text OID.int2 Renderer.word8   parseResult = mkParseResult Parser.unsignedIntegral +-- | Maps to \"int4\". instance Backend.Mapping Postgres Word16 where-  renderValue = mkRenderValue OID.int4 Renderer.word16+  renderValue = mkRenderValue PQ.Text OID.int4 Renderer.word16   parseResult = mkParseResult Parser.unsignedIntegral +-- | Maps to \"int8\". instance Backend.Mapping Postgres Word32 where-  renderValue = mkRenderValue OID.int8 Renderer.word32+  renderValue = mkRenderValue PQ.Text OID.int8 Renderer.word32   parseResult = mkParseResult Parser.unsignedIntegral +-- | Maps to \"int8\". instance Backend.Mapping Postgres Word64 where-  renderValue = mkRenderValue OID.int8 Renderer.word64+  renderValue = mkRenderValue PQ.Text OID.int8 Renderer.word64   parseResult = mkParseResult Parser.unsignedIntegral +-- | Maps to \"float4\".+instance Backend.Mapping Postgres Float where+  renderValue = mkRenderValue PQ.Text OID.float4 Renderer.float+  parseResult = mkParseResult Parser.float++-- | Maps to \"float8\".+instance Backend.Mapping Postgres Double where+  renderValue = mkRenderValue PQ.Text OID.float8 Renderer.double+  parseResult = mkParseResult Parser.double++-- | Maps to \"numeric\".+instance Backend.Mapping Postgres Scientific where+  renderValue = mkRenderValue PQ.Text OID.numeric Renderer.scientific+  parseResult = mkParseResult Parser.scientific++-- | Maps to \"date\". instance Backend.Mapping Postgres Day where-  renderValue = mkRenderValue OID.date Renderer.day+  renderValue = mkRenderValue PQ.Text OID.date Renderer.day   parseResult = mkParseResult Parser.day +-- | Maps to \"time\". instance Backend.Mapping Postgres TimeOfDay where-  renderValue = mkRenderValue OID.time Renderer.timeOfDay+  renderValue = mkRenderValue PQ.Text OID.time Renderer.timeOfDay   parseResult = mkParseResult Parser.timeOfDay +-- | Maps to \"timestamp\". instance Backend.Mapping Postgres LocalTime where-  renderValue = mkRenderValue OID.timestamp Renderer.localTime+  renderValue = mkRenderValue PQ.Text OID.timestamp Renderer.localTime   parseResult = mkParseResult Parser.localTime +-- | Maps to \"timestamptz\". instance Backend.Mapping Postgres ZonedTime where-  renderValue = mkRenderValue OID.timestamptz Renderer.zonedTime +  renderValue = mkRenderValue PQ.Text OID.timestamptz Renderer.zonedTime    parseResult = mkParseResult Parser.zonedTime  +-- | Maps to \"timestamp\". instance Backend.Mapping Postgres UTCTime where-  renderValue = mkRenderValue OID.timestamp Renderer.utcTime+  renderValue = mkRenderValue PQ.Text OID.timestamp Renderer.utcTime   parseResult = mkParseResult Parser.utcTime +-- | Maps to \"varchar\".+instance Backend.Mapping Postgres Char where+  renderValue = mkRenderValue PQ.Text OID.varchar Renderer.char+  parseResult = mkParseResult Parser.utf8Char +-- | Maps to \"text\".+instance Backend.Mapping Postgres Text where+  renderValue = mkRenderValue PQ.Text OID.text Renderer.text+  parseResult = mkParseResult Parser.utf8Text++-- | Maps to \"text\".+instance Backend.Mapping Postgres LazyText where+  renderValue = mkRenderValue PQ.Text OID.text Renderer.lazyText+  parseResult = mkParseResult Parser.utf8LazyText++-- | Maps to \"bytea\".+instance Backend.Mapping Postgres ByteString where+  renderValue = mkRenderValue PQ.Binary OID.bytea Renderer.byteString+  parseResult = mkParseResult Parser.byteString++-- | Maps to \"bytea\".+instance Backend.Mapping Postgres LazyByteString where+  renderValue = mkRenderValue PQ.Binary OID.bytea Renderer.lazyByteString+  parseResult = mkParseResult Parser.lazyByteString++ -- |--- Make a 'renderValue' function with the 'Text' format.+-- Make a 'renderValue' function. {-# INLINE mkRenderValue #-}-mkRenderValue :: PQ.Oid -> Renderer.R a -> (a -> Backend.StatementArgument Postgres)-mkRenderValue o r a =-  StatementArgument (o, Just (Renderer.run a r, PQ.Text))+mkRenderValue :: PQ.Format -> PQ.Oid -> Renderer.R a -> (a -> Backend.StatementArgument Postgres)+mkRenderValue f o r a =+  StatementArgument (o, Just (Renderer.run a r, f))  {-# INLINE mkParseResult #-} mkParseResult :: Parser.P a -> (Backend.Result Postgres -> Either Text a)

@@ -49,7 +49,8 @@       [ "SET standard_conforming_strings TO on",         "SET datestyle TO ISO",         "SET client_encoding = 'UTF8'",-        "SET client_min_messages TO WARNING" ]+        "SET client_min_messages TO WARNING",+        "SET bytea_output = 'hex'" ]     return c  

@@ -5,50 +5,54 @@  type OID = Oid -abstime     = Oid 702-bit         = Oid 1560-bool        = Oid 16-box         = Oid 603-bpchar      = Oid 1042-bytea       = Oid 17-char        = Oid 18-cid         = Oid 29-cidr        = Oid 650-circle      = Oid 718-date        = Oid 1082-float4      = Oid 700-float8      = Oid 701-inet        = Oid 869-int2        = Oid 21-int4        = Oid 23-int8        = Oid 20-interval    = Oid 1186-json        = Oid 114-line        = Oid 628-lseg        = Oid 601-macaddr     = Oid 829-money       = Oid 790-name        = Oid 19-numeric     = Oid 1700-oid         = Oid 26-path        = Oid 602-point       = Oid 600-polygon     = Oid 604-record      = Oid 2249-refcursor   = Oid 1790-regproc     = Oid 24-reltime     = Oid 703-text        = Oid 25-tid         = Oid 27-time        = Oid 1083-timestamp   = Oid 1114-timestamptz = Oid 1184-timetz      = Oid 1266-tinterval   = Oid 704-unknown     = Oid 705-uuid        = Oid 2950-varbit      = Oid 1562-varchar     = Oid 1043-void        = Oid 2278-xid         = Oid 28-xml         = Oid 142+abstime     :: OID = Oid 702+anyarray    :: OID = Oid 2277+bit         :: OID = Oid 1560+bool        :: OID = Oid 16+box         :: OID = Oid 603+bpchar      :: OID = Oid 1042+bytea       :: OID = Oid 17+char        :: OID = Oid 18+cid         :: OID = Oid 29+cidr        :: OID = Oid 650+circle      :: OID = Oid 718+date        :: OID = Oid 1082+float4      :: OID = Oid 700+float8      :: OID = Oid 701+gtsvector   :: OID = Oid 3642+inet        :: OID = Oid 869+int2        :: OID = Oid 21+int2vector  :: OID = Oid 22+int4        :: OID = Oid 23+int8        :: OID = Oid 20+interval    :: OID = Oid 1186+json        :: OID = Oid 114+line        :: OID = Oid 628+lseg        :: OID = Oid 601+macaddr     :: OID = Oid 829+money       :: OID = Oid 790+name        :: OID = Oid 19+numeric     :: OID = Oid 1700+oid         :: OID = Oid 26+path        :: OID = Oid 602+point       :: OID = Oid 600+polygon     :: OID = Oid 604+record      :: OID = Oid 2249+refcursor   :: OID = Oid 1790+regproc     :: OID = Oid 24+reltime     :: OID = Oid 703+text        :: OID = Oid 25+tid         :: OID = Oid 27+time        :: OID = Oid 1083+timestamp   :: OID = Oid 1114+timestamptz :: OID = Oid 1184+timetz      :: OID = Oid 1266+tinterval   :: OID = Oid 704+tsvector    :: OID = Oid 3614+unknown     :: OID = Oid 705+uuid        :: OID = Oid 2950+varbit      :: OID = Oid 1562+varchar     :: OID = Oid 1043+void        :: OID = Oid 2278+xid         :: OID = Oid 28+xml         :: OID = Oid 142

@@ -2,12 +2,15 @@  import Hasql.Postgres.Prelude hiding (take) import Data.Attoparsec.ByteString-import Data.Attoparsec.ByteString.Char8+import Data.Attoparsec.ByteString.Char8 hiding (double) import qualified Data.ByteString+import qualified Data.ByteString.Lazy import qualified Data.Text import qualified Data.Text.Encoding import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding+import qualified Data.Attoparsec.ByteString.Char8 as A+import qualified Database.PostgreSQL.LibPQ as PQ   type P = Parser@@ -20,15 +23,38 @@ -- ** Parser ------------------------- +{-# INLINE labeling #-} labeling :: String -> Parser a -> Parser a labeling n p =    p <?> n +scientific :: P Scientific+scientific =+  A.scientific++float :: P Float+float =+  realToFrac <$> double++double :: P Double+double = +  labeling "double" $ A.double+ bool :: P Bool bool =   labeling "bool" $     ((string "true" <|> string "t" <|> string "True" <|> string "1") *> pure True) <|>     ((string "false" <|> string "f" <|> string "False" <|> string "0") *> pure False)++byteString :: P ByteString+byteString =+  labeling "byteString" $+    takeByteString >>= maybe (fail "Improper encoding") return . unsafePerformIO . PQ.unescapeBytea++lazyByteString :: P LazyByteString+lazyByteString =+  labeling "lazyByteString" $+    Data.ByteString.Lazy.fromStrict <$> byteString  utf8Char :: P Char utf8Char =

@@ -1,6 +1,8 @@ module Hasql.Postgres.Prelude (    module Exports,+  LazyByteString,+  LazyText,   bug,   bottom,   partial,@@ -36,10 +38,6 @@ ------------------------- import Data.ByteString as Exports (ByteString) --- decimal---------------------------import Data.Decimal as Exports (Decimal, DecimalRaw)- -- scientific ------------------------- import Data.Scientific as Exports (Scientific)@@ -63,7 +61,12 @@ -- custom ------------------------- import qualified Debug.Trace.LocationTH+import qualified Data.Text.Lazy+import qualified Data.ByteString.Lazy ++type LazyByteString = Data.ByteString.Lazy.ByteString+type LazyText = Data.Text.Lazy.Text  bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]   where

@@ -7,6 +7,7 @@ import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as L import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy.Encoding as LT import qualified Data.ByteString.Builder.Scientific  @@ -45,10 +46,16 @@ byteString :: R ByteString =    B.byteString +lazyByteString :: R LazyByteString = +  B.lazyByteString+ text :: R Text =   byteString . T.encodeUtf8 +lazyText :: R LazyText =+  lazyByteString . LT.encodeUtf8 + -- *** enumerations ------------------------- @@ -105,21 +112,6 @@    double :: R Double =   B.doubleDec--decimalRawInt32 :: R (DecimalRaw Int32) =-  ascii--decimalRawInt64 :: R (DecimalRaw Int64) =-  ascii--decimalRawWord32 :: R (DecimalRaw Word32) =-  ascii--decimalRawWord64 :: R (DecimalRaw Word64) =-  ascii--decimal :: R Decimal =-  ascii  pico :: R Pico =   B.string7 . showFixed True

@@ -7,17 +7,28 @@ import Test.QuickCheck.Instances import Hasql import Hasql.Postgres (Postgres(..))-import Data.Text (Text) import Data.Time import qualified Data.Text+import qualified Data.Text.Lazy+import qualified Data.ByteString+import qualified Data.ByteString.Char8+import qualified Data.ByteString.Lazy+import qualified Data.ByteString.Lazy.Char8 import qualified ListT import qualified SlaveThread import qualified Control.Concurrent.SSem as SSem import qualified Hasql.Backend as Backend import qualified Hasql as H import qualified Hasql.Postgres as H+import qualified Data.Scientific as Scientific  +type Text = Data.Text.Text+type LazyText = Data.Text.Lazy.Text+type ByteString = Data.ByteString.ByteString+type LazyByteString = Data.ByteString.Lazy.ByteString+type Scientific = Scientific.Scientific+ main =    htfMain $ htf_thisModulesTests @@ -39,7 +50,14 @@     rows = [("A", 34525), ("B", 324987)] :: [(Text, Int)]  test_countEffects =-  unitTestPending ""+  assertEqual 100 =<< do +    session1 $ do+      tx Nothing $ do+        unit [q|DROP TABLE IF EXISTS a|]+        unit [q|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL)|]+        replicateM_ 100 $ do+          unit [q|INSERT INTO a (name) VALUES ('a')|]+        count [q|DELETE FROM a|]  test_autoIncrement =   assertEqual (Just (1 :: Word64), Just (2 :: Word64)) =<< do@@ -122,6 +140,16 @@   (isNothing $ Data.Text.find (== '\NUL') v) ==>     Just v === do unsafePerformIO $ session1 $ selectSelf v +prop_mappingOfLazyText (v :: LazyText) =+  (isNothing $ Data.Text.Lazy.find (== '\NUL') v) ==>+    Just v === do unsafePerformIO $ session1 $ selectSelf v++prop_mappingOfByteString (v :: ByteString) =+  Just v === do unsafePerformIO $ session1 $ selectSelf v++prop_mappingOfLazyByteString (v :: LazyByteString) =+  Just v === do unsafePerformIO $ session1 $ selectSelf v+ prop_mappingOfInt (v :: Int) =   Just v === do unsafePerformIO $ session1 $ selectSelf v @@ -152,6 +180,16 @@ prop_mappingOfWord64 (v :: Word64) =   Just v === do unsafePerformIO $ session1 $ selectSelf v +prop_mappingOfFloat (v :: Float) =+  floatEq v (fromJust $ unsafePerformIO $ session1 $ selectSelf v)++prop_mappingOfDouble (v :: Double) =+  floatEq v (fromJust $ unsafePerformIO $ session1 $ selectSelf v)++prop_mappingOfScientific =+  forAll scientificGen $ \v ->+    Just v === do unsafePerformIO $ session1 $ selectSelf v+ prop_mappingOfDay (v :: Day) =   Just v === do unsafePerformIO $ session1 $ selectSelf v @@ -180,6 +218,10 @@   where     gen = UTCTime <$> arbitrary <*> microsDiffTimeGen +scientificGen :: Gen Scientific+scientificGen =+  Scientific.scientific <$> arbitrary <*> arbitrary+ microsTimeOfDayGen :: Gen TimeOfDay microsTimeOfDayGen =   timeToTimeOfDay <$> microsDiffTimeGen@@ -210,3 +252,10 @@   where     backendSettings = Postgres "localhost" 5432 "postgres" "" "postgres"     poolSettings = fromJust $ sessionSettings 6 30++floatEq :: RealFrac a => Show a => a -> a -> Property+floatEq a b =+  counterexample (show a ++ " /~ " ++ show b) $+    a + error >= b && a - error <= b+  where+    error = max (abs a) 1 / 100