packages feed

hasql 0.19.14 → 0.19.15

raw patch · 36 files changed

+941/−941 lines, 36 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

hasql.cabal view
@@ -1,7 +1,7 @@ name:   hasql version:-  0.19.14+  0.19.15 category:   Hasql, Database, PostgreSQL synopsis:@@ -46,24 +46,24 @@   default-language:     Haskell2010   other-modules:-    Hasql.Prelude-    Hasql.PTI+    Hasql.Private.Prelude+    Hasql.Private.PTI     Hasql.Private.IO     Hasql.Private.Query     Hasql.Private.Session     Hasql.Private.Connection     Hasql.Private.PreparedStatementRegistry-    Hasql.Settings-    Hasql.Commands-    Hasql.Decoders.Array-    Hasql.Decoders.Composite-    Hasql.Decoders.Value-    Hasql.Decoders.Row-    Hasql.Decoders.Result-    Hasql.Decoders.Results-    Hasql.Encoders.Array-    Hasql.Encoders.Value-    Hasql.Encoders.Params+    Hasql.Private.Settings+    Hasql.Private.Commands+    Hasql.Private.Decoders.Array+    Hasql.Private.Decoders.Composite+    Hasql.Private.Decoders.Value+    Hasql.Private.Decoders.Row+    Hasql.Private.Decoders.Result+    Hasql.Private.Decoders.Results+    Hasql.Private.Encoders.Array+    Hasql.Private.Encoders.Value+    Hasql.Private.Encoders.Params   exposed-modules:     Hasql.Decoders     Hasql.Encoders@@ -80,7 +80,7 @@     bytestring-tree-builder >= 0.2.5 && < 0.3,     -- data:     dlist >= 0.7 && < 0.9,-    aeson >= 0.7 && < 0.12,+    aeson >= 0.7 && < 2,     uuid == 1.3.*,     vector >= 0.10 && < 0.12,     time >= 1.4 && < 2,
− library/Hasql/Commands.hs 
@@ -1,33 +0,0 @@-module Hasql.Commands-(-  Commands,-  asBytes,-  setEncodersToUTF8,-  setMinClientMessagesToWarning,-)-where--import Hasql.Prelude-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy.Builder as BB-import qualified Data.ByteString.Lazy.Builder.ASCII as BB-import qualified Data.ByteString.Lazy as BL---newtype Commands =-  Commands (DList BB.Builder)-  deriving (Monoid)--instance Semigroup Commands--asBytes :: Commands -> ByteString-asBytes (Commands list) =-  BL.toStrict $ BB.toLazyByteString $ foldMap (<> BB.char7 ';') $ list--setEncodersToUTF8 :: Commands-setEncodersToUTF8 =-  Commands (pure "SET client_encoding = 'UTF8'")--setMinClientMessagesToWarning :: Commands-setMinClientMessagesToWarning =-  Commands (pure "SET client_min_messages TO WARNING")
library/Hasql/Connection.hs view
@@ -13,4 +13,4 @@ where  import Hasql.Private.Connection-import Hasql.Settings+import Hasql.Private.Settings
library/Hasql/Decoders.hs view
@@ -58,17 +58,17 @@ ) where -import Hasql.Prelude hiding (maybe, bool)+import Hasql.Private.Prelude hiding (maybe, bool) import qualified Data.Aeson as Aeson import qualified Data.Vector as Vector import qualified PostgreSQL.Binary.Decoder as Decoder-import qualified Hasql.Decoders.Results as Results-import qualified Hasql.Decoders.Result as Result-import qualified Hasql.Decoders.Row as Row-import qualified Hasql.Decoders.Value as Value-import qualified Hasql.Decoders.Array as Array-import qualified Hasql.Decoders.Composite as Composite-import qualified Hasql.Prelude as Prelude+import qualified Hasql.Private.Decoders.Results as Results+import qualified Hasql.Private.Decoders.Result as Result+import qualified Hasql.Private.Decoders.Row as Row+import qualified Hasql.Private.Decoders.Value as Value+import qualified Hasql.Private.Decoders.Array as Array+import qualified Hasql.Private.Decoders.Composite as Composite+import qualified Hasql.Private.Prelude as Prelude   -- * Result
− library/Hasql/Decoders/Array.hs 
@@ -1,31 +0,0 @@-module Hasql.Decoders.Array where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Decoder as Decoder---newtype Array a =-  Array (ReaderT Bool Decoder.ArrayDecoder a)-  deriving (Functor)--{-# INLINE run #-}-run :: Array a -> Bool -> Decoder.Decoder a-run (Array imp) env =-  Decoder.array (runReaderT imp env)--{-# INLINE dimension #-}-dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b-dimension replicateM (Array imp) =-  Array $ ReaderT $ \env -> Decoder.arrayDimension replicateM (runReaderT imp env)--{-# INLINE value #-}-value :: (Bool -> Decoder.Decoder a) -> Array (Maybe a)-value decoder' =-  Array $ ReaderT $ Decoder.arrayValue . decoder'--{-# INLINE nonNullValue #-}-nonNullValue :: (Bool -> Decoder.Decoder a) -> Array a-nonNullValue decoder' =-  Array $ ReaderT $ Decoder.arrayNonNullValue . decoder'-
− library/Hasql/Decoders/Composite.hs 
@@ -1,26 +0,0 @@-module Hasql.Decoders.Composite where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Decoder as Decoder---newtype Composite a =-  Composite (ReaderT Bool Decoder.CompositeDecoder a)-  deriving (Functor, Applicative, Monad)--{-# INLINE run #-}-run :: Composite a -> Bool -> Decoder.Decoder a-run (Composite imp) env =-  Decoder.composite (runReaderT imp env)--{-# INLINE value #-}-value :: (Bool -> Decoder.Decoder a) -> Composite (Maybe a)-value decoder' =-  Composite $ ReaderT $ Decoder.compositeValue . decoder'--{-# INLINE nonNullValue #-}-nonNullValue :: (Bool -> Decoder.Decoder a) -> Composite a-nonNullValue decoder' =-  Composite $ ReaderT $ Decoder.compositeNonNullValue . decoder'-
− library/Hasql/Decoders/Result.hs 
@@ -1,232 +0,0 @@-module Hasql.Decoders.Result where--import Hasql.Prelude hiding (maybe, many)-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Hasql.Decoders.Row as Row-import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec-import qualified Data.ByteString as ByteString-import qualified Hasql.Prelude as Prelude-import qualified Data.Vector as Vector-import qualified Data.Vector.Mutable as MutableVector---newtype Result a =-  Result (ReaderT (Bool, LibPQ.Result) (EitherT Error IO) a)-  deriving (Functor, Applicative, Monad)--data Error =-  -- | -  -- An error reported by the DB. Code, message, details, hint.-  -- -  -- * The SQLSTATE code for the error. The SQLSTATE code identifies the type of error that has occurred; -  -- it can be used by front-end applications to perform specific operations (such as error handling) -  -- in response to a particular database error. -  -- For a list of the possible SQLSTATE codes, see Appendix A.-  -- This field is not localizable, and is always present.-  -- -  -- * The primary human-readable error message (typically one line). Always present.-  -- -  -- * Detail: an optional secondary error message carrying more detail about the problem. -  -- Might run to multiple lines.-  -- -  -- * Hint: an optional suggestion what to do about the problem. -  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) -  -- rather than hard facts. Might run to multiple lines.-  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |-  -- |-  -- The database returned an unexpected result.-  -- Indicates an improper statement or a schema mismatch.-  UnexpectedResult !Text |-  -- |-  -- An error of the row reader, preceded by the index of the row.-  RowError !Int !Row.Error |-  -- |-  -- An unexpected amount of rows.-  UnexpectedAmountOfRows !Int-  deriving (Show)--{-# INLINE run #-}-run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a)-run (Result reader) env =-  runEitherT (runReaderT reader env)--{-# INLINE unit #-}-unit :: Result ()-unit =-  checkExecStatus $ \case-    LibPQ.CommandOk -> True-    LibPQ.TuplesOk -> True-    _ -> False--{-# INLINE rowsAffected #-}-rowsAffected :: Result Int64-rowsAffected =-  do-    checkExecStatus $ \case-      LibPQ.CommandOk -> True-      _ -> False-    Result $ ReaderT $ \(_, result) -> EitherT $-      LibPQ.cmdTuples result & fmap cmdTuplesReader-  where-    cmdTuplesReader =-      notNothing >=> notEmpty >=> decimal-      where-        notNothing =-          Prelude.maybe (Left (UnexpectedResult "No bytes")) Right-        notEmpty bytes =-          if ByteString.null bytes-            then Left (UnexpectedResult "Empty bytes")-            else Right bytes-        decimal bytes =-          mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m)) $-          Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes--{-# INLINE checkExecStatus #-}-checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()-checkExecStatus predicate =-  {-# SCC "checkExecStatus" #-} -  do-    status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result-    unless (predicate status) $ do-      case status of-        LibPQ.BadResponse   -> serverError-        LibPQ.NonfatalError -> serverError-        LibPQ.FatalError    -> serverError-        _ -> Result $ lift $ EitherT $ pure $ Left $ UnexpectedResult $ "Unexpected result status: " <> (fromString $ show status)--{-# INLINE serverError #-}-serverError :: Result ()-serverError =-  Result $ ReaderT $ \(_, result) -> EitherT $ do-    code <- -      fmap (fromMaybe ($bug "No code")) $-      LibPQ.resultErrorField result LibPQ.DiagSqlstate-    message <- -      fmap (fromMaybe ($bug "No message")) $-      LibPQ.resultErrorField result LibPQ.DiagMessagePrimary-    detail <- -      LibPQ.resultErrorField result LibPQ.DiagMessageDetail-    hint <- -      LibPQ.resultErrorField result LibPQ.DiagMessageHint-    pure $ Left $ ServerError code message detail hint--{-# INLINE maybe #-}-maybe :: Row.Row a -> Result (Maybe a)-maybe rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do-      maxRows <- LibPQ.ntuples result-      case maxRows of-        0 -> return (Right Nothing)-        1 -> do-          maxCols <- LibPQ.nfields result-          fmap (fmap Just . mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)-        _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE single #-}-single :: Row.Row a -> Result a-single rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do-      maxRows <- LibPQ.ntuples result-      case maxRows of-        1 -> do-          maxCols <- LibPQ.nfields result-          fmap (mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)-        _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE vector #-}-vector :: Row.Row a -> Result (Vector a)-vector rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do-      maxRows <- LibPQ.ntuples result-      maxCols <- LibPQ.nfields result-      mvector <- MutableVector.unsafeNew (rowToInt maxRows)-      failureRef <- newIORef Nothing-      forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-        case rowResult of-          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))-          Right !x -> MutableVector.unsafeWrite mvector rowIndex x-      readIORef failureRef >>= \case-        Nothing -> Right <$> Vector.unsafeFreeze mvector-        Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE foldl #-}-foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a-foldl step init rowDec =-  {-# SCC "foldl" #-} -  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ {-# SCC "traversal" #-} do-      maxRows <- LibPQ.ntuples result-      maxCols <- LibPQ.nfields result-      accRef <- newIORef init-      failureRef <- newIORef Nothing-      forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-        case rowResult of-          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))-          Right !x -> modifyIORef accRef (\acc -> step acc x)-      readIORef failureRef >>= \case-        Nothing -> Right <$> readIORef accRef-        Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE foldr #-}-foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a-foldr step init rowDec =-  {-# SCC "foldr" #-} -  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do-      maxRows <- LibPQ.ntuples result-      maxCols <- LibPQ.nfields result-      accRef <- newIORef init-      failureRef <- newIORef Nothing-      forMToZero_ (rowToInt maxRows) $ \rowIndex -> do-        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-        case rowResult of-          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))-          Right !x -> modifyIORef accRef (\acc -> step x acc)-      readIORef failureRef >>= \case-        Nothing -> Right <$> readIORef accRef-        Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral
− library/Hasql/Decoders/Results.hs 
@@ -1,91 +0,0 @@--- |--- An API for retrieval of multiple results.--- Can be used to handle:--- --- * A single result,--- --- * Individual results of a multi-statement query--- with the help of "Applicative" and "Monad",--- --- * Row-by-row fetching.--- -module Hasql.Decoders.Results where--import Hasql.Prelude hiding (maybe, many)-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Hasql.Prelude as Prelude-import qualified Hasql.Decoders.Result as Result-import qualified Hasql.Decoders.Row as Row---newtype Results a =-  Results (ReaderT (Bool, LibPQ.Connection) (EitherT Error IO) a)-  deriving (Functor, Applicative, Monad)--data Error =-  -- |-  -- An error on the client-side,-  -- with a message generated by the \"libpq\" library.-  -- Usually indicates problems with the connection.-  ClientError !(Maybe ByteString) |-  ResultError !Result.Error-  deriving (Show)--{-# INLINE run #-}-run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a)-run (Results stack) env =-  runEitherT (runReaderT stack env)--{-# INLINE clientError #-}-clientError :: Results a-clientError =-  Results $ ReaderT $ \(_, connection) -> EitherT $-  fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Parse a single result.-{-# INLINE single #-}-single :: Result.Result a -> Results a-single resultDec =-  Results $ ReaderT $ \(integerDatetimes, connection) -> EitherT $ do-    resultMaybe <- LibPQ.getResult connection-    case resultMaybe of-      Just result ->-        mapLeft ResultError <$> Result.run resultDec (integerDatetimes, result) -      Nothing ->-        fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Fetch a single result.-{-# INLINE getResult #-}-getResult :: Results LibPQ.Result-getResult =-  Results $ ReaderT $ \(_, connection) -> EitherT $ do-    resultMaybe <- LibPQ.getResult connection-    case resultMaybe of-      Just result -> pure (Right result)-      Nothing -> fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Fetch a single result.-{-# INLINE getResultMaybe #-}-getResultMaybe :: Results (Maybe LibPQ.Result)-getResultMaybe =-  Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection--{-# INLINE dropRemainders #-}-dropRemainders :: Results ()-dropRemainders =-  {-# SCC "dropRemainders" #-} -  Results $ ReaderT $ \(integerDatetimes, connection) -> loop integerDatetimes connection-  where-    loop integerDatetimes connection =-      getResultMaybe >>= Prelude.maybe (pure ()) onResult-      where-        getResultMaybe =-          lift $ LibPQ.getResult connection-        onResult result =-          checkErrors *> loop integerDatetimes connection-          where-            checkErrors =-              EitherT $ fmap (mapLeft ResultError) $ Result.run Result.unit (integerDatetimes, result)
− library/Hasql/Decoders/Row.hs 
@@ -1,65 +0,0 @@-module Hasql.Decoders.Row where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Decoder as Decoder-import qualified Hasql.Decoders.Value as Value---newtype Row a =-  Row (ReaderT Env (EitherT Error IO) a)-  deriving (Functor, Applicative, Monad)--data Env =-  Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)--data Error =-  EndOfInput |-  UnexpectedNull |-  ValueError !Text-  deriving (Show)----- * Functions----------------------------{-# INLINE run #-}-run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either Error a)-run (Row impl) (result, row, columnsAmount, integerDatetimes) =-  do-    columnRef <- newIORef 0-    runEitherT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef))--{-# INLINE error #-}-error :: Error -> Row a-error x =-  Row (ReaderT (const (EitherT (pure (Left x)))))---- |--- Next value, decoded using the provided value decoder.-{-# INLINE value #-}-value :: Value.Value a -> Row (Maybe a)-value valueDec =-  {-# SCC "value" #-} -  Row $ ReaderT $ \(Env result row columnsAmount integerDatetimes columnRef) -> EitherT $ do-    col <- readIORef columnRef-    writeIORef columnRef (succ col)-    if col < columnsAmount-      then do-        valueMaybe <- {-# SCC "getvalue'" #-} LibPQ.getvalue' result row col-        pure $ -          case valueMaybe of-            Nothing ->-              Right Nothing-            Just value ->-              fmap Just $ mapLeft ValueError $-              {-# SCC "decode" #-} Decoder.run (Value.run valueDec integerDatetimes) value-      else pure (Left EndOfInput)---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nonNullValue #-}-nonNullValue :: Value.Value a -> Row a-nonNullValue valueDec =-  {-# SCC "nonNullValue" #-} -  value valueDec >>= maybe (error UnexpectedNull) pure
− library/Hasql/Decoders/Value.hs 
@@ -1,28 +0,0 @@-module Hasql.Decoders.Value where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Decoder as Decoder---newtype Value a =-  Value (ReaderT Bool Decoder.Decoder a)-  deriving (Functor)---{-# INLINE run #-}-run :: Value a -> Bool -> Decoder.Decoder a-run (Value imp) integerDatetimes =-  runReaderT imp integerDatetimes--{-# INLINE decoder #-}-decoder :: (Bool -> Decoder.Decoder a) -> Value a-decoder =-  {-# SCC "decoder" #-} -  Value . ReaderT--{-# INLINE decoderFn #-}-decoderFn :: (Bool -> ByteString -> Either Text a) -> Value a-decoderFn fn =-  Value $ ReaderT $ \integerDatetimes -> Decoder.fn $ fn integerDatetimes-
library/Hasql/Encoders.hs view
@@ -41,14 +41,14 @@ ) where -import Hasql.Prelude hiding (bool)+import Hasql.Private.Prelude hiding (bool) import qualified PostgreSQL.Binary.Encoder as Encoder import qualified Data.Aeson as Aeson-import qualified Hasql.Encoders.Params as Params-import qualified Hasql.Encoders.Value as Value-import qualified Hasql.Encoders.Array as Array-import qualified Hasql.PTI as PTI-import qualified Hasql.Prelude as Prelude+import qualified Hasql.Private.Encoders.Params as Params+import qualified Hasql.Private.Encoders.Value as Value+import qualified Hasql.Private.Encoders.Array as Array+import qualified Hasql.Private.PTI as PTI+import qualified Hasql.Private.Prelude as Prelude   -- * Parameters Product Encoder
− library/Hasql/Encoders/Array.hs 
@@ -1,31 +0,0 @@-module Hasql.Encoders.Array where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Encoder as Encoder-import qualified Hasql.PTI as PTI---data Array a =-  Array PTI.OID PTI.OID (Bool -> Encoder.ArrayEncoder a)--{-# INLINE run #-}-run :: Array a -> (PTI.OID, Bool -> Encoder.Encoder a)-run (Array valueOID arrayOID encoder') =-  (arrayOID, \env -> Encoder.array (PTI.oidWord32 valueOID) (encoder' env))--{-# INLINE value #-}-value :: PTI.OID -> PTI.OID -> (Bool -> Encoder.Encoder a) -> Array a-value valueOID arrayOID encoder' =-  Array valueOID arrayOID (Encoder.arrayValue . encoder')--{-# INLINE nullableValue #-}-nullableValue :: PTI.OID -> PTI.OID -> (Bool -> Encoder.Encoder a) -> Array (Maybe a)-nullableValue valueOID arrayOID encoder' =-  Array valueOID arrayOID (Encoder.arrayNullableValue . encoder')--{-# INLINE dimension #-}-dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-dimension foldl (Array valueOID arrayOID encoder') =-  Array valueOID arrayOID (Encoder.arrayDimension foldl . encoder')-
− library/Hasql/Encoders/Params.hs 
@@ -1,51 +0,0 @@-module Hasql.Encoders.Params where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Encoder as Encoder-import qualified Hasql.Encoders.Value as Value-import qualified Hasql.PTI as PTI----- |--- Encoder of some representation of a parameters product.-newtype Params a =-  Params (Op (DList (LibPQ.Oid, Bool -> Maybe ByteString)) a)-  deriving (Contravariant, Divisible, Decidable, Monoid)--instance Semigroup (Params a)--run :: Params a -> a -> DList (LibPQ.Oid, Bool -> Maybe ByteString)-run (Params (Op op)) params =-  {-# SCC "run" #-} -  op params--run' :: Params a -> a -> Bool -> ([LibPQ.Oid], [Maybe (ByteString, LibPQ.Format)])-run' (Params (Op op)) params integerDatetimes =-  {-# SCC "run'" #-} -  foldr step ([], []) (op params)-  where-    step (oid, bytesGetter) ~(oidList, bytesAndFormatList) =-      (,)-        (oid : oidList)-        (fmap (\bytes -> (bytes, LibPQ.Binary)) (bytesGetter integerDatetimes) : bytesAndFormatList)--run'' :: Params a -> a -> Bool -> [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)]-run'' (Params (Op op)) params integerDatetimes =-  {-# SCC "run''" #-} -  foldr step [] (op params)-  where-    step a b =-      mapping a : b-      where-        mapping (oid, bytesGetter) =-          (,,) <$> pure oid <*> bytesGetter integerDatetimes <*> pure LibPQ.Binary--value :: Value.Value a -> Params a-value =-  contramap Just . nullableValue--nullableValue :: Value.Value a -> Params (Maybe a)-nullableValue (Value.Value valueOID arrayOID encoder') =-  Params $ Op $ \input -> -    pure (PTI.oidPQ valueOID, \env -> fmap (Encoder.run (encoder' env)) input)
− library/Hasql/Encoders/Value.hs 
@@ -1,27 +0,0 @@-module Hasql.Encoders.Value where--import Hasql.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified PostgreSQL.Binary.Encoder as Encoder-import qualified Hasql.PTI as PTI---data Value a =-  Value PTI.OID PTI.OID (Bool -> Encoder.Encoder a)--instance Contravariant Value where-  {-# INLINE contramap #-}-  contramap f (Value valueOID arrayOID encoder) =-    Value valueOID arrayOID (\integerDatetimes input -> encoder integerDatetimes (f input))--{-# INLINE run #-}-run :: Value a -> (PTI.OID, PTI.OID, Bool -> Encoder.Encoder a)-run (Value valueOID arrayOID encoder') =-  (valueOID, arrayOID, encoder')--{-# INLINE unsafePTI #-}-unsafePTI :: PTI.PTI -> (Bool -> Encoder.Encoder a) -> Value a-unsafePTI pti encoder' =-  Value (PTI.ptiOID pti) (fromMaybe ($bug "No array OID") (PTI.ptiArrayOID pti)) encoder'--
− library/Hasql/PTI.hs 
@@ -1,94 +0,0 @@-module Hasql.PTI where--import Hasql.Prelude hiding (bool)-import qualified Database.PostgreSQL.LibPQ as LibPQ----- | A Postgresql type info-data PTI = PTI { ptiOID :: !OID, ptiArrayOID :: !(Maybe OID) }---- | A Word32 and a LibPQ representation of an OID-data OID = OID { oidWord32 :: !Word32, oidPQ :: !LibPQ.Oid }--mkOID :: Word32 -> OID-mkOID x =-  OID x ((LibPQ.Oid . fromIntegral) x)--mkPTI :: Word32 -> Maybe Word32 -> PTI-mkPTI oid arrayOID =-  PTI (mkOID oid) (fmap mkOID arrayOID)----- * Constants----------------------------abstime         = mkPTI 702  (Just 1023)-aclitem         = mkPTI 1033 (Just 1034)-bit             = mkPTI 1560 (Just 1561)-bool            = mkPTI 16   (Just 1000)-box             = mkPTI 603  (Just 1020)-bpchar          = mkPTI 1042 (Just 1014)-bytea           = mkPTI 17   (Just 1001)-char            = mkPTI 18   (Just 1002)-cid             = mkPTI 29   (Just 1012)-cidr            = mkPTI 650  (Just 651)-circle          = mkPTI 718  (Just 719)-cstring         = mkPTI 2275 (Just 1263)-date            = mkPTI 1082 (Just 1182)-daterange       = mkPTI 3912 (Just 3913)-float4          = mkPTI 700  (Just 1021)-float8          = mkPTI 701  (Just 1022)-gtsvector       = mkPTI 3642 (Just 3644)-inet            = mkPTI 869  (Just 1041)-int2            = mkPTI 21   (Just 1005)-int2vector      = mkPTI 22   (Just 1006)-int4            = mkPTI 23   (Just 1007)-int4range       = mkPTI 3904 (Just 3905)-int8            = mkPTI 20   (Just 1016)-int8range       = mkPTI 3926 (Just 3927)-interval        = mkPTI 1186 (Just 1187)-json            = mkPTI 114  (Just 199)-jsonb           = mkPTI 3802 (Just 3807)-line            = mkPTI 628  (Just 629)-lseg            = mkPTI 601  (Just 1018)-macaddr         = mkPTI 829  (Just 1040)-money           = mkPTI 790  (Just 791)-name            = mkPTI 19   (Just 1003)-numeric         = mkPTI 1700 (Just 1231)-numrange        = mkPTI 3906 (Just 3907)-oid             = mkPTI 26   (Just 1028)-oidvector       = mkPTI 30   (Just 1013)-path            = mkPTI 602  (Just 1019)-point           = mkPTI 600  (Just 1017)-polygon         = mkPTI 604  (Just 1027)-record          = mkPTI 2249 (Just 2287)-refcursor       = mkPTI 1790 (Just 2201)-regclass        = mkPTI 2205 (Just 2210)-regconfig       = mkPTI 3734 (Just 3735)-regdictionary   = mkPTI 3769 (Just 3770)-regoper         = mkPTI 2203 (Just 2208)-regoperator     = mkPTI 2204 (Just 2209)-regproc         = mkPTI 24   (Just 1008)-regprocedure    = mkPTI 2202 (Just 2207)-regtype         = mkPTI 2206 (Just 2211)-reltime         = mkPTI 703  (Just 1024)-text            = mkPTI 25   (Just 1009)-tid             = mkPTI 27   (Just 1010)-time            = mkPTI 1083 (Just 1183)-timestamp       = mkPTI 1114 (Just 1115)-timestamptz     = mkPTI 1184 (Just 1185)-timetz          = mkPTI 1266 (Just 1270)-tinterval       = mkPTI 704  (Just 1025)-tsquery         = mkPTI 3615 (Just 3645)-tsrange         = mkPTI 3908 (Just 3909)-tstzrange       = mkPTI 3910 (Just 3911)-tsvector        = mkPTI 3614 (Just 3643)-txid_snapshot   = mkPTI 2970 (Just 2949)-unknown         = mkPTI 705  (Just 705)-uuid            = mkPTI 2950 (Just 2951)-varbit          = mkPTI 1562 (Just 1563)-varchar         = mkPTI 1043 (Just 1015)-void            = mkPTI 2278 Nothing-xid             = mkPTI 28   (Just 1011)-xml             = mkPTI 142  (Just 143)-
− library/Hasql/Prelude.hs 
@@ -1,142 +0,0 @@-module Hasql.Prelude-(-  module Exports,-  LazyByteString,-  ByteStringBuilder,-  LazyText,-  TextBuilder,-  bug,-  bottom,-  forMToZero_,-  forMFromZero_,-  strictCons,-)-where----- base-prelude---------------------------import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error, (<>), First(..), Last(..))---- transformers---------------------------import Control.Monad.IO.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)-import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)-import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)-import Data.Functor.Identity as Exports---- mtl---------------------------import Control.Monad.Error.Class as Exports (MonadError (..))---- data-default-class---------------------------import Data.Default.Class as Exports---- profunctors---------------------------import Data.Profunctor.Unsafe as Exports---- contravariant---------------------------import Data.Functor.Contravariant as Exports-import Data.Functor.Contravariant.Divisible as Exports---- contravariant-extras---------------------------import Contravariant.Extras as Exports---- either---------------------------import Control.Monad.Trans.Either as Exports-import Data.Either.Combinators as Exports---- semigroups---------------------------import Data.Semigroup as Exports---- hashable---------------------------import Data.Hashable as Exports (Hashable(..))---- text---------------------------import Data.Text as Exports (Text)---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- scientific---------------------------import Data.Scientific as Exports (Scientific)---- uuid---------------------------import Data.UUID as Exports (UUID)---- time---------------------------import Data.Time as Exports---- vector---------------------------import Data.Vector as Exports (Vector)---- dlist---------------------------import Data.DList as Exports (DList)---- placeholders---------------------------import Development.Placeholders as Exports---- loch-th---------------------------import Debug.Trace.LocationTH as Exports---- custom---------------------------import qualified Debug.Trace.LocationTH-import qualified Data.Text.Lazy-import qualified Data.Text.Lazy.Builder-import qualified Data.ByteString.Lazy-import qualified Data.ByteString.Builder---type LazyByteString =-  Data.ByteString.Lazy.ByteString--type ByteStringBuilder =-  Data.ByteString.Builder.Builder--type LazyText =-  Data.Text.Lazy.Text--type TextBuilder =-  Data.Text.Lazy.Builder.Builder--bug =-  [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]-  where-    msg = "A \"hasql\" package bug: " :: String--bottom =-  [e| $bug "Bottom evaluated" |]--{-# INLINE forMToZero_ #-}-forMToZero_ :: Applicative m => Int -> (Int -> m a) -> m ()-forMToZero_ !startN f =-  ($ pred startN) $ fix $ \loop !n -> if n >= 0 then f n *> loop (pred n) else pure ()--{-# INLINE forMFromZero_ #-}-forMFromZero_ :: Applicative m => Int -> (Int -> m a) -> m ()-forMFromZero_ !endN f =-  ($ 0) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()--{-# INLINE strictCons #-}-strictCons :: a -> [a] -> [a]-strictCons !a b =-  let !c = a : b in c
+ library/Hasql/Private/Commands.hs view
@@ -0,0 +1,33 @@+module Hasql.Private.Commands+(+  Commands,+  asBytes,+  setEncodersToUTF8,+  setMinClientMessagesToWarning,+)+where++import Hasql.Private.Prelude+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Builder as BB+import qualified Data.ByteString.Lazy.Builder.ASCII as BB+import qualified Data.ByteString.Lazy as BL+++newtype Commands =+  Commands (DList BB.Builder)+  deriving (Monoid)++instance Semigroup Commands++asBytes :: Commands -> ByteString+asBytes (Commands list) =+  BL.toStrict $ BB.toLazyByteString $ foldMap (<> BB.char7 ';') $ list++setEncodersToUTF8 :: Commands+setEncodersToUTF8 =+  Commands (pure "SET client_encoding = 'UTF8'")++setMinClientMessagesToWarning :: Commands+setMinClientMessagesToWarning =+  Commands (pure "SET client_min_messages TO WARNING")
library/Hasql/Private/Connection.hs view
@@ -3,11 +3,11 @@ module Hasql.Private.Connection where -import Hasql.Prelude+import Hasql.Private.Prelude import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.PreparedStatementRegistry as PreparedStatementRegistry import qualified Hasql.Private.IO as IO-import qualified Hasql.Settings as Settings+import qualified Hasql.Private.Settings as Settings   -- |
+ library/Hasql/Private/Decoders/Array.hs view
@@ -0,0 +1,31 @@+module Hasql.Private.Decoders.Array where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Decoder as Decoder+++newtype Array a =+  Array (ReaderT Bool Decoder.ArrayDecoder a)+  deriving (Functor)++{-# INLINE run #-}+run :: Array a -> Bool -> Decoder.Decoder a+run (Array imp) env =+  Decoder.array (runReaderT imp env)++{-# INLINE dimension #-}+dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b+dimension replicateM (Array imp) =+  Array $ ReaderT $ \env -> Decoder.arrayDimension replicateM (runReaderT imp env)++{-# INLINE value #-}+value :: (Bool -> Decoder.Decoder a) -> Array (Maybe a)+value decoder' =+  Array $ ReaderT $ Decoder.arrayValue . decoder'++{-# INLINE nonNullValue #-}+nonNullValue :: (Bool -> Decoder.Decoder a) -> Array a+nonNullValue decoder' =+  Array $ ReaderT $ Decoder.arrayNonNullValue . decoder'+
+ library/Hasql/Private/Decoders/Composite.hs view
@@ -0,0 +1,26 @@+module Hasql.Private.Decoders.Composite where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Decoder as Decoder+++newtype Composite a =+  Composite (ReaderT Bool Decoder.CompositeDecoder a)+  deriving (Functor, Applicative, Monad)++{-# INLINE run #-}+run :: Composite a -> Bool -> Decoder.Decoder a+run (Composite imp) env =+  Decoder.composite (runReaderT imp env)++{-# INLINE value #-}+value :: (Bool -> Decoder.Decoder a) -> Composite (Maybe a)+value decoder' =+  Composite $ ReaderT $ Decoder.compositeValue . decoder'++{-# INLINE nonNullValue #-}+nonNullValue :: (Bool -> Decoder.Decoder a) -> Composite a+nonNullValue decoder' =+  Composite $ ReaderT $ Decoder.compositeNonNullValue . decoder'+
+ library/Hasql/Private/Decoders/Result.hs view
@@ -0,0 +1,232 @@+module Hasql.Private.Decoders.Result where++import Hasql.Private.Prelude hiding (maybe, many)+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified Hasql.Private.Decoders.Row as Row+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec+import qualified Data.ByteString as ByteString+import qualified Hasql.Private.Prelude as Prelude+import qualified Data.Vector as Vector+import qualified Data.Vector.Mutable as MutableVector+++newtype Result a =+  Result (ReaderT (Bool, LibPQ.Result) (EitherT Error IO) a)+  deriving (Functor, Applicative, Monad)++data Error =+  -- | +  -- An error reported by the DB. Code, message, details, hint.+  -- +  -- * The SQLSTATE code for the error. The SQLSTATE code identifies the type of error that has occurred; +  -- it can be used by front-end applications to perform specific operations (such as error handling) +  -- in response to a particular database error. +  -- For a list of the possible SQLSTATE codes, see Appendix A.+  -- This field is not localizable, and is always present.+  -- +  -- * The primary human-readable error message (typically one line). Always present.+  -- +  -- * Detail: an optional secondary error message carrying more detail about the problem. +  -- Might run to multiple lines.+  -- +  -- * Hint: an optional suggestion what to do about the problem. +  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) +  -- rather than hard facts. Might run to multiple lines.+  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |+  -- |+  -- The database returned an unexpected result.+  -- Indicates an improper statement or a schema mismatch.+  UnexpectedResult !Text |+  -- |+  -- An error of the row reader, preceded by the index of the row.+  RowError !Int !Row.Error |+  -- |+  -- An unexpected amount of rows.+  UnexpectedAmountOfRows !Int+  deriving (Show)++{-# INLINE run #-}+run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a)+run (Result reader) env =+  runEitherT (runReaderT reader env)++{-# INLINE unit #-}+unit :: Result ()+unit =+  checkExecStatus $ \case+    LibPQ.CommandOk -> True+    LibPQ.TuplesOk -> True+    _ -> False++{-# INLINE rowsAffected #-}+rowsAffected :: Result Int64+rowsAffected =+  do+    checkExecStatus $ \case+      LibPQ.CommandOk -> True+      _ -> False+    Result $ ReaderT $ \(_, result) -> EitherT $+      LibPQ.cmdTuples result & fmap cmdTuplesReader+  where+    cmdTuplesReader =+      notNothing >=> notEmpty >=> decimal+      where+        notNothing =+          Prelude.maybe (Left (UnexpectedResult "No bytes")) Right+        notEmpty bytes =+          if ByteString.null bytes+            then Left (UnexpectedResult "Empty bytes")+            else Right bytes+        decimal bytes =+          mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m)) $+          Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes++{-# INLINE checkExecStatus #-}+checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()+checkExecStatus predicate =+  {-# SCC "checkExecStatus" #-} +  do+    status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result+    unless (predicate status) $ do+      case status of+        LibPQ.BadResponse   -> serverError+        LibPQ.NonfatalError -> serverError+        LibPQ.FatalError    -> serverError+        _ -> Result $ lift $ EitherT $ pure $ Left $ UnexpectedResult $ "Unexpected result status: " <> (fromString $ show status)++{-# INLINE serverError #-}+serverError :: Result ()+serverError =+  Result $ ReaderT $ \(_, result) -> EitherT $ do+    code <- +      fmap (fromMaybe ($bug "No code")) $+      LibPQ.resultErrorField result LibPQ.DiagSqlstate+    message <- +      fmap (fromMaybe ($bug "No message")) $+      LibPQ.resultErrorField result LibPQ.DiagMessagePrimary+    detail <- +      LibPQ.resultErrorField result LibPQ.DiagMessageDetail+    hint <- +      LibPQ.resultErrorField result LibPQ.DiagMessageHint+    pure $ Left $ ServerError code message detail hint++{-# INLINE maybe #-}+maybe :: Row.Row a -> Result (Maybe a)+maybe rowDec =+  do+    checkExecStatus $ \case+      LibPQ.TuplesOk -> True+      _ -> False+    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do+      maxRows <- LibPQ.ntuples result+      case maxRows of+        0 -> return (Right Nothing)+        1 -> do+          maxCols <- LibPQ.nfields result+          fmap (fmap Just . mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)+        _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))+  where+    rowToInt (LibPQ.Row n) =+      fromIntegral n+    intToRow =+      LibPQ.Row . fromIntegral++{-# INLINE single #-}+single :: Row.Row a -> Result a+single rowDec =+  do+    checkExecStatus $ \case+      LibPQ.TuplesOk -> True+      _ -> False+    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do+      maxRows <- LibPQ.ntuples result+      case maxRows of+        1 -> do+          maxCols <- LibPQ.nfields result+          fmap (mapLeft (RowError 0)) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)+        _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))+  where+    rowToInt (LibPQ.Row n) =+      fromIntegral n+    intToRow =+      LibPQ.Row . fromIntegral++{-# INLINE vector #-}+vector :: Row.Row a -> Result (Vector a)+vector rowDec =+  do+    checkExecStatus $ \case+      LibPQ.TuplesOk -> True+      _ -> False+    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do+      maxRows <- LibPQ.ntuples result+      maxCols <- LibPQ.nfields result+      mvector <- MutableVector.unsafeNew (rowToInt maxRows)+      failureRef <- newIORef Nothing+      forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do+        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)+        case rowResult of+          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))+          Right !x -> MutableVector.unsafeWrite mvector rowIndex x+      readIORef failureRef >>= \case+        Nothing -> Right <$> Vector.unsafeFreeze mvector+        Just x -> pure (Left x)+  where+    rowToInt (LibPQ.Row n) =+      fromIntegral n+    intToRow =+      LibPQ.Row . fromIntegral++{-# INLINE foldl #-}+foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a+foldl step init rowDec =+  {-# SCC "foldl" #-} +  do+    checkExecStatus $ \case+      LibPQ.TuplesOk -> True+      _ -> False+    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ {-# SCC "traversal" #-} do+      maxRows <- LibPQ.ntuples result+      maxCols <- LibPQ.nfields result+      accRef <- newIORef init+      failureRef <- newIORef Nothing+      forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do+        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)+        case rowResult of+          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))+          Right !x -> modifyIORef accRef (\acc -> step acc x)+      readIORef failureRef >>= \case+        Nothing -> Right <$> readIORef accRef+        Just x -> pure (Left x)+  where+    rowToInt (LibPQ.Row n) =+      fromIntegral n+    intToRow =+      LibPQ.Row . fromIntegral++{-# INLINE foldr #-}+foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a+foldr step init rowDec =+  {-# SCC "foldr" #-} +  do+    checkExecStatus $ \case+      LibPQ.TuplesOk -> True+      _ -> False+    Result $ ReaderT $ \(integerDatetimes, result) -> EitherT $ do+      maxRows <- LibPQ.ntuples result+      maxCols <- LibPQ.nfields result+      accRef <- newIORef init+      failureRef <- newIORef Nothing+      forMToZero_ (rowToInt maxRows) $ \rowIndex -> do+        rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)+        case rowResult of+          Left !x -> writeIORef failureRef (Just (RowError rowIndex x))+          Right !x -> modifyIORef accRef (\acc -> step x acc)+      readIORef failureRef >>= \case+        Nothing -> Right <$> readIORef accRef+        Just x -> pure (Left x)+  where+    rowToInt (LibPQ.Row n) =+      fromIntegral n+    intToRow =+      LibPQ.Row . fromIntegral
+ library/Hasql/Private/Decoders/Results.hs view
@@ -0,0 +1,91 @@+-- |+-- An API for retrieval of multiple results.+-- Can be used to handle:+-- +-- * A single result,+-- +-- * Individual results of a multi-statement query+-- with the help of "Applicative" and "Monad",+-- +-- * Row-by-row fetching.+-- +module Hasql.Private.Decoders.Results where++import Hasql.Private.Prelude hiding (maybe, many)+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified Hasql.Private.Prelude as Prelude+import qualified Hasql.Private.Decoders.Result as Result+import qualified Hasql.Private.Decoders.Row as Row+++newtype Results a =+  Results (ReaderT (Bool, LibPQ.Connection) (EitherT Error IO) a)+  deriving (Functor, Applicative, Monad)++data Error =+  -- |+  -- An error on the client-side,+  -- with a message generated by the \"libpq\" library.+  -- Usually indicates problems with the connection.+  ClientError !(Maybe ByteString) |+  ResultError !Result.Error+  deriving (Show)++{-# INLINE run #-}+run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a)+run (Results stack) env =+  runEitherT (runReaderT stack env)++{-# INLINE clientError #-}+clientError :: Results a+clientError =+  Results $ ReaderT $ \(_, connection) -> EitherT $+  fmap (Left . ClientError) (LibPQ.errorMessage connection)++-- |+-- Parse a single result.+{-# INLINE single #-}+single :: Result.Result a -> Results a+single resultDec =+  Results $ ReaderT $ \(integerDatetimes, connection) -> EitherT $ do+    resultMaybe <- LibPQ.getResult connection+    case resultMaybe of+      Just result ->+        mapLeft ResultError <$> Result.run resultDec (integerDatetimes, result) +      Nothing ->+        fmap (Left . ClientError) (LibPQ.errorMessage connection)++-- |+-- Fetch a single result.+{-# INLINE getResult #-}+getResult :: Results LibPQ.Result+getResult =+  Results $ ReaderT $ \(_, connection) -> EitherT $ do+    resultMaybe <- LibPQ.getResult connection+    case resultMaybe of+      Just result -> pure (Right result)+      Nothing -> fmap (Left . ClientError) (LibPQ.errorMessage connection)++-- |+-- Fetch a single result.+{-# INLINE getResultMaybe #-}+getResultMaybe :: Results (Maybe LibPQ.Result)+getResultMaybe =+  Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection++{-# INLINE dropRemainders #-}+dropRemainders :: Results ()+dropRemainders =+  {-# SCC "dropRemainders" #-} +  Results $ ReaderT $ \(integerDatetimes, connection) -> loop integerDatetimes connection+  where+    loop integerDatetimes connection =+      getResultMaybe >>= Prelude.maybe (pure ()) onResult+      where+        getResultMaybe =+          lift $ LibPQ.getResult connection+        onResult result =+          checkErrors *> loop integerDatetimes connection+          where+            checkErrors =+              EitherT $ fmap (mapLeft ResultError) $ Result.run Result.unit (integerDatetimes, result)
+ library/Hasql/Private/Decoders/Row.hs view
@@ -0,0 +1,65 @@+module Hasql.Private.Decoders.Row where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Decoder as Decoder+import qualified Hasql.Private.Decoders.Value as Value+++newtype Row a =+  Row (ReaderT Env (EitherT Error IO) a)+  deriving (Functor, Applicative, Monad)++data Env =+  Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)++data Error =+  EndOfInput |+  UnexpectedNull |+  ValueError !Text+  deriving (Show)+++-- * Functions+-------------------------++{-# INLINE run #-}+run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either Error a)+run (Row impl) (result, row, columnsAmount, integerDatetimes) =+  do+    columnRef <- newIORef 0+    runEitherT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef))++{-# INLINE error #-}+error :: Error -> Row a+error x =+  Row (ReaderT (const (EitherT (pure (Left x)))))++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE value #-}+value :: Value.Value a -> Row (Maybe a)+value valueDec =+  {-# SCC "value" #-} +  Row $ ReaderT $ \(Env result row columnsAmount integerDatetimes columnRef) -> EitherT $ do+    col <- readIORef columnRef+    writeIORef columnRef (succ col)+    if col < columnsAmount+      then do+        valueMaybe <- {-# SCC "getvalue'" #-} LibPQ.getvalue' result row col+        pure $ +          case valueMaybe of+            Nothing ->+              Right Nothing+            Just value ->+              fmap Just $ mapLeft ValueError $+              {-# SCC "decode" #-} Decoder.run (Value.run valueDec integerDatetimes) value+      else pure (Left EndOfInput)++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE nonNullValue #-}+nonNullValue :: Value.Value a -> Row a+nonNullValue valueDec =+  {-# SCC "nonNullValue" #-} +  value valueDec >>= maybe (error UnexpectedNull) pure
+ library/Hasql/Private/Decoders/Value.hs view
@@ -0,0 +1,28 @@+module Hasql.Private.Decoders.Value where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Decoder as Decoder+++newtype Value a =+  Value (ReaderT Bool Decoder.Decoder a)+  deriving (Functor)+++{-# INLINE run #-}+run :: Value a -> Bool -> Decoder.Decoder a+run (Value imp) integerDatetimes =+  runReaderT imp integerDatetimes++{-# INLINE decoder #-}+decoder :: (Bool -> Decoder.Decoder a) -> Value a+decoder =+  {-# SCC "decoder" #-} +  Value . ReaderT++{-# INLINE decoderFn #-}+decoderFn :: (Bool -> ByteString -> Either Text a) -> Value a+decoderFn fn =+  Value $ ReaderT $ \integerDatetimes -> Decoder.fn $ fn integerDatetimes+
+ library/Hasql/Private/Encoders/Array.hs view
@@ -0,0 +1,31 @@+module Hasql.Private.Encoders.Array where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Encoder as Encoder+import qualified Hasql.Private.PTI as PTI+++data Array a =+  Array PTI.OID PTI.OID (Bool -> Encoder.ArrayEncoder a)++{-# INLINE run #-}+run :: Array a -> (PTI.OID, Bool -> Encoder.Encoder a)+run (Array valueOID arrayOID encoder') =+  (arrayOID, \env -> Encoder.array (PTI.oidWord32 valueOID) (encoder' env))++{-# INLINE value #-}+value :: PTI.OID -> PTI.OID -> (Bool -> Encoder.Encoder a) -> Array a+value valueOID arrayOID encoder' =+  Array valueOID arrayOID (Encoder.arrayValue . encoder')++{-# INLINE nullableValue #-}+nullableValue :: PTI.OID -> PTI.OID -> (Bool -> Encoder.Encoder a) -> Array (Maybe a)+nullableValue valueOID arrayOID encoder' =+  Array valueOID arrayOID (Encoder.arrayNullableValue . encoder')++{-# INLINE dimension #-}+dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c+dimension foldl (Array valueOID arrayOID encoder') =+  Array valueOID arrayOID (Encoder.arrayDimension foldl . encoder')+
+ library/Hasql/Private/Encoders/Params.hs view
@@ -0,0 +1,51 @@+module Hasql.Private.Encoders.Params where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Encoder as Encoder+import qualified Hasql.Private.Encoders.Value as Value+import qualified Hasql.Private.PTI as PTI+++-- |+-- Encoder of some representation of a parameters product.+newtype Params a =+  Params (Op (DList (LibPQ.Oid, Bool -> Maybe ByteString)) a)+  deriving (Contravariant, Divisible, Decidable, Monoid)++instance Semigroup (Params a)++run :: Params a -> a -> DList (LibPQ.Oid, Bool -> Maybe ByteString)+run (Params (Op op)) params =+  {-# SCC "run" #-} +  op params++run' :: Params a -> a -> Bool -> ([LibPQ.Oid], [Maybe (ByteString, LibPQ.Format)])+run' (Params (Op op)) params integerDatetimes =+  {-# SCC "run'" #-} +  foldr step ([], []) (op params)+  where+    step (oid, bytesGetter) ~(oidList, bytesAndFormatList) =+      (,)+        (oid : oidList)+        (fmap (\bytes -> (bytes, LibPQ.Binary)) (bytesGetter integerDatetimes) : bytesAndFormatList)++run'' :: Params a -> a -> Bool -> [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)]+run'' (Params (Op op)) params integerDatetimes =+  {-# SCC "run''" #-} +  foldr step [] (op params)+  where+    step a b =+      mapping a : b+      where+        mapping (oid, bytesGetter) =+          (,,) <$> pure oid <*> bytesGetter integerDatetimes <*> pure LibPQ.Binary++value :: Value.Value a -> Params a+value =+  contramap Just . nullableValue++nullableValue :: Value.Value a -> Params (Maybe a)+nullableValue (Value.Value valueOID arrayOID encoder') =+  Params $ Op $ \input -> +    pure (PTI.oidPQ valueOID, \env -> fmap (Encoder.run (encoder' env)) input)
+ library/Hasql/Private/Encoders/Value.hs view
@@ -0,0 +1,27 @@+module Hasql.Private.Encoders.Value where++import Hasql.Private.Prelude+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified PostgreSQL.Binary.Encoder as Encoder+import qualified Hasql.Private.PTI as PTI+++data Value a =+  Value PTI.OID PTI.OID (Bool -> Encoder.Encoder a)++instance Contravariant Value where+  {-# INLINE contramap #-}+  contramap f (Value valueOID arrayOID encoder) =+    Value valueOID arrayOID (\integerDatetimes input -> encoder integerDatetimes (f input))++{-# INLINE run #-}+run :: Value a -> (PTI.OID, PTI.OID, Bool -> Encoder.Encoder a)+run (Value valueOID arrayOID encoder') =+  (valueOID, arrayOID, encoder')++{-# INLINE unsafePTI #-}+unsafePTI :: PTI.PTI -> (Bool -> Encoder.Encoder a) -> Value a+unsafePTI pti encoder' =+  Value (PTI.ptiOID pti) (fromMaybe ($bug "No array OID") (PTI.ptiArrayOID pti)) encoder'++
library/Hasql/Private/IO.hs view
@@ -3,13 +3,13 @@ module Hasql.Private.IO where -import Hasql.Prelude+import Hasql.Private.Prelude import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Hasql.Commands as Commands+import qualified Hasql.Private.Commands as Commands import qualified Hasql.Private.PreparedStatementRegistry as PreparedStatementRegistry-import qualified Hasql.Decoders.Result as ResultDecoders-import qualified Hasql.Decoders.Results as ResultsDecoders-import qualified Hasql.Encoders.Params as ParamsEncoders+import qualified Hasql.Private.Decoders.Result as ResultDecoders+import qualified Hasql.Private.Decoders.Results as ResultsDecoders+import qualified Hasql.Private.Encoders.Params as ParamsEncoders import qualified Data.DList as DList
+ library/Hasql/Private/PTI.hs view
@@ -0,0 +1,94 @@+module Hasql.Private.PTI where++import Hasql.Private.Prelude hiding (bool)+import qualified Database.PostgreSQL.LibPQ as LibPQ+++-- | A Postgresql type info+data PTI = PTI { ptiOID :: !OID, ptiArrayOID :: !(Maybe OID) }++-- | A Word32 and a LibPQ representation of an OID+data OID = OID { oidWord32 :: !Word32, oidPQ :: !LibPQ.Oid }++mkOID :: Word32 -> OID+mkOID x =+  OID x ((LibPQ.Oid . fromIntegral) x)++mkPTI :: Word32 -> Maybe Word32 -> PTI+mkPTI oid arrayOID =+  PTI (mkOID oid) (fmap mkOID arrayOID)+++-- * Constants+-------------------------++abstime         = mkPTI 702  (Just 1023)+aclitem         = mkPTI 1033 (Just 1034)+bit             = mkPTI 1560 (Just 1561)+bool            = mkPTI 16   (Just 1000)+box             = mkPTI 603  (Just 1020)+bpchar          = mkPTI 1042 (Just 1014)+bytea           = mkPTI 17   (Just 1001)+char            = mkPTI 18   (Just 1002)+cid             = mkPTI 29   (Just 1012)+cidr            = mkPTI 650  (Just 651)+circle          = mkPTI 718  (Just 719)+cstring         = mkPTI 2275 (Just 1263)+date            = mkPTI 1082 (Just 1182)+daterange       = mkPTI 3912 (Just 3913)+float4          = mkPTI 700  (Just 1021)+float8          = mkPTI 701  (Just 1022)+gtsvector       = mkPTI 3642 (Just 3644)+inet            = mkPTI 869  (Just 1041)+int2            = mkPTI 21   (Just 1005)+int2vector      = mkPTI 22   (Just 1006)+int4            = mkPTI 23   (Just 1007)+int4range       = mkPTI 3904 (Just 3905)+int8            = mkPTI 20   (Just 1016)+int8range       = mkPTI 3926 (Just 3927)+interval        = mkPTI 1186 (Just 1187)+json            = mkPTI 114  (Just 199)+jsonb           = mkPTI 3802 (Just 3807)+line            = mkPTI 628  (Just 629)+lseg            = mkPTI 601  (Just 1018)+macaddr         = mkPTI 829  (Just 1040)+money           = mkPTI 790  (Just 791)+name            = mkPTI 19   (Just 1003)+numeric         = mkPTI 1700 (Just 1231)+numrange        = mkPTI 3906 (Just 3907)+oid             = mkPTI 26   (Just 1028)+oidvector       = mkPTI 30   (Just 1013)+path            = mkPTI 602  (Just 1019)+point           = mkPTI 600  (Just 1017)+polygon         = mkPTI 604  (Just 1027)+record          = mkPTI 2249 (Just 2287)+refcursor       = mkPTI 1790 (Just 2201)+regclass        = mkPTI 2205 (Just 2210)+regconfig       = mkPTI 3734 (Just 3735)+regdictionary   = mkPTI 3769 (Just 3770)+regoper         = mkPTI 2203 (Just 2208)+regoperator     = mkPTI 2204 (Just 2209)+regproc         = mkPTI 24   (Just 1008)+regprocedure    = mkPTI 2202 (Just 2207)+regtype         = mkPTI 2206 (Just 2211)+reltime         = mkPTI 703  (Just 1024)+text            = mkPTI 25   (Just 1009)+tid             = mkPTI 27   (Just 1010)+time            = mkPTI 1083 (Just 1183)+timestamp       = mkPTI 1114 (Just 1115)+timestamptz     = mkPTI 1184 (Just 1185)+timetz          = mkPTI 1266 (Just 1270)+tinterval       = mkPTI 704  (Just 1025)+tsquery         = mkPTI 3615 (Just 3645)+tsrange         = mkPTI 3908 (Just 3909)+tstzrange       = mkPTI 3910 (Just 3911)+tsvector        = mkPTI 3614 (Just 3643)+txid_snapshot   = mkPTI 2970 (Just 2949)+unknown         = mkPTI 705  (Just 705)+uuid            = mkPTI 2950 (Just 2951)+varbit          = mkPTI 1562 (Just 1563)+varchar         = mkPTI 1043 (Just 1015)+void            = mkPTI 2278 Nothing+xid             = mkPTI 28   (Just 1011)+xml             = mkPTI 142  (Just 143)+
+ library/Hasql/Private/Prelude.hs view
@@ -0,0 +1,142 @@+module Hasql.Private.Prelude+(+  module Exports,+  LazyByteString,+  ByteStringBuilder,+  LazyText,+  TextBuilder,+  bug,+  bottom,+  forMToZero_,+  forMFromZero_,+  strictCons,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error, (<>), First(..), Last(..))++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Data.Functor.Identity as Exports++-- mtl+-------------------------+import Control.Monad.Error.Class as Exports (MonadError (..))++-- data-default-class+-------------------------+import Data.Default.Class as Exports++-- profunctors+-------------------------+import Data.Profunctor.Unsafe as Exports++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- contravariant-extras+-------------------------+import Contravariant.Extras as Exports++-- either+-------------------------+import Control.Monad.Trans.Either as Exports+import Data.Either.Combinators as Exports++-- semigroups+-------------------------+import Data.Semigroup as Exports++-- hashable+-------------------------+import Data.Hashable as Exports (Hashable(..))++-- text+-------------------------+import Data.Text as Exports (Text)++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- scientific+-------------------------+import Data.Scientific as Exports (Scientific)++-- uuid+-------------------------+import Data.UUID as Exports (UUID)++-- time+-------------------------+import Data.Time as Exports++-- vector+-------------------------+import Data.Vector as Exports (Vector)++-- dlist+-------------------------+import Data.DList as Exports (DList)++-- placeholders+-------------------------+import Development.Placeholders as Exports++-- loch-th+-------------------------+import Debug.Trace.LocationTH as Exports++-- custom+-------------------------+import qualified Debug.Trace.LocationTH+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Builder+import qualified Data.ByteString.Lazy+import qualified Data.ByteString.Builder+++type LazyByteString =+  Data.ByteString.Lazy.ByteString++type ByteStringBuilder =+  Data.ByteString.Builder.Builder++type LazyText =+  Data.Text.Lazy.Text++type TextBuilder =+  Data.Text.Lazy.Builder.Builder++bug =+  [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]+  where+    msg = "A \"hasql\" package bug: " :: String++bottom =+  [e| $bug "Bottom evaluated" |]++{-# INLINE forMToZero_ #-}+forMToZero_ :: Applicative m => Int -> (Int -> m a) -> m ()+forMToZero_ !startN f =+  ($ pred startN) $ fix $ \loop !n -> if n >= 0 then f n *> loop (pred n) else pure ()++{-# INLINE forMFromZero_ #-}+forMFromZero_ :: Applicative m => Int -> (Int -> m a) -> m ()+forMFromZero_ !endN f =+  ($ 0) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()++{-# INLINE strictCons #-}+strictCons :: a -> [a] -> [a]+strictCons !a b =+  let !c = a : b in c
library/Hasql/Private/PreparedStatementRegistry.hs view
@@ -7,7 +7,7 @@ ) where -import Hasql.Prelude hiding (lookup)+import Hasql.Private.Prelude hiding (lookup) import qualified Data.HashTable.IO as A import qualified ByteString.TreeBuilder as B
library/Hasql/Private/Query.hs view
@@ -1,12 +1,12 @@ module Hasql.Private.Query where -import Hasql.Prelude+import Hasql.Private.Prelude import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.IO as IO import qualified Hasql.Private.Connection as Connection-import qualified Hasql.Decoders.Results as Decoders.Results-import qualified Hasql.Encoders.Params as Encoders.Params+import qualified Hasql.Private.Decoders.Results as Decoders.Results+import qualified Hasql.Private.Encoders.Params as Encoders.Params   -- |
library/Hasql/Private/Session.hs view
@@ -1,11 +1,11 @@ module Hasql.Private.Session where -import Hasql.Prelude+import Hasql.Private.Prelude import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Hasql.Decoders.Results as Decoders.Results-import qualified Hasql.Decoders.Result as Decoders.Result-import qualified Hasql.Settings as Settings+import qualified Hasql.Private.Decoders.Results as Decoders.Results+import qualified Hasql.Private.Decoders.Result as Decoders.Result+import qualified Hasql.Private.Settings as Settings import qualified Hasql.Private.IO as IO import qualified Hasql.Private.Query as Query import qualified Hasql.Private.Connection as Connection
+ library/Hasql/Private/Settings.hs view
@@ -0,0 +1,39 @@+module Hasql.Private.Settings where++import Hasql.Private.Prelude+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Builder as BB+import qualified Data.ByteString.Lazy.Builder.ASCII as BB+import qualified Data.ByteString.Lazy as BL++++-- | +-- All settings encoded in a single byte-string according to +-- <http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING the PostgreSQL format>.+type Settings =+  ByteString++-- |+-- Encode a host, a port, a user, a password and a database into the PostgreSQL settings byte-string.+{-# INLINE settings #-}+settings :: ByteString -> Word16 -> ByteString -> ByteString -> ByteString -> Settings+settings host port user password database =+  BL.toStrict $ BB.toLazyByteString $ mconcat $ intersperse (BB.char7 ' ') $ catMaybes $+  [+    mappend (BB.string7 "host=") . BB.byteString <$> +    mfilter (not . B.null) (pure host)+    ,+    mappend (BB.string7 "port=") . BB.word16Dec <$> +    mfilter (/= 0) (pure port)+    ,+    mappend (BB.string7 "user=") . BB.byteString <$> +    mfilter (not . B.null) (pure user)+    ,+    mappend (BB.string7 "password=") . BB.byteString <$> +    mfilter (not . B.null) (pure password)+    ,+    mappend (BB.string7 "dbname=") . BB.byteString <$> +    mfilter (not . B.null) (pure database)+  ]+
library/Hasql/Query.hs view
@@ -5,11 +5,11 @@ ) where -import Hasql.Prelude+import Hasql.Private.Prelude import qualified Hasql.Private.Query as Query-import qualified Hasql.Decoders.Results as Decoders.Results+import qualified Hasql.Private.Decoders.Results as Decoders.Results import qualified Hasql.Decoders as Decoders-import qualified Hasql.Encoders.Params as Encoders.Params+import qualified Hasql.Private.Encoders.Params as Encoders.Params import qualified Hasql.Encoders as Encoders  @@ -41,10 +41,10 @@ --     sql = --       "select ($1 + $2)" --     encoder =---       'contramap' 'fst' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8') '<>'---       'contramap' 'snd' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8')+--       'contramap' 'fst' (Hasql.Private.Encoders.'Hasql.Private.Encoders.value' Hasql.Private.Encoders.'Hasql.Private.Encoders.int8') '<>'+--       'contramap' 'snd' (Hasql.Private.Encoders.'Hasql.Private.Encoders.value' Hasql.Private.Encoders.'Hasql.Private.Encoders.int8') --     decoder =---       Hasql.Decoders.'Hasql.Decoders.singleRow' (Hasql.Decoders.'Hasql.Decoders.value' Hasql.Decoders.'Hasql.Decoders.int8')+--       Hasql.Private.Decoders.'Hasql.Private.Decoders.singleRow' (Hasql.Private.Decoders.'Hasql.Private.Decoders.value' Hasql.Private.Decoders.'Hasql.Private.Decoders.int8') -- @ --  -- The statement above accepts a product of two parameters of type 'Int64'
− library/Hasql/Settings.hs 
@@ -1,39 +0,0 @@-module Hasql.Settings where--import Hasql.Prelude-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy.Builder as BB-import qualified Data.ByteString.Lazy.Builder.ASCII as BB-import qualified Data.ByteString.Lazy as BL------ | --- All settings encoded in a single byte-string according to --- <http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING the PostgreSQL format>.-type Settings =-  ByteString---- |--- Encode a host, a port, a user, a password and a database into the PostgreSQL settings byte-string.-{-# INLINE settings #-}-settings :: ByteString -> Word16 -> ByteString -> ByteString -> ByteString -> Settings-settings host port user password database =-  BL.toStrict $ BB.toLazyByteString $ mconcat $ intersperse (BB.char7 ' ') $ catMaybes $-  [-    mappend (BB.string7 "host=") . BB.byteString <$> -    mfilter (not . B.null) (pure host)-    ,-    mappend (BB.string7 "port=") . BB.word16Dec <$> -    mfilter (/= 0) (pure port)-    ,-    mappend (BB.string7 "user=") . BB.byteString <$> -    mfilter (not . B.null) (pure user)-    ,-    mappend (BB.string7 "password=") . BB.byteString <$> -    mfilter (not . B.null) (pure password)-    ,-    mappend (BB.string7 "dbname=") . BB.byteString <$> -    mfilter (not . B.null) (pure database)-  ]-