postgresql-typed 0.3.3 → 0.4.0

raw patch · 13 files changed

+312/−274 lines, 13 filesdep −parsecdep ~attoparsecdep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies removed: parsec

Dependency ranges changed: attoparsec, bytestring, containers, time

API changes (from Hackage documentation)

Files

• COPYING +2/−1
• Database/PostgreSQL/Typed/Array.hs +7/−11
• Database/PostgreSQL/Typed/Dynamic.hs +27/−13
• Database/PostgreSQL/Typed/Enum.hs +4/−3
• Database/PostgreSQL/Typed/Internal.hs +28/−16
• Database/PostgreSQL/Typed/Protocol.hs +98/−82
• Database/PostgreSQL/Typed/Query.hs +40/−38
• Database/PostgreSQL/Typed/Range.hs +7/−7
• Database/PostgreSQL/Typed/TH.hs +12/−8
• Database/PostgreSQL/Typed/TemplatePG.hs +13/−10
• Database/PostgreSQL/Typed/Types.hs +64/−76
• postgresql-typed.cabal +6/−6
• test/Main.hs +4/−3

@@ -1,4 +1,5 @@-Copyright (c) 2010, 2011, Chris Forno+Copyright (c) 2014, 2015, Dylan Simon+Portions Copyright (c) 2010, 2011, Chris Forno All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, UndecidableInstances, DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, UndecidableInstances, DataKinds, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module: Database.PostgreSQL.Typed.Array@@ -10,13 +10,13 @@  module Database.PostgreSQL.Typed.Array where -import Control.Applicative ((<$>))+import Control.Applicative ((<$>), (*>), (<*))+import qualified Data.Attoparsec.ByteString.Char8 as P import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Char8 as BSC import Data.Char (toLower) import Data.List (intersperse) import Data.Monoid ((<>), mconcat)-import qualified Text.Parsec as P  import Database.PostgreSQL.Typed.Types @@ -39,14 +39,10 @@     el Nothing = BSB.string7 "null"     el (Just e) = pgDQuote (pgArrayDelim ta : "{}") $ pgEncode (pgArrayElementType ta) e instance (PGArrayType ta t, PGColumn t a) => PGColumn ta (PGArray a) where-  pgDecode ta a = either (error . ("pgDecode array: " ++) . show) id $ P.parse pa (BSC.unpack a) a where-    pa = do-      l <- P.between (P.char '{') (P.char '}') $-        P.sepBy el (P.char (pgArrayDelim ta))-      _ <- P.eof-      return l-    el = P.between P.spaces P.spaces $ fmap (pgDecode (pgArrayElementType ta) . BSC.pack) <$>-      parsePGDQuote (pgArrayDelim ta : "{}") (("null" ==) . map toLower)+  pgDecode ta a = either (error . ("pgDecode array (" ++) . (++ ("): " ++ BSC.unpack a))) id $ P.parseOnly pa a where+    pa = P.char '{' *> P.sepBy (P.skipSpace *> el <* P.skipSpace) (P.char (pgArrayDelim ta)) <* P.char '}' <* P.endOfInput+    el = fmap (pgDecode (pgArrayElementType ta)) <$>+      parsePGDQuote False (pgArrayDelim ta : "{}") (("null" ==) . BSC.map toLower)  -- Just a dump of pg_type: instance PGType "boolean" => PGType "boolean[]"

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, FunctionalDependencies, UndecidableInstances, DataKinds, DefaultSignatures, PatternGuards, TemplateHaskell #-}+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, FunctionalDependencies, UndecidableInstances, DataKinds, DefaultSignatures, PatternGuards, GADTs, TemplateHaskell #-} -- | -- Module: Database.PostgreSQL.Typed.Dynamic -- Copyright: 2015 Dylan Simon@@ -8,15 +8,21 @@  module Database.PostgreSQL.Typed.Dynamic    ( PGRep(..)+  , pgLiteralString   , pgSafeLiteral+  , pgSafeLiteralString   , pgSubstituteLiterals   ) where  import Control.Applicative ((<$>))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.Monoid ((<>)) import Data.Int #ifdef USE_SCIENTIFIC import Data.Scientific (Scientific) #endif+import Data.String (fromString) #ifdef USE_TEXT import qualified Data.Text as T #endif@@ -37,8 +43,8 @@   pgEncodeRep :: a -> PGValue   default pgEncodeRep :: PGParameter t a => a -> PGValue   pgEncodeRep x = pgEncodeValue unknownPGTypeEnv (pgTypeOf x) x-  pgLiteralRep :: a -> String-  default pgLiteralRep :: PGParameter t a => a -> String+  pgLiteralRep :: a -> BS.ByteString+  default pgLiteralRep :: PGParameter t a => a -> BS.ByteString   pgLiteralRep x = pgLiteral (pgTypeOf x) x   pgDecodeRep :: PGValue -> a #ifdef USE_BINARY_XXX@@ -50,14 +56,20 @@   pgDecodeRep (PGTextValue v) = pgDecode (PGTypeProxy :: PGTypeName t) v   pgDecodeRep _ = error $ "pgDecodeRep " ++ pgTypeName (PGTypeProxy :: PGTypeName t) ++ ": unsupported PGValue" +pgLiteralString :: PGRep t a => a -> String+pgLiteralString = BSC.unpack . pgLiteralRep+ -- |Produce a safely type-cast literal value for interpolation in a SQL statement.-pgSafeLiteral :: PGRep t a => a -> String-pgSafeLiteral x = pgLiteralRep x ++ "::" ++ pgTypeName (pgTypeOf x)+pgSafeLiteral :: PGRep t a => a -> BS.ByteString+pgSafeLiteral x = pgLiteralRep x <> BSC.pack "::" <> fromString (pgTypeName (pgTypeOf x)) +pgSafeLiteralString :: PGRep t a => a -> String+pgSafeLiteralString x = pgLiteralString x ++ "::" ++ pgTypeName (pgTypeOf x)+ instance PGRep t a => PGRep t (Maybe a) where   pgEncodeRep Nothing = PGNullValue   pgEncodeRep (Just x) = pgEncodeRep x-  pgLiteralRep Nothing = "NULL"+  pgLiteralRep Nothing = BSC.pack "NULL"   pgLiteralRep (Just x) = pgLiteralRep x   pgDecodeRep PGNullValue = Nothing   pgDecodeRep v = Just (pgDecodeRep v)@@ -71,6 +83,7 @@ instance PGRep "double precision" Double instance PGRep "\"char\"" Char instance PGRep "text" String+instance PGRep "text" BS.ByteString #ifdef USE_TEXT instance PGRep "text" T.Text #endif@@ -91,11 +104,12 @@ -- This lets you do safe, type-driven literal substitution into SQL fragments without needing a full query, bypassing placeholder inference and any prepared queries. -- Unlike most other TH functions, this does not require any database connection. pgSubstituteLiterals :: String -> TH.ExpQ-pgSubstituteLiterals ('$':'$':'{':s) = (++$) "${" <$> pgSubstituteLiterals s-pgSubstituteLiterals ('$':'{':s)-  | (e, '}':r) <- break (\c -> c == '{' || c == '}') s = do+pgSubstituteLiterals sql = TH.AppE (TH.VarE 'BS.concat) . TH.ListE <$> ssl (sqlSplitExprs sql) where+  ssl :: SQLSplit String True -> TH.Q [TH.Exp]+  ssl (SQLLiteral s l) = (TH.VarE 'fromString `TH.AppE` stringE s :) <$> ssp l+  ssl SQLSplitEnd = return []+  ssp :: SQLSplit String False -> TH.Q [TH.Exp]+  ssp (SQLPlaceholder e l) = do     v <- either (fail . (++) ("Failed to parse expression {" ++ e ++ "}: ")) return $ parseExp e-    ($++$) (TH.VarE 'pgSafeLiteral `TH.AppE` v) <$> pgSubstituteLiterals r-  | otherwise = fail $ "Error parsing SQL: could not find end of expression: ${" ++ s-pgSubstituteLiterals (c:r) = (++$) [c] <$> pgSubstituteLiterals r-pgSubstituteLiterals "" = return $ stringE ""+    (TH.VarE 'pgSafeLiteral `TH.AppE` v :) <$> ssl l+  ssp SQLSplitEnd = return []

@@ -14,7 +14,8 @@ import Control.Monad (when) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC-import qualified Data.ByteString.UTF8 as U+import qualified Data.ByteString.Lazy as BSL+import Data.String (fromString) import Data.Typeable (Typeable) import qualified Language.Haskell.TH as TH @@ -49,10 +50,10 @@   -> TH.DecsQ makePGEnum name typs valnf = do   (_, vals) <- TH.runIO $ withTPGConnection $ \c ->-    pgSimpleQuery c $ "SELECT enumlabel FROM pg_catalog.pg_enum JOIN pg_catalog.pg_type t ON enumtypid = t.oid WHERE typtype = 'e' AND format_type(t.oid, -1) = " ++ pgQuote name ++ " ORDER BY enumsortorder"+    pgSimpleQuery c $ BSL.fromChunks [BSC.pack "SELECT enumlabel FROM pg_catalog.pg_enum JOIN pg_catalog.pg_type t ON enumtypid = t.oid WHERE typtype = 'e' AND format_type(t.oid, -1) = ", pgQuote (fromString name), BSC.pack " ORDER BY enumsortorder"]   when (null vals) $ fail $ "makePGEnum: enum " ++ name ++ " not found"   let -    valn = map (\[PGTextValue v] -> let u = U.toString v in (TH.mkName $ valnf u, map (TH.IntegerL . fromIntegral) $ BS.unpack v, TH.StringL u)) vals+    valn = map (\[PGTextValue v] -> let u = BSC.unpack v in (TH.mkName $ valnf u, map (TH.IntegerL . fromIntegral) $ BS.unpack v, TH.StringL u)) vals   dv <- TH.newName "x"   return     [ TH.DataD [] typn [] (map (\(n, _, _) -> TH.NormalC n []) valn) [''Eq, ''Ord, ''Enum, ''Bounded, ''Typeable]

@@ -1,33 +1,45 @@-{-# LANGUAGE PatternSynonyms, TemplateHaskell #-}+{-# LANGUAGE PatternSynonyms, PatternGuards, TemplateHaskell, GADTs, KindSignatures, DataKinds #-} module Database.PostgreSQL.Typed.Internal   ( stringE   , pattern StringE-  , ($++$)-  , (++$)+  , SQLSplit(..)+  , sqlSplitExprs+  , sqlSplitParams   ) where +import Data.Char (isDigit) import Data.String (IsString(..)) import qualified Language.Haskell.TH as TH+import Numeric (readDec)  stringE :: String -> TH.Exp stringE = TH.LitE . TH.StringL  pattern StringE s = TH.LitE (TH.StringL s)-pattern InfixE l o r = TH.InfixE (Just l) (TH.VarE o) (Just r)  instance IsString TH.Exp where   fromString = stringE -($++$) :: TH.Exp -> TH.Exp -> TH.Exp-infixr 5 $++$-StringE s $++$ r = s ++$ r-l $++$ StringE "" = l-InfixE ll pp (StringE lr) $++$ StringE r | pp == '(++) = ll $++$ StringE (lr ++ r)-l $++$ r = InfixE l '(++) r+data SQLSplit a (literal :: Bool) where+  SQLLiteral :: String -> SQLSplit a False -> SQLSplit a True+  SQLPlaceholder :: a -> SQLSplit a True -> SQLSplit a False+  SQLSplitEnd :: SQLSplit a any -(++$) :: String -> TH.Exp -> TH.Exp-infixr 5 ++$-"" ++$ r = r-l ++$ StringE r = StringE (l ++ r)-l ++$ InfixE (StringE rl) pp rr | pp == '(++) = (l ++ rl) ++$ rr-l ++$ r = InfixE (StringE l) '(++) r+sqlCons :: Char -> SQLSplit a True -> SQLSplit a True+sqlCons c (SQLLiteral s l) = SQLLiteral (c : s) l+sqlCons c SQLSplitEnd = SQLLiteral [c] SQLSplitEnd++sqlSplitExprs :: String -> SQLSplit String True+sqlSplitExprs ('$':'$':'{':s) = sqlCons '$' $ sqlCons '{' $ sqlSplitExprs s+sqlSplitExprs ('$':'{':s)+  | (e, '}':r) <- break (\c -> c == '{' || c == '}') s = SQLLiteral "" $ SQLPlaceholder e $ sqlSplitExprs r+  | otherwise = error $ "Error parsing SQL: could not find end of expression: ${" ++ s+sqlSplitExprs (c:s) = sqlCons c $ sqlSplitExprs s+sqlSplitExprs [] = SQLSplitEnd++sqlSplitParams :: String -> SQLSplit Int True+sqlSplitParams ('$':'$':d:s) | isDigit d = sqlCons '$' $ sqlCons d $ sqlSplitParams s+sqlSplitParams ('$':s@(d:_)) | isDigit d, [(n, r)] <- readDec s = SQLLiteral "" $ SQLPlaceholder n $ sqlSplitParams r+sqlSplitParams (c:s) = sqlCons c $ sqlSplitParams s+sqlSplitParams [] = SQLSplitEnd+

@@ -18,6 +18,7 @@   , pgReconnect   , pgDescribe   , pgSimpleQuery+  , pgSimpleQueries_   , pgPreparedQuery   , pgPreparedLazyQuery   , pgCloseStatement@@ -37,10 +38,8 @@ import Data.ByteString.Internal (w2c) import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Lazy.Internal (smallChunkSize)-import qualified Data.ByteString.Lazy.UTF8 as BSLU-import qualified Data.ByteString.UTF8 as BSU import qualified Data.Foldable as Fold-import Data.IORef (IORef, newIORef, writeIORef, readIORef, atomicModifyIORef, atomicModifyIORef', modifyIORef)+import Data.IORef (IORef, newIORef, writeIORef, readIORef, atomicModifyIORef, atomicModifyIORef', modifyIORef, modifyIORef') import Data.Int (Int32, Int16) import qualified Data.Map.Lazy as Map import Data.Maybe (fromMaybe)@@ -48,7 +47,7 @@ import Data.Typeable (Typeable) import Data.Word (Word32) import Network (HostName, PortID(..), connectTo)-import System.IO (Handle, hFlush, hClose, stderr, hPutStrLn)+import System.IO (Handle, hFlush, hClose, stderr, hPutStrLn, hSetBuffering, BufferMode(BlockBuffering)) import System.IO.Unsafe (unsafeInterleaveIO) import Text.Read (readMaybe) @@ -57,6 +56,7 @@  data PGState   = StateUnknown -- no Sync+  | StateCommand -- was Sync, sent command   | StatePending -- Sync sent   -- ReadyForQuery received:   | StateIdle@@ -70,8 +70,8 @@ data PGDatabase = PGDatabase   { pgDBHost :: HostName -- ^ The hostname (ignored if 'pgDBPort' is 'UnixSocket')   , pgDBPort :: PortID -- ^ The port, likely either @PortNumber 5432@ or @UnixSocket \"\/tmp\/.s.PGSQL.5432\"@-  , pgDBName :: String -- ^ The name of the database-  , pgDBUser, pgDBPass :: String+  , pgDBName :: BS.ByteString -- ^ The name of the database+  , pgDBUser, pgDBPass :: BS.ByteString   , pgDBDebug :: Bool -- ^ Log all low-level server messages   , pgDBLogMessage :: MessageFields -> IO () -- ^ How to log server notice messages (e.g., @print . PGError@)   }@@ -87,15 +87,15 @@   , connDatabase :: !PGDatabase   , connPid :: !Word32 -- unused   , connKey :: !Word32 -- unused-  , connParameters :: Map.Map String String+  , connParameters :: Map.Map BS.ByteString BS.ByteString   , connTypeEnv :: PGTypeEnv-  , connPreparedStatements :: IORef (Integer, Map.Map (String, [OID]) Integer)+  , connPreparedStatements :: IORef (Integer, Map.Map (BS.ByteString, [OID]) Integer)   , connState :: IORef PGState   , connInput :: IORef (G.Decoder PGBackendMessage)   }  data ColDescription = ColDescription-  { colName :: String+  { colName :: BS.ByteString   , colTable :: !OID   , colNumber :: !Int16   , colType :: !OID@@ -103,26 +103,26 @@   , colBinary :: !Bool   } deriving (Show) -type MessageFields = Map.Map Char String+type MessageFields = Map.Map Char BS.ByteString  -- |PGFrontendMessage represents a PostgreSQL protocol message that we'll send. -- See <http://www.postgresql.org/docs/current/interactive/protocol-message-formats.html>. data PGFrontendMessage-  = StartupMessage [(String, String)] -- only sent first+  = StartupMessage [(BS.ByteString, BS.ByteString)] -- only sent first   | CancelRequest !Word32 !Word32 -- sent first on separate connection-  | Bind { statementName :: String, bindParameters :: PGValues, binaryColumns :: [Bool] }-  | Close { statementName :: String }+  | Bind { statementName :: BS.ByteString, bindParameters :: PGValues, binaryColumns :: [Bool] }+  | Close { statementName :: BS.ByteString }   -- |Describe a SQL query/statement. The SQL string can contain   --  parameters ($1, $2, etc.).-  | Describe { statementName :: String }+  | Describe { statementName :: BS.ByteString }   | Execute !Word32   | Flush   -- |Parse SQL Destination (prepared statement)-  | Parse { statementName :: String, queryString :: String, parseTypes :: [OID] }+  | Parse { statementName :: BS.ByteString, queryString :: BSL.ByteString, parseTypes :: [OID] }   | PasswordMessage BS.ByteString   -- |SimpleQuery takes a simple SQL string. Parameters ($1, $2,   --  etc.) aren't allowed.-  | SimpleQuery { queryString :: String }+  | SimpleQuery { queryString :: BSL.ByteString }   | Sync   | Terminate   deriving (Show)@@ -137,14 +137,8 @@   | BackendKeyData Word32 Word32   | BindComplete   | CloseComplete-  -- |CommandComplete is bare for now, although it could be made-  --  to contain the number of rows affected by statements in a-  --  later version.   | CommandComplete BS.ByteString-  -- |Each DataRow (result of a query) is a list of ByteStrings-  --  (or just Nothing for null values, to distinguish them from-  --  emtpy strings). The ByteStrings can then be converted to-  --  the appropriate type by 'pgStringToType'.+  -- |Each DataRow (result of a query) is a list of 'PGValue', which are assumed to be text unless known to be otherwise.   | DataRow PGValues   | EmptyQueryResponse   -- |An ErrorResponse contains the severity, "SQLSTATE", and@@ -158,7 +152,7 @@   --  PostgreSQL does not give us nullability information for the   --  parameter.   | ParameterDescription [OID]-  | ParameterStatus String String+  | ParameterStatus BS.ByteString BS.ByteString   | ParseComplete   | PortalSuspended   | ReadyForQuery PGState@@ -181,15 +175,15 @@ -- |Produce a human-readable string representing the message displayMessage :: MessageFields -> String displayMessage m = "PG" ++ f 'S' ++ " [" ++ f 'C' ++ "]: " ++ f 'M' ++ '\n' : f 'D'-  where f c = Map.findWithDefault "" c m+  where f c = BSC.unpack $ Map.findWithDefault BS.empty c m -makeMessage :: String -> String -> MessageFields+makeMessage :: BS.ByteString -> BS.ByteString -> MessageFields makeMessage m d = Map.fromAscList [('D', d), ('M', m)]  -- |Message SQLState code. --  See <http://www.postgresql.org/docs/current/static/errcodes-appendix.html>.-pgErrorCode :: PGError -> String-pgErrorCode (PGError e) = Map.findWithDefault "" 'C' e+pgErrorCode :: PGError -> BS.ByteString+pgErrorCode (PGError e) = Map.findWithDefault BS.empty 'C' e  defaultLogMessage :: MessageFields -> IO () defaultLogMessage = hPutStrLn stderr . displayMessage@@ -197,7 +191,7 @@ -- |A database connection with sane defaults: -- localhost:5432:postgres defaultPGDatabase :: PGDatabase-defaultPGDatabase = PGDatabase "localhost" (PortNumber 5432) "postgres" "postgres" "" False defaultLogMessage+defaultPGDatabase = PGDatabase "localhost" (PortNumber 5432) (BSC.pack "postgres") (BSC.pack "postgres") BS.empty False defaultLogMessage  connDebug :: PGConnection -> Bool connDebug = pgDBDebug . connDatabase@@ -217,19 +211,20 @@ nul :: B.Builder nul = B.word8 0 --- |Convert a string to a NULL-terminated UTF-8 string. The PostgreSQL---  protocol transmits most strings in this format.-pgString :: String -> B.Builder-pgString s = B.stringUtf8 s <> nul+byteStringNul :: BS.ByteString -> B.Builder+byteStringNul s = B.byteString s <> nul --- |Given a message, determinal the (optional) type ID and the body+lazyByteStringNul :: BSL.ByteString -> B.Builder+lazyByteStringNul s = B.lazyByteString s <> nul++-- |Given a message, determin the (optional) type ID and the body messageBody :: PGFrontendMessage -> (Maybe Char, B.Builder) messageBody (StartupMessage kv) = (Nothing, B.word32BE 0x30000-  <> Fold.foldMap (\(k, v) -> pgString k <> pgString v) kv <> nul)+  <> Fold.foldMap (\(k, v) -> byteStringNul k <> byteStringNul v) kv <> nul) messageBody (CancelRequest pid key) = (Nothing, B.word32BE 80877102   <> B.word32BE pid <> B.word32BE key) messageBody Bind{ statementName = n, bindParameters = p, binaryColumns = bc } = (Just 'B',-  nul <> pgString n+  nul <> byteStringNul n     <> (if any fmt p           then B.word16BE (fromIntegral $ length p) <> Fold.foldMap (B.word16BE . fromIntegral . fromEnum . fmt) p           else B.word16BE 0)@@ -244,45 +239,48 @@   val (PGTextValue v) = B.word32BE (fromIntegral $ BS.length v) <> B.byteString v   val (PGBinaryValue v) = B.word32BE (fromIntegral $ BS.length v) <> B.byteString v messageBody Close{ statementName = n } = (Just 'C', -  B.char7 'S' <> pgString n)+  B.char7 'S' <> byteStringNul n) messageBody Describe{ statementName = n } = (Just 'D',-  B.char7 'S' <> pgString n)+  B.char7 'S' <> byteStringNul n) messageBody (Execute r) = (Just 'E',   nul <> B.word32BE r) messageBody Flush = (Just 'H', mempty) messageBody Parse{ statementName = n, queryString = s, parseTypes = t } = (Just 'P',-  pgString n <> pgString s+  byteStringNul n <> lazyByteStringNul s     <> B.word16BE (fromIntegral $ length t) <> Fold.foldMap B.word32BE t) messageBody (PasswordMessage s) = (Just 'p',   B.byteString s <> nul) messageBody SimpleQuery{ queryString = s } = (Just 'Q',-  pgString s)+  lazyByteStringNul s) messageBody Sync = (Just 'S', mempty) messageBody Terminate = (Just 'X', mempty)  -- |Send a message to PostgreSQL (low-level). pgSend :: PGConnection -> PGFrontendMessage -> IO () pgSend c@PGConnection{ connHandle = h, connState = sr } msg = do-  writeIORef sr (case msg of Sync -> StatePending ; _ -> StateUnknown)+  modifyIORef' sr $ state msg   when (connDebug c) $ putStrLn $ "> " ++ show msg   B.hPutBuilder h $ Fold.foldMap B.char7 t <> B.word32BE (fromIntegral $ 4 + BS.length b)   BS.hPut h b -- or B.hPutBuilder? But we've already had to convert to BS to get length-  where (t, b) = second (BSL.toStrict . B.toLazyByteString) $ messageBody msg+  where+  (t, b) = second (BSL.toStrict . B.toLazyByteString) $ messageBody msg+  state _ StateClosed = StateClosed+  state Sync _ = StatePending+  state Terminate _ = StateClosed+  state _ StateUnknown = StateUnknown+  state _ _ = StateCommand  pgFlush :: PGConnection -> IO () pgFlush = hFlush . connHandle  -getPGString :: G.Get String-getPGString = BSLU.toString <$> G.getLazyByteStringNul- getByteStringNul :: G.Get BS.ByteString getByteStringNul = fmap BSL.toStrict G.getLazyByteStringNul  getMessageFields :: G.Get MessageFields getMessageFields = g . w2c =<< G.getWord8 where   g '\0' = return Map.empty-  g f = liftM2 (Map.insert f . BSU.toString) getByteStringNul getMessageFields+  g f = liftM2 (Map.insert f) getByteStringNul getMessageFields  -- |Parse an incoming message. getMessageBody :: Char -> G.Get PGBackendMessage@@ -298,7 +296,7 @@   numFields <- G.getWord16be   RowDescription <$> replicateM (fromIntegral numFields) getField where   getField = do-    name <- getPGString+    name <- getByteStringNul     oid <- G.getWord32be -- table OID     col <- G.getWord16be -- column number     typ' <- G.getWord32be -- type@@ -322,7 +320,7 @@ getMessageBody '2' = return BindComplete getMessageBody '3' = return CloseComplete getMessageBody 'C' = CommandComplete <$> getByteStringNul-getMessageBody 'S' = liftM2 ParameterStatus getPGString getPGString+getMessageBody 'S' = liftM2 ParameterStatus getByteStringNul getByteStringNul getMessageBody 'D' = do    numFields <- G.getWord16be   DataRow <$> replicateM (fromIntegral numFields) (getField =<< G.getWord32be) where@@ -350,25 +348,27 @@   return msg  pgRecv :: Bool -> PGConnection -> IO (Maybe PGBackendMessage)-pgRecv block c@PGConnection{ connHandle = h, connInput = dr } =+pgRecv block c@PGConnection{ connHandle = h, connInput = dr, connState = sr } =   go =<< readIORef dr where   next = writeIORef dr-  state s d = writeIORef (connState c) s >> next d+  state s d = writeIORef sr s >> next d   new = G.pushChunk getMessage   go (G.Done b _ m) = do     when (connDebug c) $ putStrLn $ "< " ++ show m-    got (new b) m+    got (new b) m =<< readIORef sr   go (G.Fail _ _ r) = next (new BS.empty) >> fail r -- not clear how can recover   go d@(G.Partial r) = do     b <- (if block then BS.hGetSome else BS.hGetNonBlocking) h smallChunkSize     if BS.null b       then Nothing <$ next d       else go $ r (Just b)-  got :: G.Decoder PGBackendMessage -> PGBackendMessage -> IO (Maybe PGBackendMessage)-  got d (NoticeResponse m) = connLogMessage c m >> go d-  got d m@(ReadyForQuery s) = Just m <$ state s d-  got d m@(ErrorResponse _) = Just m <$ state StateUnknown d-  got d m                   = Just m <$ next d+  got :: G.Decoder PGBackendMessage -> PGBackendMessage -> PGState -> IO (Maybe PGBackendMessage)+  got d (NoticeResponse m) _ = connLogMessage c m >> go d+  got d (ReadyForQuery _) StateCommand = go d+  got d m@(ReadyForQuery s) _ = Just m <$ state s d+  got d m@(ErrorResponse _) _ = Just m <$ state StateUnknown d+  got d m StateCommand = Just m <$ state StateUnknown d+  got d m _ = Just m <$ next d  -- |Receive the next message from PostgreSQL (low-level). Note that this will -- block until it gets a message.@@ -389,6 +389,7 @@   prep <- newIORef (0, Map.empty)   input <- newIORef getMessage   h <- connectTo (pgDBHost db) (pgDBPort db)+  hSetBuffering h (BlockBuffering Nothing)   let c = PGConnection         { connHandle = h         , connDatabase = db@@ -401,13 +402,13 @@         , connInput = input         }   pgSend c $ StartupMessage-    [ ("user", pgDBUser db)-    , ("database", pgDBName db)-    , ("client_encoding", "UTF8")-    , ("standard_conforming_strings", "on")-    , ("bytea_output", "hex")-    , ("DateStyle", "ISO, YMD")-    , ("IntervalStyle", "iso_8601")+    [ (BSC.pack "user", pgDBUser db)+    , (BSC.pack "database", pgDBName db)+    , (BSC.pack "client_encoding", BSC.pack "UTF8")+    , (BSC.pack "standard_conforming_strings", BSC.pack "on")+    , (BSC.pack "bytea_output", BSC.pack "hex")+    , (BSC.pack "DateStyle", BSC.pack "ISO, YMD")+    , (BSC.pack "IntervalStyle", BSC.pack "iso_8601")     ]   pgFlush c   conn c@@ -415,19 +416,19 @@   conn c = pgReceive c >>= msg c   msg c (ReadyForQuery _) = return c     { connTypeEnv = PGTypeEnv-      { pgIntegerDatetimes = fmap ("on" ==) $ Map.lookup "integer_datetimes" (connParameters c)+      { pgIntegerDatetimes = fmap (BSC.pack "on" ==) $ Map.lookup (BSC.pack "integer_datetimes") (connParameters c)       }     }   msg c (BackendKeyData p k) = conn c{ connPid = p, connKey = k }   msg c (ParameterStatus k v) = conn c{ connParameters = Map.insert k v $ connParameters c }   msg c AuthenticationOk = conn c   msg c AuthenticationCleartextPassword = do-    pgSend c $ PasswordMessage $ BSU.fromString $ pgDBPass db+    pgSend c $ PasswordMessage $ pgDBPass db     pgFlush c     conn c #ifdef USE_MD5   msg c (AuthenticationMD5Password salt) = do-    pgSend c $ PasswordMessage $ BSC.pack "md5" `BS.append` md5 (md5 (BSU.fromString (pgDBPass db ++ pgDBUser db)) `BS.append` salt)+    pgSend c $ PasswordMessage $ BSC.pack "md5" `BS.append` md5 (md5 (pgDBPass db <> pgDBUser db) `BS.append` salt)     pgFlush c     conn c #endif@@ -436,9 +437,8 @@ -- |Disconnect cleanly from the PostgreSQL server. pgDisconnect :: PGConnection -- ^ a handle from 'pgConnect'              -> IO ()-pgDisconnect c@PGConnection{ connHandle = h, connState = s } = do+pgDisconnect c@PGConnection{ connHandle = h } = do   pgSend c Terminate-  writeIORef s StateClosed   hClose h  -- |Possibly re-open a connection to a different database, either reusing the connection if the given database is already connected or closing it and opening a new one.@@ -473,21 +473,21 @@         wait s       (Just (ReadyForQuery _)) -> return ()       (Just m) -> do-        connLogMessage c $ makeMessage ("Unexpected server message: " ++ show m) "Each statement should only contain a single query"+        connLogMessage c $ makeMessage (BSC.pack $ "Unexpected server message: " ++ show m) $ BSC.pack "Each statement should only contain a single query"         wait s      -- |Describe a SQL statement/query. A statement description consists of 0 or -- more parameter descriptions (a PostgreSQL type) and zero or more result -- field descriptions (for queries) (consist of the name of the field, the -- type of the field, and a nullability indicator).-pgDescribe :: PGConnection -> String -- ^ SQL string+pgDescribe :: PGConnection -> BSL.ByteString -- ^ SQL string                   -> [OID] -- ^ Optional type specifications                   -> Bool -- ^ Guess nullability, otherwise assume everything is-                  -> IO ([OID], [(String, OID, Bool)]) -- ^ a list of parameter types, and a list of result field names, types, and nullability indicators.+                  -> IO ([OID], [(BS.ByteString, OID, Bool)]) -- ^ a list of parameter types, and a list of result field names, types, and nullability indicators. pgDescribe h sql types nulls = do   pgSync h-  pgSend h $ Parse{ queryString = sql, statementName = "", parseTypes = types }-  pgSend h $ Describe ""+  pgSend h $ Parse{ queryString = sql, statementName = BS.empty, parseTypes = types }+  pgSend h $ Describe BS.empty   pgSend h Flush   pgSend h Sync   pgFlush h@@ -509,7 +509,7 @@     | nulls && oid /= 0 = do       -- In cases where the resulting field is tracable to the column of a       -- table, we can check there.-      (_, r) <- pgPreparedQuery h "SELECT attnotnull FROM pg_catalog.pg_attribute WHERE attrelid = $1 AND attnum = $2" [26, 21] [pgEncodeRep (oid :: OID), pgEncodeRep (col :: Int16)] []+      (_, r) <- pgPreparedQuery h (BSC.pack "SELECT attnotnull FROM pg_catalog.pg_attribute WHERE attrelid = $1 AND attnum = $2") [26, 21] [pgEncodeRep (oid :: OID), pgEncodeRep (col :: Int16)] []       case r of         [[s]] -> return $ not $ pgDecodeRep s         [] -> return True@@ -532,7 +532,7 @@ -- message to the PostgreSQL server. The query is sent as a single string; you -- cannot bind parameters. Note that queries can return 0 results (an empty -- list).-pgSimpleQuery :: PGConnection -> String -- ^ SQL string+pgSimpleQuery :: PGConnection -> BSL.ByteString -- ^ SQL string                    -> IO (Int, [PGValues]) -- ^ The number of rows affected and a list of result rows pgSimpleQuery h sql = do   pgSync h@@ -549,14 +549,30 @@   row _ _ m = fail $ "pgSimpleQuery: unexpected row: " ++ show m   got c r = return (rowsAffected c, r) -pgPreparedBind :: PGConnection -> String -> [OID] -> PGValues -> [Bool] -> IO (IO ())+-- |A simple query which may contain multiple queries (separated by semi-colons) whose results are all ignored.+pgSimpleQueries_ :: PGConnection -> BSL.ByteString -- ^ SQL string+                   -> IO ()+pgSimpleQueries_ h sql = do+  pgSync h+  pgSend h $ SimpleQuery sql+  pgFlush h+  go where+  go = pgReceive h >>= res+  res (RowDescription _) = go+  res (CommandComplete _) = go+  res EmptyQueryResponse = go+  res (DataRow _) = go+  res (ReadyForQuery _) = return ()+  res m = fail $ "pgSimpleQueries_: unexpected response: " ++ show m++pgPreparedBind :: PGConnection -> BS.ByteString -> [OID] -> PGValues -> [Bool] -> IO (IO ()) pgPreparedBind c@PGConnection{ connPreparedStatements = psr } sql types bind bc = do   pgSync c   (p, n) <- atomicModifyIORef' psr $ \(i, m) ->     maybe ((succ i, m), (False, i)) ((,) (i, m) . (,) True) $ Map.lookup key m-  let sn = show n+  let sn = BSC.pack $ show n   unless p $-    pgSend c $ Parse{ queryString = sql, statementName = sn, parseTypes = types }+    pgSend c $ Parse{ queryString = BSL.fromStrict sql, statementName = sn, parseTypes = types }   pgSend c $ Bind{ statementName = sn, bindParameters = bind, binaryColumns = bc }   let     go = pgReceive c >>= start@@ -571,7 +587,7 @@  -- |Prepare a statement, bind it, and execute it. -- If the given statement has already been prepared (and not yet closed) on this connection, it will be re-used.-pgPreparedQuery :: PGConnection -> String -- ^ SQL statement with placeholders+pgPreparedQuery :: PGConnection -> BS.ByteString -- ^ SQL statement with placeholders   -> [OID] -- ^ Optional type specifications (only used for first call)   -> PGValues -- ^ Paremeters to bind to placeholders   -> [Bool] -- ^ Requested binary format for result columns@@ -593,7 +609,7 @@  -- |Like 'pgPreparedQuery' but requests results lazily in chunks of the given size. -- Does not use a named portal, so other requests may not intervene.-pgPreparedLazyQuery :: PGConnection -> String -> [OID] -> PGValues -> [Bool] -> Word32 -- ^ Chunk size (1 is common, 0 is all-at-once)+pgPreparedLazyQuery :: PGConnection -> BS.ByteString -> [OID] -> PGValues -> [Bool] -> Word32 -- ^ Chunk size (1 is common, 0 is all-at-once)   -> IO [PGValues] pgPreparedLazyQuery c sql types bind bc count = do   start <- pgPreparedBind c sql types bind bc@@ -614,13 +630,13 @@   row _ m = fail $ "pgPreparedLazyQuery: unexpected row: " ++ show m  -- |Close a previously prepared query (if necessary).-pgCloseStatement :: PGConnection -> String -> [OID] -> IO ()+pgCloseStatement :: PGConnection -> BS.ByteString -> [OID] -> IO () pgCloseStatement c@PGConnection{ connPreparedStatements = psr } sql types = do   mn <- atomicModifyIORef psr $ \(i, m) ->     let (n, m') = Map.updateLookupWithKey (\_ _ -> Nothing) (sql, types) m in ((i, m'), n)   Fold.forM_ mn $ \n -> do     pgSync c-    pgSend c $ Close{ statementName = show n }+    pgSend c $ Close{ statementName = BSC.pack $ show n }     pgFlush c     CloseComplete <- pgReceive c     return ()

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, PatternGuards, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, TemplateHaskell #-}+{-# LANGUAGE CPP, PatternGuards, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, GADTs, DataKinds, TemplateHaskell #-} module Database.PostgreSQL.Typed.Query   ( PGQuery(..)   , PGSimpleQuery@@ -18,9 +18,12 @@ import Control.Applicative ((<$>)) import Control.Arrow ((***), first, second) import Control.Exception (try)-import Control.Monad (when, mapAndUnzipM)+import Control.Monad (void, when, mapAndUnzipM) import Data.Array (listArray, (!), inRange)-import Data.Char (isDigit, isSpace)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import Data.Char (isSpace) import qualified Data.Foldable as Fold import Data.List (dropWhileEnd) import Data.Maybe (fromMaybe, isNothing)@@ -29,7 +32,6 @@ import Language.Haskell.Meta.Parse (parseExp) import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote (QuasiQuoter(..))-import Numeric (readDec)  import Database.PostgreSQL.Typed.Internal import Database.PostgreSQL.Typed.Types@@ -43,7 +45,7 @@   -- |Change the raw SQL query stored within this query.   -- This is unsafe because the query has already been type-checked, so any change must not change the number or type of results or placeholders (so adding additional static WHERE or ORDER BY clauses is generally safe).   -- This is useful in cases where you need to construct some part of the query dynamically, but still want to infer the result types.-  unsafeModifyQuery :: q -> (String -> String) -> q+  unsafeModifyQuery :: q -> (BS.ByteString -> BS.ByteString) -> q class PGQuery q PGValues => PGRawQuery q  -- |Execute a query that does not return results.@@ -55,17 +57,17 @@ pgQuery :: PGQuery q a => PGConnection -> q -> IO [a] pgQuery c q = snd <$> pgRunQuery c q -instance PGQuery String PGValues where-  pgRunQuery c sql = pgSimpleQuery c sql+instance PGQuery BS.ByteString PGValues where+  pgRunQuery c sql = pgSimpleQuery c (BSL.fromStrict sql)   unsafeModifyQuery q f = f q -newtype SimpleQuery = SimpleQuery String+newtype SimpleQuery = SimpleQuery BS.ByteString instance PGQuery SimpleQuery PGValues where-  pgRunQuery c (SimpleQuery sql) = pgSimpleQuery c sql+  pgRunQuery c (SimpleQuery sql) = pgSimpleQuery c (BSL.fromStrict sql)   unsafeModifyQuery (SimpleQuery sql) f = SimpleQuery $ f sql instance PGRawQuery SimpleQuery -data PreparedQuery = PreparedQuery String [OID] PGValues [Bool]+data PreparedQuery = PreparedQuery BS.ByteString [OID] PGValues [Bool] instance PGQuery PreparedQuery PGValues where   pgRunQuery c (PreparedQuery sql types bind bc) = pgPreparedQuery c sql types bind bc   unsafeModifyQuery (PreparedQuery sql types bind bc) f = PreparedQuery (f sql) types bind bc@@ -89,16 +91,16 @@ type PGPreparedQuery = QueryParser PreparedQuery  -- |Make a simple query directly from a query string, with no type inference-rawPGSimpleQuery :: String -> PGSimpleQuery PGValues+rawPGSimpleQuery :: BS.ByteString -> PGSimpleQuery PGValues rawPGSimpleQuery = rawParser . SimpleQuery  instance IsString (PGSimpleQuery PGValues) where-  fromString = rawPGSimpleQuery+  fromString = rawPGSimpleQuery . fromString instance IsString (PGSimpleQuery ()) where-  fromString = fmap (const ()) . rawPGSimpleQuery+  fromString = void . rawPGSimpleQuery . fromString  -- |Make a prepared query directly from a query string and bind parameters, with no type inference-rawPGPreparedQuery :: String -> PGValues -> PGPreparedQuery PGValues+rawPGPreparedQuery :: BS.ByteString -> PGValues -> PGPreparedQuery PGValues rawPGPreparedQuery sql bind = rawParser $ PreparedQuery sql [] bind []  -- |Run a prepared query in lazy mode, where only chunk size rows are requested at a time.@@ -115,28 +117,27 @@ -- This does not understand strings or other SQL syntax, so any literal occurrence of the string @${@ must be escaped as @$${@. -- Embedded expressions may not contain @{@ or @}@. sqlPlaceholders :: String -> (String, [String])-sqlPlaceholders = sph (1 :: Int) where-  sph n ('$':'$':'{':s) = first (('$':) . ('{':)) $ sph n s-  sph n ('$':'{':s)-    | (e, '}':r) <- break (\c -> c == '{' || c == '}') s =-      (('$':show n) ++) *** (e :) $ sph (succ n) r-    | otherwise = error $ "Error parsing SQL statement: could not find end of expression: ${" ++ s-  sph n (c:s) = first (c:) $ sph n s-  sph _ "" = ("", [])+sqlPlaceholders = ssl 1 . sqlSplitExprs where+  ssl :: Int -> SQLSplit String True -> (String, [String])+  ssl n (SQLLiteral s l) = first (s ++) $ ssp n l+  ssl _ SQLSplitEnd = ("", [])+  ssp :: Int -> SQLSplit String False -> (String, [String])+  ssp n (SQLPlaceholder e l) = (('$':show n) ++) *** (e :) $ ssl (succ n) l+  ssp _ SQLSplitEnd = ("", []) --- |Given a SQL statement with placeholders of the form @$N@ and a list of TH 'String' expressions, return a new 'String' expression that substitutes the expressions for the placeholders.+-- |Given a SQL statement with placeholders of the form @$N@ and a list of TH 'ByteString' expressions, return a new 'ByteString' expression that substitutes the expressions for the placeholders. -- This does not understand strings or other SQL syntax, so any literal occurrence of a string like @$N@ must be escaped as @$$N@. sqlSubstitute :: String -> [TH.Exp] -> TH.Exp-sqlSubstitute sql exprl = ss sql where+sqlSubstitute sql exprl = TH.AppE (TH.VarE 'BS.concat) $ TH.ListE $ ssl $ sqlSplitParams sql where   bnds = (1, length exprl)   exprs = listArray bnds exprl   expr n     | inRange bnds n = exprs ! n     | otherwise = error $ "SQL placeholder '$" ++ show n ++ "' out of range (not recognized by PostgreSQL); literal occurrences may need to be escaped with '$$'"-  ss ('$':'$':d:r) | isDigit d = ['$',d] ++$ ss r-  ss ('$':s@(d:_)) | isDigit d, [(n, r)] <- readDec s = expr n $++$ ss r-  ss (c:r) = [c] ++$ ss r-  ss "" = stringE ""+  ssl (SQLLiteral s l) = TH.VarE 'fromString `TH.AppE` stringE s : ssp l+  ssl SQLSplitEnd = []+  ssp (SQLPlaceholder n l) = expr n : ssl l+  ssp SQLSplitEnd = []  splitCommas :: String -> [String] splitCommas = spl where@@ -163,30 +164,30 @@ makePGQuery :: QueryFlags -> String -> TH.ExpQ makePGQuery QueryFlags{ flagQuery = False } sqle = pgSubstituteLiterals sqle makePGQuery QueryFlags{ flagNullable = nulls, flagPrepare = prep } sqle = do-  (pt, rt) <- TH.runIO $ tpgDescribe sqlp (fromMaybe [] prep) (isNothing nulls)+  (pt, rt) <- TH.runIO $ tpgDescribe (fromString sqlp) (fromMaybe [] prep) (isNothing nulls)   when (length pt < length exprs) $ fail "Not all expression placeholders were recognized by PostgreSQL; literal occurrences of '${' may need to be escaped with '$${'"    e <- TH.newName "_tenv"   (vars, vals) <- mapAndUnzipM (\t -> do-    v <- TH.newName $ 'p':tpgValueName t+    v <- TH.newName $ 'p':BSC.unpack (tpgValueName t)     return        ( TH.VarP v       , tpgTypeEncoder (isNothing prep) t e `TH.AppE` TH.VarE v       )) pt   (pats, conv, bins) <- unzip3 <$> mapM (\t -> do-    v <- TH.newName $ 'c':tpgValueName t+    v <- TH.newName $ 'c':BSC.unpack (tpgValueName t)     return        ( TH.VarP v       , tpgTypeDecoder (Fold.and nulls) t e `TH.AppE` TH.VarE v       , tpgTypeBinary t e       )) rt   foldl TH.AppE (TH.LamE vars $ TH.ConE 'QueryParser-    `TH.AppE` TH.LamE [TH.VarP e] (if isNothing prep-      then TH.ConE 'SimpleQuery-        `TH.AppE` sqlSubstitute sqlp vals-      else TH.ConE 'PreparedQuery-        `TH.AppE` stringE sqlp -        `TH.AppE` TH.ListE (map (TH.LitE . TH.IntegerL . toInteger . tpgValueTypeOID) pt) +    `TH.AppE` TH.LamE [TH.VarP e] (maybe+      (TH.ConE 'SimpleQuery+        `TH.AppE` sqlSubstitute sqlp vals)+      (\p -> TH.ConE 'PreparedQuery+        `TH.AppE` (TH.VarE 'fromString `TH.AppE` stringE sqlp)+        `TH.AppE` TH.ListE (map (TH.LitE . TH.IntegerL . toInteger . tpgValueTypeOID . snd) $ zip p pt)         `TH.AppE` TH.ListE vals          `TH.AppE` TH.ListE  #ifdef USE_BINARY@@ -195,6 +196,7 @@           [] #endif       )+      prep)     `TH.AppE` TH.LamE [TH.VarP e, TH.ListP pats] (TH.TupE conv))     <$> mapM parse exprs   where@@ -222,7 +224,7 @@ qqTop True ('!':sql) = qqTop False sql qqTop err sql = do   r <- TH.runIO $ try $ withTPGConnection $ \c ->-    pgSimpleQuery c sql+    pgSimpleQuery c (fromString sql)   either ((if err then TH.reportError else TH.reportWarning) . (show :: PGError -> String)) (const $ return ()) r   return [] 

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, FunctionalDependencies, DataKinds, GeneralizedNewtypeDeriving, PatternGuards #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, FunctionalDependencies, DataKinds, GeneralizedNewtypeDeriving, PatternGuards, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module: Database.PostgreSQL.Typed.Range@@ -12,10 +12,10 @@  import Control.Applicative ((<$>), (<$)) import Control.Monad (guard)+import qualified Data.Attoparsec.ByteString.Char8 as P import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Char8 as BSC import Data.Monoid (Monoid(..), (<>))-import qualified Text.Parsec as P  import Database.PostgreSQL.Typed.Types @@ -228,11 +228,11 @@     pb (Just b) = pgDQuote "(),[]" $ pgEncode (pgRangeElementType tr) b     pc c o b = BSB.char7 $ if boundClosed b then c else o instance (PGRangeType tr t, PGColumn t a) => PGColumn tr (Range a) where-  pgDecode tr a = either (error . ("pgDecode range: " ++) . show) id $ P.parse per (BSC.unpack a) a where-    per = Empty <$ pe P.<|> pr-    pe = P.oneOf "Ee" >> P.oneOf "Mm" >> P.oneOf "Pp" >> P.oneOf "Tt" >> P.oneOf "Yy"-    pb = fmap (pgDecode (pgRangeElementType tr) . BSC.pack) <$> parsePGDQuote "(),[]" null-    pc c o = True <$ P.char c P.<|> False <$ P.char o+  pgDecode tr a = either (error . ("pgDecode range (" ++) . (++ ("): " ++ BSC.unpack a))) id $ P.parseOnly per a where+    per = (Empty <$ pe) <> pr+    pe = P.stringCI "empty"+    pb = fmap (pgDecode (pgRangeElementType tr)) <$> parsePGDQuote True "(),[]" BSC.null+    pc c o = (True <$ P.char c) <> (False <$ P.char o)     mb = maybe Unbounded . Bounded     pr = do       lc <- pc '[' '('

@@ -22,6 +22,10 @@ import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar, modifyMVar_) import Control.Exception (onException, finally) import Control.Monad (liftM2)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC+import qualified Data.ByteString.UTF8 as BSU import qualified Data.Foldable as Fold import qualified Data.IntMap.Lazy as IntMap import Data.List (find)@@ -53,9 +57,9 @@   return $ defaultPGDatabase     { pgDBHost = host     , pgDBPort = port-    , pgDBName = db-    , pgDBUser = user-    , pgDBPass = pass+    , pgDBName = BSU.fromString db+    , pgDBUser = BSU.fromString user+    , pgDBPass = BSU.fromString pass     , pgDBDebug = debug     } @@ -73,7 +77,7 @@ tpgLoadTypes :: TPGState -> IO TPGState tpgLoadTypes tpg = do   -- defer loading types until they're needed-  tl <- unsafeInterleaveIO $ pgSimpleQuery (tpgConnection tpg) "SELECT typ.oid, format_type(CASE WHEN typtype = 'd' THEN typbasetype ELSE typ.oid END, -1) FROM pg_catalog.pg_type typ JOIN pg_catalog.pg_namespace nsp ON typnamespace = nsp.oid WHERE nspname <> 'pg_toast' AND nspname <> 'information_schema' ORDER BY typ.oid"+  tl <- unsafeInterleaveIO $ pgSimpleQuery (tpgConnection tpg) $ BSLC.pack "SELECT typ.oid, format_type(CASE WHEN typtype = 'd' THEN typbasetype ELSE typ.oid END, -1) FROM pg_catalog.pg_type typ JOIN pg_catalog.pg_namespace nsp ON typnamespace = nsp.oid WHERE nspname <> 'pg_toast' AND nspname <> 'information_schema' ORDER BY typ.oid"   return $ tpg{ tpgTypes = IntMap.fromAscList $ map (\[to, tn] ->     (fromIntegral (pgDecodeRep to :: OID), pgDecodeRep tn)) $ snd tl   }@@ -129,20 +133,20 @@     $ find ((==) t . snd) $ IntMap.toList types  data TPGValueInfo = TPGValueInfo-  { tpgValueName :: String+  { tpgValueName :: BS.ByteString   , tpgValueTypeOID :: !OID   , tpgValueType :: TPGType   , tpgValueNullable :: Bool   }  -- |A type-aware wrapper to 'pgDescribe'-tpgDescribe :: String -> [String] -> Bool -> IO ([TPGValueInfo], [TPGValueInfo])+tpgDescribe :: BS.ByteString -> [String] -> Bool -> IO ([TPGValueInfo], [TPGValueInfo]) tpgDescribe sql types nulls = withTPGState $ \tpg -> do   at <- mapM (getTPGTypeOID tpg) types-  (pt, rt) <- pgDescribe (tpgConnection tpg) sql at nulls+  (pt, rt) <- pgDescribe (tpgConnection tpg) (BSL.fromStrict sql) at nulls   return     ( map (\o -> TPGValueInfo-      { tpgValueName = ""+      { tpgValueName = BS.empty       , tpgValueTypeOID = o       , tpgValueType = tpgType tpg o       , tpgValueNullable = True

@@ -24,6 +24,9 @@  import Control.Exception (onException, catchJust) import Control.Monad (liftM, void, guard)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy.Char8 as BSLC import Data.Maybe (listToMaybe, isJust) import qualified Language.Haskell.TH as TH import Network (HostName, PortID(..))@@ -74,28 +77,28 @@ -- 'MonadPeelIO' version. withTransaction :: PG.PGConnection -> IO a -> IO a withTransaction h a =-  onException (do void $ PG.pgSimpleQuery h "BEGIN"+  onException (do void $ PG.pgSimpleQuery h $ BSLC.pack "BEGIN"                   c <- a-                  void $ PG.pgSimpleQuery h "COMMIT"+                  void $ PG.pgSimpleQuery h $ BSLC.pack "COMMIT"                   return c)-              (void $ PG.pgSimpleQuery h "ROLLBACK")+              (void $ PG.pgSimpleQuery h $ BSLC.pack "ROLLBACK")  -- |Roll back a transaction. rollback :: PG.PGConnection -> IO ()-rollback h = void $ PG.pgSimpleQuery h "ROLLBACK"+rollback h = void $ PG.pgSimpleQuery h $ BSLC.pack "ROLLBACK"  -- |Ignore duplicate key errors. This is also limited to the 'IO' Monad. insertIgnore :: IO () -> IO () insertIgnore q = catchJust uniquenessError q (\ _ -> return ()) where-  uniquenessError e = guard (PG.pgErrorCode e == "23505")+  uniquenessError e = guard (PG.pgErrorCode e == BSC.pack "23505")  type PGException = PG.PGError -pgConnect :: HostName  -- ^ the host to connect to-          -> PortID    -- ^ the port to connect on-          -> String    -- ^ the database to connect to-          -> String    -- ^ the username to connect as-          -> String    -- ^ the password to connect with+pgConnect :: HostName   -- ^ the host to connect to+          -> PortID     -- ^ the port to connect on+          -> ByteString -- ^ the database to connect to+          -> ByteString -- ^ the username to connect as+          -> ByteString -- ^ the password to connect with           -> IO PG.PGConnection -- ^ a handle to communicate with the PostgreSQL server on pgConnect h n d u p = do   debug <- isJust `liftM` lookupEnv "TPG_DEBUG"

@@ -34,12 +34,12 @@   , buildPGValue   ) where -import Control.Applicative ((<$>), (<$))-import Control.Monad (mzero)+import Control.Applicative ((<$>), (<$), (<*), (*>)) #ifdef USE_AESON import qualified Data.Aeson as JSON-import qualified Data.Attoparsec.ByteString as JSONP #endif+import qualified Data.Attoparsec.ByteString as P (anyWord8)+import qualified Data.Attoparsec.ByteString.Char8 as P import Data.Bits (shiftL, (.|.)) import Data.ByteString.Internal (w2c) import qualified Data.ByteString as BS@@ -51,7 +51,7 @@ import qualified Data.ByteString.UTF8 as BSU import Data.Char (isSpace, isDigit, digitToInt, intToDigit, toLower) import Data.Int-import Data.List (intersperse, intercalate)+import Data.List (intersperse) import Data.Maybe (fromMaybe) import Data.Monoid ((<>), mconcat, mempty) import Data.Ratio ((%), numerator, denominator)@@ -65,6 +65,11 @@ import qualified Data.Text.Lazy.Encoding as TLE #endif import qualified Data.Time as Time+#if MIN_VERSION_time(1,5,0)+import Data.Time (defaultTimeLocale)+#else+import System.Locale (defaultTimeLocale)+#endif #ifdef USE_UUID import qualified Data.UUID as UUID #endif@@ -76,9 +81,6 @@ import qualified PostgreSQLBinary.Decoder as BinD import qualified PostgreSQLBinary.Encoder as BinE #endif-import System.Locale (defaultTimeLocale)-import qualified Text.Parsec as P-import Text.Parsec.Token (naturalOrFloat, makeTokenParser, GenLanguageDef(..))  type PGTextValue = BS.ByteString type PGBinaryValue = BS.ByteString@@ -96,7 +98,7 @@ -- Nothing values represent unknown. data PGTypeEnv = PGTypeEnv   { pgIntegerDatetimes :: Maybe Bool -- ^ If @integer_datetimes@ is @on@; only relevant for binary encoding.-  }+  } deriving (Show)  unknownPGTypeEnv :: PGTypeEnv unknownPGTypeEnv = PGTypeEnv@@ -123,8 +125,8 @@   pgEncode :: PGTypeName t -> a -> PGTextValue   -- |Encode a value to a (quoted) literal value for use in SQL statements.   -- Defaults to a quoted version of 'pgEncode'-  pgLiteral :: PGTypeName t -> a -> String-  pgLiteral t = pgQuote . BSU.toString . pgEncode t+  pgLiteral :: PGTypeName t -> a -> BS.ByteString+  pgLiteral t = pgQuote . pgEncode t   -- |Encode a value to a PostgreSQL representation.   -- Defaults to the text representation by pgEncode   pgEncodeValue :: PGTypeEnv -> PGTypeName t -> a -> PGValue@@ -145,7 +147,7 @@  instance PGParameter t a => PGParameter t (Maybe a) where   pgEncode t = maybe (error $ "pgEncode " ++ pgTypeName t ++ ": Nothing") (pgEncode t)-  pgLiteral = maybe "NULL" . pgLiteral+  pgLiteral = maybe (BSC.pack "NULL") . pgLiteral   pgEncodeValue e = maybe PGNullValue . pgEncodeValue e  instance PGColumn t a => PGColumn t (Maybe a) where@@ -160,7 +162,7 @@ pgEncodeParameter = pgEncodeValue  -- |Final parameter escaping function used when a (nullable) parameter is passed to be substituted into a simple query.-pgEscapeParameter :: PGParameter t a => PGTypeEnv -> PGTypeName t -> a -> String+pgEscapeParameter :: PGParameter t a => PGTypeEnv -> PGTypeName t -> a -> BS.ByteString pgEscapeParameter _ = pgLiteral  -- |Final column decoding function used for a nullable result value.@@ -172,22 +174,19 @@ pgDecodeColumnNotNull = pgDecodeValue  -pgQuoteUnsafe :: String -> String-pgQuoteUnsafe s = '\'' : s ++ "'"+pgQuoteUnsafe :: BS.ByteString -> BS.ByteString+pgQuoteUnsafe = (`BSC.snoc` '\'') . BSC.cons '\''  -- |Produce a SQL string literal by wrapping (and escaping) a string with single quotes.-pgQuote :: String -> String-pgQuote = ('\'':) . es where-  es "" = "'"-  es (c@'\'':r) = c:c:es r-  es (c:r) = c:es r+pgQuote :: BS.ByteString -> BS.ByteString+pgQuote = pgQuoteUnsafe . BSC.intercalate (BSC.pack "''") . BSC.split '\''  buildPGValue :: BSB.Builder -> BS.ByteString buildPGValue = BSL.toStrict . BSB.toLazyByteString  -- |Double-quote a value if it's \"\", \"null\", or contains any whitespace, \'\"\', \'\\\', or the characters given in the first argument. -- Checking all these things may not be worth it.  We could just double-quote everything.-pgDQuote :: String -> BS.ByteString -> BSB.Builder+pgDQuote :: [Char] -> BS.ByteString -> BSB.Builder pgDQuote unsafe s   | BS.null s || BSC.any (\c -> isSpace c || c == '"' || c == '\\' || c `elem` unsafe) s || BSC.map toLower s == BSC.pack "null" =     dq <> BSBP.primMapByteStringBounded ec s <> dq@@ -197,11 +196,18 @@   bs = BSBP.liftFixedToBounded $ ((,) '\\') BSBP.>$< (BSBP.char7 BSBP.>*< BSBP.word8)  -- |Parse double-quoted values ala 'pgDQuote'.-parsePGDQuote :: P.Stream s m Char => String -> (String -> Bool) -> P.ParsecT s u m (Maybe String)-parsePGDQuote unsafe isnul = (Just <$> q P.<|> mnul <$> uq) where-  q = P.between (P.char '"') (P.char '"') $-    P.many $ (P.char '\\' >> P.anyChar) P.<|> P.noneOf "\\\""-  uq = P.many (P.noneOf ('"':'\\':unsafe))+parsePGDQuote :: Bool -> [Char] -> (BS.ByteString -> Bool) -> P.Parser (Maybe BS.ByteString)+parsePGDQuote blank unsafe isnul = (Just <$> q) <> (mnul <$> uq) where+  q = P.char '"' *> (BS.concat <$> qs)+  qs = do+    p <- P.takeTill (\c -> c == '"' || c == '\\')+    e <- P.anyChar+    if e == '"'+      then return [p]+      else do+        c <- P.anyWord8+        (p :) . (BS.singleton c :) <$> qs+  uq = (if blank then P.takeWhile else P.takeWhile1) (`notElem` ('"':'\\':unsafe))   mnul s     | isnul s = Nothing     | otherwise = Just s@@ -229,8 +235,8 @@ instance PGParameter "boolean" Bool where   pgEncode _ False = BSC.singleton 'f'   pgEncode _ True = BSC.singleton 't'-  pgLiteral _ False = "false"-  pgLiteral _ True = "true"+  pgLiteral _ False = BSC.pack "false"+  pgLiteral _ True = BSC.pack "true"   BIN_ENC(BinE.bool) instance PGColumn "boolean" Bool where   pgDecode _ s = case BSC.head s of@@ -243,7 +249,7 @@ instance PGType "oid" where BIN_COL instance PGParameter "oid" OID where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.int4 . Right) instance PGColumn "oid" OID where   pgDecode _ = read . BSC.unpack@@ -252,7 +258,7 @@ instance PGType "smallint" where BIN_COL instance PGParameter "smallint" Int16 where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.int2. Left) instance PGColumn "smallint" Int16 where   pgDecode _ = read . BSC.unpack@@ -261,7 +267,7 @@ instance PGType "integer" where BIN_COL instance PGParameter "integer" Int32 where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.int4 . Left) instance PGColumn "integer" Int32 where   pgDecode _ = read . BSC.unpack@@ -270,7 +276,7 @@ instance PGType "bigint" where BIN_COL instance PGParameter "bigint" Int64 where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.int8 . Left) instance PGColumn "bigint" Int64 where   pgDecode _ = read . BSC.unpack@@ -279,7 +285,7 @@ instance PGType "real" where BIN_COL instance PGParameter "real" Float where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.float4) instance PGColumn "real" Float where   pgDecode _ = read . BSC.unpack@@ -288,7 +294,7 @@ instance PGType "double precision" where BIN_COL instance PGParameter "double precision" Double where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.float8) instance PGColumn "double precision" Double where   pgDecode _ = read . BSC.unpack@@ -369,14 +375,14 @@ instance PGType "bytea" where BIN_COL instance PGParameter "bytea" BSL.ByteString where   pgEncode _ = encodeBytea . BSB.lazyByteStringHex-  pgLiteral t = pgQuoteUnsafe . BSC.unpack . pgEncode t+  pgLiteral t = pgQuoteUnsafe . pgEncode t   BIN_ENC(BinE.bytea . Right) instance PGColumn "bytea" BSL.ByteString where   pgDecode _ = BSL.pack . decodeBytea   BIN_DEC((BSL.fromStrict .) . binDec BinD.bytea) instance PGParameter "bytea" BS.ByteString where   pgEncode _ = encodeBytea . BSB.byteStringHex-  pgLiteral t = pgQuoteUnsafe . BSC.unpack . pgEncode t+  pgLiteral t = pgQuoteUnsafe . pgEncode t   BIN_ENC(BinE.bytea . Left) instance PGColumn "bytea" BS.ByteString where   pgDecode _ = BS.pack . decodeBytea@@ -385,7 +391,7 @@ instance PGType "date" where BIN_COL instance PGParameter "date" Time.Day where   pgEncode _ = BSC.pack . Time.showGregorian-  pgLiteral _ = pgQuoteUnsafe . Time.showGregorian+  pgLiteral t = pgQuoteUnsafe . pgEncode t   BIN_ENC(BinE.date) instance PGColumn "date" Time.Day where   pgDecode _ = Time.readTime defaultTimeLocale "%F" . BSC.unpack@@ -409,7 +415,7 @@   pgBinaryColumn = binColDatetime instance PGParameter "time without time zone" Time.TimeOfDay where   pgEncode _ = BSC.pack . Time.formatTime defaultTimeLocale "%T%Q"-  pgLiteral _ = pgQuoteUnsafe . Time.formatTime defaultTimeLocale "%T%Q"+  pgLiteral t = pgQuoteUnsafe . pgEncode t #ifdef USE_BINARY   pgEncodeValue = binEncDatetime BinE.time #endif@@ -423,7 +429,7 @@   pgBinaryColumn = binColDatetime instance PGParameter "timestamp without time zone" Time.LocalTime where   pgEncode _ = BSC.pack . Time.formatTime defaultTimeLocale "%F %T%Q"-  pgLiteral _ = pgQuoteUnsafe . Time.formatTime defaultTimeLocale "%F %T%Q"+  pgLiteral t = pgQuoteUnsafe . pgEncode t #ifdef USE_BINARY   pgEncodeValue = binEncDatetime BinE.timestamp #endif@@ -447,7 +453,7 @@   pgBinaryColumn = binColDatetime instance PGParameter "timestamp with time zone" Time.UTCTime where   pgEncode _ = BSC.pack . fixTZ . Time.formatTime defaultTimeLocale "%F %T%Q%z"-  pgLiteral _ = pgQuote{-Unsafe-} . fixTZ . Time.formatTime defaultTimeLocale "%F %T%Q%z"+  -- pgLiteral t = pgQuoteUnsafe . pgEncode t #ifdef USE_BINARY   pgEncodeValue = binEncDatetime BinE.timestamptz #endif@@ -461,7 +467,7 @@   pgBinaryColumn = binColDatetime instance PGParameter "interval" Time.DiffTime where   pgEncode _ = BSC.pack . show-  pgLiteral _ = pgQuoteUnsafe . show+  pgLiteral t = pgQuoteUnsafe . pgEncode t #ifdef USE_BINARY   pgEncodeValue = binEncDatetime BinE.interval #endif@@ -469,36 +475,22 @@ -- PostgreSQL stores months and days separately in intervals, but DiffTime does not. -- We collapse all interval fields into seconds instance PGColumn "interval" Time.DiffTime where-  pgDecode _ a = either (error . ("pgDecode interval: " ++) . show) id $ P.parse ps (BSC.unpack a) a where+  pgDecode _ a = either (error . ("pgDecode interval (" ++) . (++ ("): " ++ BSC.unpack a))) realToFrac $ P.parseOnly ps a where     ps = do       _ <- P.char 'P'       d <- units [('Y', 12*month), ('M', month), ('W', 7*day), ('D', day)]-      (d +) <$> pt P.<|> d <$ P.eof+      ((d +) <$> pt) <> (d <$ P.endOfInput)     pt = do       _ <- P.char 'T'       t <- units [('H', 3600), ('M', 60), ('S', 1)]-      _ <- P.eof+      P.endOfInput       return t-    units l = fmap sum $ P.many $ do-      s <- negate <$ P.char '-' P.<|> id <$ P.char '+' P.<|> return id-      x <- num-      u <- P.choice $ map (\(c, u) -> s u <$ P.char c) l-      return $ either (Time.secondsToDiffTime . (* u)) (realToFrac . (* fromInteger u)) x+    units l = fmap sum $ P.many' $ do+      x <- P.signed P.scientific+      u <- P.choice $ map (\(c, u) -> u <$ P.char c) l+      return $ x * u     day = 86400     month = 2629746-    num = naturalOrFloat $ makeTokenParser $ LanguageDef-      { commentStart   = ""-      , commentEnd     = ""-      , commentLine    = ""-      , nestedComments = False-      , identStart     = mzero-      , identLetter    = mzero-      , opStart        = mzero-      , opLetter       = mzero-      , reservedOpNames= []-      , reservedNames  = []-      , caseSensitive  = True-      } #ifdef USE_BINARY   pgDecodeBinary = binDecDatetime BinD.interval #endif@@ -510,8 +502,8 @@     | otherwise = BSC.pack $ take 30 (showRational (r / (10 ^^ e))) ++ 'e' : show e where     e = floor $ logBase (10 :: Double) $ fromRational $ abs r :: Int -- not great, and arbitrarily truncate somewhere   pgLiteral _ r-    | denominator r == 0 = "'NaN'" -- this can't happen-    | otherwise = '(' : show (numerator r) ++ '/' : show (denominator r) ++ "::numeric)"+    | denominator r == 0 = BSC.pack "'NaN'" -- this can't happen+    | otherwise = BSC.pack $ '(' : show (numerator r) ++ '/' : show (denominator r) ++ "::numeric)"   BIN_ENC(BinE.numeric . realToFrac) -- |High-precision representation of Rational as numeric. -- Unfortunately, numeric has an NaN, while Rational does not.@@ -535,7 +527,7 @@ #ifdef USE_SCIENTIFIC instance PGParameter "numeric" Scientific where   pgEncode _ = BSC.pack . show-  pgLiteral _ = show+  pgLiteral = pgEncode   BIN_ENC(BinE.numeric) instance PGColumn "numeric" Scientific where   pgDecode _ = read . BSC.unpack@@ -546,7 +538,7 @@ instance PGType "uuid" where BIN_COL instance PGParameter "uuid" UUID.UUID where   pgEncode _ = UUID.toASCIIBytes-  pgLiteral _ = pgQuoteUnsafe . UUID.toString+  pgLiteral t = pgQuoteUnsafe . pgEncode t   BIN_ENC(BinE.uuid) instance PGColumn "uuid" UUID.UUID where   pgDecode _ u = fromMaybe (error $ "pgDecode uuid: " ++ BSC.unpack u) $ UUID.fromASCIIBytes u@@ -558,17 +550,13 @@ class PGType t => PGRecordType t instance PGRecordType t => PGParameter t PGRecord where   pgEncode _ (PGRecord l) =-    buildPGValue $ BSB.char7 '(' <> mconcat (intersperse (BSB.char7 ',') $ map (maybe mempty (pgDQuote "(),")) l) <> BSB.char7 ')' where+    buildPGValue $ BSB.char7 '(' <> mconcat (intersperse (BSB.char7 ',') $ map (maybe mempty (pgDQuote "(),")) l) <> BSB.char7 ')'   pgLiteral _ (PGRecord l) =-    "ROW(" ++ intercalate "," (map (maybe "NULL" (pgQuote . BSU.toString)) l) ++ ")" where+    BSC.pack "ROW(" <> BS.intercalate (BSC.singleton ',') (map (maybe (BSC.pack "NULL") pgQuote) l) `BSC.snoc` ')' instance PGRecordType t => PGColumn t PGRecord where-  pgDecode _ a = either (error . ("pgDecode record: " ++) . show) PGRecord $ P.parse pa (BSC.unpack a) a where-    pa = do-      l <- P.between (P.char '(') (P.char ')') $-        P.sepBy el (P.char ',')-      _ <- P.eof-      return l-    el = fmap BSC.pack <$> parsePGDQuote "()," null+  pgDecode _ a = either (error . ("pgDecode record (" ++) . (++ ("): " ++ BSC.unpack a))) PGRecord $ P.parseOnly pa a where+    pa = P.char '(' *> P.sepBy el (P.char ',') <* P.char ')' <* P.endOfInput+    el = parsePGDQuote True "()," BS.null  instance PGType "record" -- |The generic anonymous record type, as created by @ROW@.@@ -580,13 +568,13 @@ instance PGParameter "json" JSON.Value where   pgEncode _ = BSL.toStrict . JSON.encode instance PGColumn "json" JSON.Value where-  pgDecode _ j = either (error . ("pgDecode json: " ++)) id $ JSONP.parseOnly JSON.json j+  pgDecode _ j = either (error . ("pgDecode json (" ++) . (++ ("): " ++ BSC.unpack j))) id $ P.parseOnly JSON.json j  instance PGType "jsonb" instance PGParameter "jsonb" JSON.Value where   pgEncode _ = BSL.toStrict . JSON.encode instance PGColumn "jsonb" JSON.Value where-  pgDecode _ j = either (error . ("pgDecode json: " ++)) id $ JSONP.parseOnly JSON.json j+  pgDecode _ j = either (error . ("pgDecode jsonb (" ++) . (++ ("): " ++ BSC.unpack j))) id $ P.parseOnly JSON.json j #endif  {-

@@ -1,5 +1,5 @@ Name:          postgresql-typed-Version:       0.3.3+Version:       0.4.0 Cabal-Version: >= 1.8 License:       BSD3 License-File:  COPYING@@ -52,14 +52,14 @@     base >= 4.7 && < 5,     array,     binary,-    containers < 0.5.6,+    containers,     old-locale,-    time < 1.5,+    time,     bytestring >= 0.10.2,     template-haskell,     haskell-src-meta,     network,-    parsec,+    attoparsec >= 0.12 && < 0.14,     utf8-string   Exposed-Modules:     Database.PostgreSQL.Typed@@ -93,11 +93,11 @@       Build-Depends: scientific >= 0.3       CPP-options: -DUSE_SCIENTIFIC   if flag(aeson)-    Build-Depends: aeson >= 0.7, attoparsec >= 0.10+    Build-Depends: aeson >= 0.7     CPP-options: -DUSE_AESON  test-suite test-  build-depends: base, network, time, postgresql-typed+  build-depends: base, network, time, bytestring, postgresql-typed   type: exitcode-stdio-1.0   main-is: Main.hs   buildable: True

@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DataKinds, DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DataKinds, DeriveDataTypeable #-} -- {-# OPTIONS_GHC -ddump-splices #-} module Main (main) where +import Data.ByteString (ByteString) import Data.Int (Int32) import qualified Data.Time as Time import System.Exit (exitSuccess, exitFailure)@@ -44,8 +45,8 @@       t = Time.zonedTimeToLocalTime z       d = Time.localDay t       p = -34881559 :: Time.DiffTime-      s = "\"hel\\o'"-      l = [Just "a\\\"b,c", Nothing, Just "null", Just "nullish"]+      s = "\"hel\\o'" :: String+      l = [Just "a\\\"b,c", Nothing, Just "null", Just "nullish" :: Maybe ByteString]       r = Range.normal (Just (-2 :: Int32)) Nothing       e = MyEnum_XX_ye   [(Just b', Just i', Just f', Just s', Just d', Just t', Just z', Just p', Just l', Just r', Just e')] <- pgQuery c