diff --git a/.github/workflows/fourmolu.yaml b/.github/workflows/fourmolu.yaml new file mode 100644 index 0000000..4730c86 --- /dev/null +++ b/.github/workflows/fourmolu.yaml @@ -0,0 +1,10 @@ +name: Fourmolu +on: push +jobs: + format: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: haskell-actions/run-fourmolu@v10 + with: + version: "0.15.0.0" diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..b47fe72 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,53 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: none + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: leading + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: leading + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: true + +# Whether to leave a space before an opening record brace +record-brace-space: true + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: single-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: inline + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: no-space + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: never + +# Whether to put parentheses around a single deriving class (choices: auto, always, or never) +single-deriving-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] diff --git a/hpqtypes.cabal b/hpqtypes.cabal index de0e953..7f78665 100644 --- a/hpqtypes.cabal +++ b/hpqtypes.cabal @@ -116,7 +116,7 @@ library hs-source-dirs: src - ghc-options: -Wall + ghc-options: -Wall -Wprepositive-qualified-module include-dirs: libpqtypes/src @@ -152,6 +152,7 @@ library , ForeignFunctionInterface , GADTs , GeneralizedNewtypeDeriving + , ImportQualifiedPost , LambdaCase , MultiParamTypeClasses , MultiWayIf @@ -170,7 +171,7 @@ library test-suite hpqtypes-tests type: exitcode-stdio-1.0 - ghc-options: -Wall -threaded + ghc-options: -Wall -Wprepositive-qualified-module -threaded hs-source-dirs: test main-is: Main.hs @@ -210,6 +211,7 @@ test-suite hpqtypes-tests , ForeignFunctionInterface , GADTs , GeneralizedNewtypeDeriving + , ImportQualifiedPost , LambdaCase , MultiParamTypeClasses , MultiWayIf diff --git a/src/Data/Monoid/Utils.hs b/src/Data/Monoid/Utils.hs index 3723f10..2596d7b 100644 --- a/src/Data/Monoid/Utils.hs +++ b/src/Data/Monoid/Utils.hs @@ -1,5 +1,5 @@ -module Data.Monoid.Utils ( - mintercalate +module Data.Monoid.Utils + ( mintercalate , mspace , smappend , smconcat @@ -28,4 +28,5 @@ smconcat = mintercalate mspace -- | Infix version of 'smappend'. (<+>) :: (IsString m, Monoid m) => m -> m -> m (<+>) = smappend + infixr 6 <+> diff --git a/src/Database/PostgreSQL/PQTypes.hs b/src/Database/PostgreSQL/PQTypes.hs index 7ea3c27..a96710b 100644 --- a/src/Database/PostgreSQL/PQTypes.hs +++ b/src/Database/PostgreSQL/PQTypes.hs @@ -1,42 +1,47 @@ -- | Set of definitions exposed to the end user. -module Database.PostgreSQL.PQTypes ( - -- Database.PostgreSQL.PQTypes.Internal.Connection - -- * Connection +module Database.PostgreSQL.PQTypes + ( -- Database.PostgreSQL.PQTypes.Internal.Connection + + -- * Connection Connection - , ConnectionStats(..) - , ConnectionSettings(..) + , ConnectionStats (..) + , ConnectionSettings (..) , defaultConnectionSettings , ConnectionSourceM - , ConnectionSource(..) + , ConnectionSource (..) , simpleSource , poolSource -- Database.PostgreSQL.PQTypes.Internal.Error - -- * Exceptions - , ErrorCode(..) - , DetailedQueryError(..) - , QueryError(..) - , HPQTypesError(..) - , LibPQError(..) - , ConversionError(..) - , ArrayItemError(..) - , InvalidValue(..) - , RangeError(..) - , ArrayDimensionMismatch(..) - , RowLengthMismatch(..) - , AffectedRowsMismatch(..) + + -- * Exceptions + , ErrorCode (..) + , DetailedQueryError (..) + , QueryError (..) + , HPQTypesError (..) + , LibPQError (..) + , ConversionError (..) + , ArrayItemError (..) + , InvalidValue (..) + , RangeError (..) + , ArrayDimensionMismatch (..) + , RowLengthMismatch (..) + , AffectedRowsMismatch (..) -- Database.PostgreSQL.PQTypes.Internal.Exception - , DBException(..) + , DBException (..) -- Database.PostgreSQL.PQTypes.Internal.Monad - -- * Monad transformer + + -- * Monad transformer , DBT , runDBT , mapDBT -- Database.PostgreSQL.PQTypes.Internal.QueryResult - -- * Query result + + -- * Query result , QueryResult , ntuples , nfields - -- * Other modules + + -- * Other modules , module Data.Functor.Identity , module Database.PostgreSQL.PQTypes.Array , module Database.PostgreSQL.PQTypes.Class @@ -88,4 +93,3 @@ import Database.PostgreSQL.PQTypes.Transaction import Database.PostgreSQL.PQTypes.Transaction.Settings import Database.PostgreSQL.PQTypes.Utils import Database.PostgreSQL.PQTypes.XML - diff --git a/src/Database/PostgreSQL/PQTypes/Array.hs b/src/Database/PostgreSQL/PQTypes/Array.hs index 9a29609..9f91631 100644 --- a/src/Database/PostgreSQL/PQTypes/Array.hs +++ b/src/Database/PostgreSQL/PQTypes/Array.hs @@ -1,28 +1,32 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.Array ( - -- * Array1 - Array1(..) + +module Database.PostgreSQL.PQTypes.Array + ( -- * Array1 + Array1 (..) , unArray1 - -- * CompositeArray1 - , CompositeArray1(..) + + -- * CompositeArray1 + , CompositeArray1 (..) , unCompositeArray1 - -- * Array2 - , Array2(..) + + -- * Array2 + , Array2 (..) , unArray2 - -- * CompositeArray2 - , CompositeArray2(..) + + -- * CompositeArray2 + , CompositeArray2 (..) , unCompositeArray2 ) where +import Control.Exception qualified as E import Control.Monad +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Unsafe qualified as BS +import Data.Vector.Storable qualified as V import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Unsafe as BS -import qualified Data.Vector.Storable as V import Database.PostgreSQL.PQTypes.Composite import Database.PostgreSQL.PQTypes.Format @@ -62,9 +66,9 @@ instance ToSQL t => ToSQL (Array1 t) where type PQDest (Array1 t) = PGarray toSQL (Array1 arr) pa@(ParamAllocator allocParam) conv = alloca $ \err -> allocParam $ \param -> - putArray1 arr param conv $ \fmt item -> - toSQL item pa (c_PQputf1 param err fmt) - >>= verifyPQTRes err "toSQL (Array1)" + putArray1 arr param conv $ \fmt item -> + toSQL item pa (c_PQputf1 param err fmt) + >>= verifyPQTRes err "toSQL (Array1)" ---------------------------------------- @@ -84,62 +88,80 @@ instance CompositeFromSQL t => FromSQL (CompositeArray1 t) where fromSQL Nothing = unexpectedNULL fromSQL (Just arr) = getArray1 CompositeArray1 arr getItem where - getItem res err i (_::Ptr CInt) _ = toComposite <$> fromRow res err 0 i + getItem res err i (_ :: Ptr CInt) _ = toComposite <$> fromRow res err 0 i instance CompositeToSQL t => ToSQL (CompositeArray1 t) where type PQDest (CompositeArray1 t) = PGarray toSQL (CompositeArray1 arr) pa@(ParamAllocator allocParam) conv = alloca $ \err -> allocParam $ \param -> - putArray1 arr param conv $ \fmt item -> - toSQL (Composite item) pa (c_PQputf1 param err fmt) - >>= verifyPQTRes err "toSQL (CompositeArray1)" + putArray1 arr param conv $ \fmt item -> + toSQL (Composite item) pa (c_PQputf1 param err fmt) + >>= verifyPQTRes err "toSQL (CompositeArray1)" ---------------------------------------- -- | Helper function for putting elements of -- 'Array1' / 'CompositeArray1' into 'PGparam'. -putArray1 :: forall t r. PQFormat t - => [t] -- ^ List of items to be put. - -> Ptr PGparam -- ^ Inner 'PGparam' to put items into. - -> (Ptr PGarray -> IO r) -- ^ Continuation that puts - -- 'PGarray' into outer 'PGparam'. - -> (CString -> t -> IO ()) -- ^ Function that takes item - -- along with its format and puts it into inner 'PGparam'. - -> IO r +putArray1 + :: forall t r + . PQFormat t + => [t] + -- ^ List of items to be put. + -> Ptr PGparam + -- ^ Inner 'PGparam' to put items into. + -> (Ptr PGarray -> IO r) + -- ^ Continuation that puts + -- 'PGarray' into outer 'PGparam'. + -> (CString -> t -> IO ()) + -- ^ Function that takes item + -- along with its format and puts it into inner 'PGparam'. + -> IO r putArray1 arr param conv putItem = do pqFormat0 @t `BS.unsafeUseAsCString` (forM_ arr . putItem) - putAsPtr (PGarray { - pgArrayNDims = 0 - , pgArrayLBound = V.empty - , pgArrayDims = V.empty - , pgArrayParam = param - , pgArrayRes = nullPtr - }) conv + putAsPtr + ( PGarray + { pgArrayNDims = 0 + , pgArrayLBound = V.empty + , pgArrayDims = V.empty + , pgArrayParam = param + , pgArrayRes = nullPtr + } + ) + conv -- | Helper function for getting elements of -- 'Array1' / 'CompositeArray1' out of 'PGarray'. -getArray1 :: forall a array t. (PQFormat t, Storable a) - => ([t] -> array) -- ^ Array constructor. - -> PGarray -- ^ Source 'PGarray'. - -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) -- ^ - -- Function that takes an item with a given index - -- out of 'PGresult' and stores it in provided 'Ptr'. - -> IO array -getArray1 con PGarray{..} getItem = flip E.finally (c_PQclear pgArrayRes) $ - if pgArrayNDims > 1 - then E.throwIO ArrayDimensionMismatch { - arrDimExpected = 1 - , arrDimDelivered = fromIntegral pgArrayNDims - } - else do - size <- c_PQntuples pgArrayRes - alloca $ \err -> alloca $ \ptr -> pqFormat0 @t - `BS.unsafeUseAsCString` loop [] (size - 1) err ptr +getArray1 + :: forall a array t + . (PQFormat t, Storable a) + => ([t] -> array) + -- ^ Array constructor. + -> PGarray + -- ^ Source 'PGarray'. + -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) + -- ^ + -- Function that takes an item with a given index + -- out of 'PGresult' and stores it in provided 'Ptr'. + -> IO array +getArray1 con PGarray {..} getItem = + flip E.finally (c_PQclear pgArrayRes) $ + if pgArrayNDims > 1 + then + E.throwIO + ArrayDimensionMismatch + { arrDimExpected = 1 + , arrDimDelivered = fromIntegral pgArrayNDims + } + else do + size <- c_PQntuples pgArrayRes + alloca $ \err -> alloca $ \ptr -> + pqFormat0 @t + `BS.unsafeUseAsCString` loop [] (size - 1) err ptr where loop :: [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array loop acc !i err ptr fmt = case i of -1 -> return . con $ acc - _ -> do + _ -> do item <- getItem pgArrayRes err i ptr fmt `E.catch` rethrowWithArrayError i loop (item : acc) (i - 1) err ptr fmt @@ -171,8 +193,8 @@ instance ToSQL t => ToSQL (Array2 t) where type PQDest (Array2 t) = PGarray toSQL (Array2 arr) pa@(ParamAllocator allocParam) conv = alloca $ \err -> allocParam $ \param -> - putArray2 arr param conv $ \fmt item -> - toSQL item pa (c_PQputf1 param err fmt) + putArray2 arr param conv $ \fmt item -> + toSQL item pa (c_PQputf1 param err fmt) >>= verifyPQTRes err "toSQL (Array2)" ---------------------------------------- @@ -193,74 +215,92 @@ instance CompositeFromSQL t => FromSQL (CompositeArray2 t) where fromSQL Nothing = unexpectedNULL fromSQL (Just arr) = getArray2 CompositeArray2 arr getItem where - getItem res err i (_::Ptr CInt) _ = toComposite <$> fromRow res err 0 i + getItem res err i (_ :: Ptr CInt) _ = toComposite <$> fromRow res err 0 i instance CompositeToSQL t => ToSQL (CompositeArray2 t) where type PQDest (CompositeArray2 t) = PGarray toSQL (CompositeArray2 arr) pa@(ParamAllocator allocParam) conv = alloca $ \err -> allocParam $ \param -> - putArray2 arr param conv $ \fmt item -> - toSQL (Composite item) pa (c_PQputf1 param err fmt) - >>= verifyPQTRes err "toSQL (CompositeArray2)" + putArray2 arr param conv $ \fmt item -> + toSQL (Composite item) pa (c_PQputf1 param err fmt) + >>= verifyPQTRes err "toSQL (CompositeArray2)" ---------------------------------------- -- | Helper function for putting elements of -- 'Array2' / 'CompositeArray2' into 'PGparam'. -putArray2 :: forall t r. PQFormat t - => [[t]] -- ^ List of items to be put. - -> Ptr PGparam -- ^ Inner 'PGparam' to put items into. - -> (Ptr PGarray -> IO r) -- ^ Continuation - -- that puts 'PGarray' into outer 'PGparam'. - -> (CString -> t -> IO ()) -- ^ Function that takes item - -- along with its format and puts it into inner 'PGparam'. - -> IO r +putArray2 + :: forall t r + . PQFormat t + => [[t]] + -- ^ List of items to be put. + -> Ptr PGparam + -- ^ Inner 'PGparam' to put items into. + -> (Ptr PGarray -> IO r) + -- ^ Continuation + -- that puts 'PGarray' into outer 'PGparam'. + -> (CString -> t -> IO ()) + -- ^ Function that takes item + -- along with its format and puts it into inner 'PGparam'. + -> IO r putArray2 arr param conv putItem = do dims <- pqFormat0 @t `BS.unsafeUseAsCString` loop arr 0 0 - putAsPtr (PGarray { - pgArrayNDims = 2 - , pgArrayLBound = V.fromList [1, 1] - , pgArrayDims = dims - , pgArrayParam = param - , pgArrayRes = nullPtr - }) conv + putAsPtr + ( PGarray + { pgArrayNDims = 2 + , pgArrayLBound = V.fromList [1, 1] + , pgArrayDims = dims + , pgArrayParam = param + , pgArrayRes = nullPtr + } + ) + conv where loop :: [[t]] -> CInt -> CInt -> CString -> IO (V.Vector CInt) loop rows !size !innerSize fmt = case rows of - [] -> return . V.fromList $ [size, innerSize] + [] -> return . V.fromList $ [size, innerSize] (row : rest) -> do nextInnerSize <- innLoop row 0 fmt when (size > 0 && innerSize /= nextInnerSize) $ - hpqTypesError $ "putArray2: inner rows have different sizes" + hpqTypesError $ + "putArray2: inner rows have different sizes" loop rest (size + 1) nextInnerSize fmt innLoop :: [t] -> CInt -> CString -> IO CInt innLoop items !size fmt = case items of - [] -> return size + [] -> return size (item : rest) -> do putItem fmt item innLoop rest (size + 1) fmt -- | Helper function for getting elements of -- 'Array2' / 'CompositeArray2' out of 'PGarray'. -getArray2 :: forall a array t. (PQFormat t, Storable a) - => ([[t]] -> array) -- ^ Array constructor. - -> PGarray -- ^ Source 'PGarray'. - -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) -- ^ - -- Function that takes an item with a given index - -- out of 'PGresult' and stores it in provided 'Ptr'. - -> IO array -getArray2 con PGarray{..} getItem = flip E.finally (c_PQclear pgArrayRes) $ do +getArray2 + :: forall a array t + . (PQFormat t, Storable a) + => ([[t]] -> array) + -- ^ Array constructor. + -> PGarray + -- ^ Source 'PGarray'. + -> (Ptr PGresult -> Ptr PGerror -> CInt -> Ptr a -> CString -> IO t) + -- ^ + -- Function that takes an item with a given index + -- out of 'PGresult' and stores it in provided 'Ptr'. + -> IO array +getArray2 con PGarray {..} getItem = flip E.finally (c_PQclear pgArrayRes) $ do if pgArrayNDims /= 0 && pgArrayNDims /= 2 - then E.throwIO ArrayDimensionMismatch { - arrDimExpected = 2 - , arrDimDelivered = fromIntegral pgArrayNDims - } + then + E.throwIO + ArrayDimensionMismatch + { arrDimExpected = 2 + , arrDimDelivered = fromIntegral pgArrayNDims + } else do let dim2 = pgArrayDims V.! 1 size <- c_PQntuples pgArrayRes - alloca $ \ptr -> alloca $ \err -> pqFormat0 @t - `BS.unsafeUseAsCString` loop [] dim2 size err ptr + alloca $ \ptr -> alloca $ \err -> + pqFormat0 @t + `BS.unsafeUseAsCString` loop [] dim2 size err ptr where loop :: [[t]] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array loop acc dim2 !i err ptr fmt = case i of @@ -273,7 +313,7 @@ getArray2 con PGarray{..} getItem = flip E.finally (c_PQclear pgArrayRes) $ do innLoop :: [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t] innLoop acc !i baseIdx err ptr fmt = case i of -1 -> return acc - _ -> do + _ -> do let i' = baseIdx + i item <- getItem pgArrayRes err i' ptr fmt `E.catch` rethrowWithArrayError i' innLoop (item : acc) (i - 1) baseIdx err ptr fmt diff --git a/src/Database/PostgreSQL/PQTypes/Class.hs b/src/Database/PostgreSQL/PQTypes/Class.hs index fe74e26..008170d 100644 --- a/src/Database/PostgreSQL/PQTypes/Class.hs +++ b/src/Database/PostgreSQL/PQTypes/Class.hs @@ -1,6 +1,6 @@ module Database.PostgreSQL.PQTypes.Class - ( QueryName(..) - , MonadDB(..) + ( QueryName (..) + , MonadDB (..) ) where import Control.Monad.Trans @@ -20,11 +20,14 @@ class (Applicative m, Monad m) => MonadDB m where -- a given time. If simultaneous call is made from another thread, it -- will block until currently running 'runQuery' finishes. runQuery :: (HasCallStack, IsSQL sql) => sql -> m Int + -- | Similar to 'runQuery', but it prepares and executes a statement under a -- given name. runPreparedQuery :: (HasCallStack, IsSQL sql) => QueryName -> sql -> m Int + -- | Get last SQL query that was executed. getLastQuery :: m SomeSQL + -- | Subsequent queries in the callback do not alter the result of -- 'getLastQuery'. withFrozenLastQuery :: m a -> m a @@ -34,11 +37,13 @@ class (Applicative m, Monad m) => MonadDB m where -- | Get current query result. getQueryResult :: FromRow row => m (Maybe (QueryResult row)) + -- | Clear current query result. clearQueryResult :: m () -- | Get current transaction settings. getTransactionSettings :: m TransactionSettings + -- | Set transaction settings to supplied ones. Note that it -- won't change any properties of currently running transaction, -- only the subsequent ones. @@ -70,21 +75,24 @@ class (Applicative m, Monad m) => MonadDB m where withNewConnection :: m a -> m a -- | Generic, overlappable instance. -instance {-# OVERLAPPABLE #-} +instance + {-# OVERLAPPABLE #-} ( Applicative (t m) , Monad (t m) , MonadTrans t , MonadTransControl t , MonadDB m - ) => MonadDB (t m) where - runQuery = withFrozenCallStack $ lift . runQuery - runPreparedQuery name = withFrozenCallStack $ lift . runPreparedQuery name - getLastQuery = lift getLastQuery - withFrozenLastQuery m = controlT $ \run -> withFrozenLastQuery (run m) - getConnectionStats = withFrozenCallStack $ lift getConnectionStats - getQueryResult = lift getQueryResult - clearQueryResult = lift clearQueryResult - getTransactionSettings = lift getTransactionSettings - setTransactionSettings = lift . setTransactionSettings - getNotification = lift . getNotification - withNewConnection m = controlT $ \run -> withNewConnection (run m) + ) + => MonadDB (t m) + where + runQuery = withFrozenCallStack $ lift . runQuery + runPreparedQuery name = withFrozenCallStack $ lift . runPreparedQuery name + getLastQuery = lift getLastQuery + withFrozenLastQuery m = controlT $ \run -> withFrozenLastQuery (run m) + getConnectionStats = withFrozenCallStack $ lift getConnectionStats + getQueryResult = lift getQueryResult + clearQueryResult = lift clearQueryResult + getTransactionSettings = lift getTransactionSettings + setTransactionSettings = lift . setTransactionSettings + getNotification = lift . getNotification + withNewConnection m = controlT $ \run -> withNewConnection (run m) diff --git a/src/Database/PostgreSQL/PQTypes/Composite.hs b/src/Database/PostgreSQL/PQTypes/Composite.hs index e664385..c0bd904 100644 --- a/src/Database/PostgreSQL/PQTypes/Composite.hs +++ b/src/Database/PostgreSQL/PQTypes/Composite.hs @@ -1,15 +1,16 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.Composite ( - Composite(..) + +module Database.PostgreSQL.PQTypes.Composite + ( Composite (..) , unComposite , CompositeRow - , CompositeFromSQL(..) - , CompositeToSQL(..) + , CompositeFromSQL (..) + , CompositeToSQL (..) ) where +import Control.Exception qualified as E import Data.Kind (Type) import Foreign.Ptr -import qualified Control.Exception as E import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromRow @@ -53,8 +54,9 @@ instance PQFormat t => PQFormat (Composite t) where instance CompositeFromSQL t => FromSQL (Composite t) where type PQBase (Composite t) = Ptr PGresult fromSQL Nothing = unexpectedNULL - fromSQL (Just res) = Composite - <$> E.finally (toComposite <$> fromRow' res 0 0) (c_PQclear res) + fromSQL (Just res) = + Composite + <$> E.finally (toComposite <$> fromRow' res 0 0) (c_PQclear res) instance CompositeToSQL t => ToSQL (Composite t) where type PQDest (Composite t) = PGparam diff --git a/src/Database/PostgreSQL/PQTypes/Cursor.hs b/src/Database/PostgreSQL/PQTypes/Cursor.hs index 636fda0..116a686 100644 --- a/src/Database/PostgreSQL/PQTypes/Cursor.hs +++ b/src/Database/PostgreSQL/PQTypes/Cursor.hs @@ -1,9 +1,9 @@ module Database.PostgreSQL.PQTypes.Cursor - ( CursorName(..) - , Scroll(..) - , Hold(..) + ( CursorName (..) + , Scroll (..) + , Hold (..) , Cursor - , CursorDirection(..) + , CursorDirection (..) , cursorName , cursorQuery , withCursor @@ -26,7 +26,7 @@ import Database.PostgreSQL.PQTypes.SQL.Class import Database.PostgreSQL.PQTypes.Utils -- | Name of a cursor. -newtype CursorName sql = CursorName { unCursorName :: sql } +newtype CursorName sql = CursorName {unCursorName :: sql} deriving (Eq, Ord) instance IsString sql => IsString (CursorName sql) where @@ -70,22 +70,22 @@ data CursorDirection | CD_Backward_All | CD_Absolute Int | CD_Relative Int - | CD_Forward Int + | CD_Forward Int | CD_Backward Int deriving (Eq, Ord, Show) cursorDirectionToSQL :: (IsString sql, IsSQL sql, Monoid sql) => CursorDirection -> sql cursorDirectionToSQL = \case - CD_Next -> "NEXT" - CD_Prior -> "PRIOR" - CD_First -> "FIRST" - CD_Last -> "LAST" - CD_Forward_All -> "FORWARD ALL" + CD_Next -> "NEXT" + CD_Prior -> "PRIOR" + CD_First -> "FIRST" + CD_Last -> "LAST" + CD_Forward_All -> "FORWARD ALL" CD_Backward_All -> "BACKWARD ALL" - CD_Absolute n -> "ABSOLUTE" <+> unsafeSQL (show n) - CD_Relative n -> "RELATIVE" <+> unsafeSQL (show n) - CD_Forward n -> "FORWARD" <+> unsafeSQL (show n) - CD_Backward n -> "BACKWARD" <+> unsafeSQL (show n) + CD_Absolute n -> "ABSOLUTE" <+> unsafeSQL (show n) + CD_Relative n -> "RELATIVE" <+> unsafeSQL (show n) + CD_Forward n -> "FORWARD" <+> unsafeSQL (show n) + CD_Backward n -> "BACKWARD" <+> unsafeSQL (show n) ---------------------------------------- @@ -106,35 +106,38 @@ withCursor -> sql -> (Cursor sql -> m r) -> m r -withCursor name scroll hold sql k = bracket_ - (runQuery_ declareCursor) - (runQuery_ closeCursor) - (k $ Cursor name sql) +withCursor name scroll hold sql k = + bracket_ + (runQuery_ declareCursor) + (runQuery_ closeCursor) + (k $ Cursor name sql) where - declareCursor = smconcat - [ "DECLARE" - , unCursorName name - , case scroll of - Scroll -> "SCROLL" - NoScroll -> "NO SCROLL" - , "CURSOR" - , case hold of - Hold -> "WITH HOLD" - NoHold -> "WITHOUT HOLD" - , "FOR" - , sql - ] + declareCursor = + smconcat + [ "DECLARE" + , unCursorName name + , case scroll of + Scroll -> "SCROLL" + NoScroll -> "NO SCROLL" + , "CURSOR" + , case hold of + Hold -> "WITH HOLD" + NoHold -> "WITHOUT HOLD" + , "FOR" + , sql + ] -- Because the cursor might potentially be closed within the continuation -- (either by an explicit CLOSE or finishing the current transaction), we -- need to supress a potential 'InvalidCursorName' exception. - closeCursor = smconcat - [ "DO $$" - , "BEGIN" - , " EXECUTE 'CLOSE" <+> unCursorName name <+> "';" - , "EXCEPTION WHEN invalid_cursor_name THEN" - , "END $$" - ] + closeCursor = + smconcat + [ "DO $$" + , "BEGIN" + , " EXECUTE 'CLOSE" <+> unCursorName name <+> "';" + , "EXCEPTION WHEN invalid_cursor_name THEN" + , "END $$" + ] -- | Version of 'withCursor' without the @sql@ type parameter for convenience. withCursorSQL @@ -154,16 +157,19 @@ cursorFetch => Cursor sql -> CursorDirection -> m Int -cursorFetch cursor direction = runQuery $ smconcat - [ "FETCH" - , cursorDirectionToSQL direction - , "FROM" - , unCursorName $ cursorName cursor - ] +cursorFetch cursor direction = + runQuery $ + smconcat + [ "FETCH" + , cursorDirectionToSQL direction + , "FROM" + , unCursorName $ cursorName cursor + ] -- | Same as 'cursorFetch', except the result (i.e. the number of fetched rows) -- is ignored. -cursorFetch_ :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m) +cursorFetch_ + :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m) => Cursor sql -> CursorDirection -> m () @@ -177,12 +183,14 @@ cursorMove => Cursor sql -> CursorDirection -> m Int -cursorMove cursor direction = runQuery $ smconcat - [ "MOVE" - , cursorDirectionToSQL direction - , "FROM" - , unCursorName $ cursorName cursor - ] +cursorMove cursor direction = + runQuery $ + smconcat + [ "MOVE" + , cursorDirectionToSQL direction + , "FROM" + , unCursorName $ cursorName cursor + ] -- | Same as 'cursorMove', except the result (i.e. the number of rows that would -- be fetched) is ignored. diff --git a/src/Database/PostgreSQL/PQTypes/Fold.hs b/src/Database/PostgreSQL/PQTypes/Fold.hs index 068b63a..6451a5d 100644 --- a/src/Database/PostgreSQL/PQTypes/Fold.hs +++ b/src/Database/PostgreSQL/PQTypes/Fold.hs @@ -1,5 +1,5 @@ -module Database.PostgreSQL.PQTypes.Fold ( - queryResult +module Database.PostgreSQL.PQTypes.Fold + ( queryResult , foldrDB , foldlDB , mapDB_ @@ -21,8 +21,10 @@ import Database.PostgreSQL.PQTypes.Utils queryResult :: (HasCallStack, MonadDB m, MonadThrow m, FromRow row) => m (QueryResult row) -queryResult = withFrozenCallStack $ getQueryResult - >>= maybe (throwDB . HPQTypesError $ "queryResult: no query result") return +queryResult = + withFrozenCallStack $ + getQueryResult + >>= maybe (throwDB . HPQTypesError $ "queryResult: no query result") return ---------------------------------------- @@ -32,8 +34,10 @@ foldrDB => (row -> acc -> m acc) -> acc -> m acc -foldrDB f acc = withFrozenCallStack $ getQueryResult - >>= maybe (return acc) (foldrImpl False f acc) +foldrDB f acc = + withFrozenCallStack $ + getQueryResult + >>= maybe (return acc) (foldrImpl False f acc) -- | Fetcher of rows returned by a query as a monadic left fold. foldlDB @@ -41,16 +45,20 @@ foldlDB => (acc -> row -> m acc) -> acc -> m acc -foldlDB f acc = withFrozenCallStack $ getQueryResult - >>= maybe (return acc) (foldlImpl False f acc) +foldlDB f acc = + withFrozenCallStack $ + getQueryResult + >>= maybe (return acc) (foldlImpl False f acc) -- | Fetcher of rows returned by a query as a monadic map. mapDB_ :: (HasCallStack, MonadDB m, FromRow row) => (row -> m r) -> m () -mapDB_ f = withFrozenCallStack $ getQueryResult - >>= maybe (return ()) (foldlImpl False (\() row -> () <$ f row) ()) +mapDB_ f = + withFrozenCallStack $ + getQueryResult + >>= maybe (return ()) (foldlImpl False (\() row -> () <$ f row) ()) ---------------------------------------- @@ -70,10 +78,12 @@ fetchMaybe f = withFrozenCallStack $ do Just qr -> fst <$> foldlDB go (Nothing, f <$> qr) where go (Nothing, qr) row = return (Just $ f row, qr) - go (Just _, qr) _ = throwDB AffectedRowsMismatch { - rowsExpected = [(0, 1)] - , rowsDelivered = ntuples qr - } + go (Just _, qr) _ = + throwDB + AffectedRowsMismatch + { rowsExpected = [(0, 1)] + , rowsDelivered = ntuples qr + } -- | Specialization of 'fetchMaybe' that fetches exactly one row. If -- no row is delivered, 'AffectedRowsMismatch' exception is thrown. @@ -81,8 +91,10 @@ fetchOne :: (HasCallStack, MonadDB m, MonadThrow m, FromRow row) => (row -> t) - fetchOne f = withFrozenCallStack $ do mt <- fetchMaybe f case mt of - Just t -> return t - Nothing -> throwDB AffectedRowsMismatch { - rowsExpected = [(1, 1)] - , rowsDelivered = 0 - } + Just t -> return t + Nothing -> + throwDB + AffectedRowsMismatch + { rowsExpected = [(1, 1)] + , rowsDelivered = 0 + } diff --git a/src/Database/PostgreSQL/PQTypes/Format.hs b/src/Database/PostgreSQL/PQTypes/Format.hs index f8145f5..6202728 100644 --- a/src/Database/PostgreSQL/PQTypes/Format.hs +++ b/src/Database/PostgreSQL/PQTypes/Format.hs @@ -1,23 +1,24 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.Format ( - PQFormat(..) +{-# LANGUAGE TypeApplications #-} + +module Database.PostgreSQL.PQTypes.Format + ( PQFormat (..) , pqFormatP , pqFormat0P , pqVariablesP - , (:*:)(..) + , (:*:) (..) ) where +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Functor.Identity import Data.Int import Data.Proxy +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL import Data.Time -import Data.Word import Data.UUID.Types -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL +import Data.Word ---------------------------------------- @@ -40,13 +41,13 @@ class PQFormat t where -- Helpers that are parametrised by a 'Proxy t' instead of 't'. -pqFormatP :: forall t . PQFormat t => Proxy t -> BS.ByteString -pqFormatP _ = pqFormat @t +pqFormatP :: forall t. PQFormat t => Proxy t -> BS.ByteString +pqFormatP _ = pqFormat @t -pqFormat0P :: forall t . PQFormat t => Proxy t -> BS.ByteString -pqFormat0P _ = pqFormat0 @t +pqFormat0P :: forall t. PQFormat t => Proxy t -> BS.ByteString +pqFormat0P _ = pqFormat0 @t -pqVariablesP :: forall t . PQFormat t => Proxy t -> Int +pqVariablesP :: forall t. PQFormat t => Proxy t -> Int pqVariablesP _ = pqVariables @t -- CARTESIAN PRODUCT @@ -56,13 +57,13 @@ data a :*: b = a :*: b deriving (Eq, Ord, Show) instance (PQFormat t1, PQFormat t2) => PQFormat (t1 :*: t2) where - pqFormat = pqFormat @t1 `BS.append` pqFormat @t2 + pqFormat = pqFormat @t1 `BS.append` pqFormat @t2 pqVariables = pqVariables @t1 + pqVariables @t2 -- NULLables instance PQFormat t => PQFormat (Maybe t) where - pqFormat = pqFormat @t + pqFormat = pqFormat @t pqVariables = pqVariables @t -- NUMERICS @@ -145,42 +146,44 @@ instance PQFormat Bool where -- TUPLES +{- FOURMOLU_DISABLE -} + instance PQFormat () where pqFormat = BS.empty pqVariables = 0 -instance ( - PQFormat t +instance + ( PQFormat t ) => PQFormat (Identity t) where pqFormat = pqFormat @t pqVariables = 1 -instance ( - PQFormat t1, PQFormat t2 +instance + ( PQFormat t1, PQFormat t2 ) => PQFormat (t1, t2) where pqFormat = BS.concat [ pqFormat @t1, pqFormat @t2 ] pqVariables = 2 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3 ) => PQFormat (t1, t2, t3) where pqFormat = BS.concat [ pqFormat @t1, pqFormat @t2, pqFormat @t3 ] pqVariables = 3 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4 ) => PQFormat (t1, t2, t3, t4) where pqFormat = BS.concat [ pqFormat @t1, pqFormat @t2, pqFormat @t3, pqFormat @t4 ] pqVariables = 4 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5 ) => PQFormat (t1, t2, t3, t4, t5) where pqFormat = BS.concat [ pqFormat @t1, pqFormat @t2, pqFormat @t3, pqFormat @t4 @@ -188,8 +191,8 @@ instance ( ] pqVariables = 5 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 ) => PQFormat (t1, t2, t3, t4, t5, t6) where pqFormat = BS.concat [ pqFormat @t1, pqFormat @t2, pqFormat @t3, pqFormat @t4 @@ -197,8 +200,8 @@ instance ( ] pqVariables = 6 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7) where pqFormat = BS.concat [ @@ -207,8 +210,8 @@ instance ( ] pqVariables = 7 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8) where pqFormat = BS.concat [ @@ -217,8 +220,8 @@ instance ( ] pqVariables = 8 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9) where pqFormat = BS.concat [ @@ -228,8 +231,8 @@ instance ( ] pqVariables = 9 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) where pqFormat = BS.concat [ @@ -239,8 +242,8 @@ instance ( ] pqVariables = 10 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11) where pqFormat = BS.concat [ @@ -250,8 +253,8 @@ instance ( ] pqVariables = 11 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12) where pqFormat = BS.concat [ @@ -261,8 +264,8 @@ instance ( ] pqVariables = 12 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13) where @@ -274,8 +277,8 @@ instance ( ] pqVariables = 13 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14) where @@ -287,8 +290,8 @@ instance ( ] pqVariables = 14 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15) where @@ -300,8 +303,8 @@ instance ( ] pqVariables = 15 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16) where @@ -313,8 +316,8 @@ instance ( ] pqVariables = 16 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17) where @@ -327,8 +330,8 @@ instance ( ] pqVariables = 17 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 ) => PQFormat (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18) where @@ -341,8 +344,8 @@ instance ( ] pqVariables = 18 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19 @@ -356,8 +359,8 @@ instance ( ] pqVariables = 19 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20 @@ -371,8 +374,8 @@ instance ( ] pqVariables = 20 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21 @@ -387,8 +390,8 @@ instance ( ] pqVariables = 21 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22 @@ -403,8 +406,8 @@ instance ( ] pqVariables = 22 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23 @@ -419,8 +422,8 @@ instance ( ] pqVariables = 23 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -435,8 +438,8 @@ instance ( ] pqVariables = 24 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -453,8 +456,8 @@ instance ( ] pqVariables = 25 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -471,8 +474,8 @@ instance ( ] pqVariables = 26 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -489,8 +492,8 @@ instance ( ] pqVariables = 27 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -507,8 +510,8 @@ instance ( ] pqVariables = 28 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -526,8 +529,8 @@ instance ( ] pqVariables = 29 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -545,8 +548,8 @@ instance ( ] pqVariables = 30 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -565,8 +568,8 @@ instance ( ] pqVariables = 31 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -585,8 +588,8 @@ instance ( ] pqVariables = 32 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -606,8 +609,8 @@ instance ( ] pqVariables = 33 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -627,8 +630,8 @@ instance ( ] pqVariables = 34 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -648,8 +651,8 @@ instance ( ] pqVariables = 35 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -669,8 +672,8 @@ instance ( ] pqVariables = 36 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -692,8 +695,8 @@ instance ( ] pqVariables = 37 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -715,8 +718,8 @@ instance ( ] pqVariables = 38 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -738,8 +741,8 @@ instance ( ] pqVariables = 39 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -761,8 +764,8 @@ instance ( ] pqVariables = 40 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -785,8 +788,8 @@ instance ( ] pqVariables = 41 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -809,8 +812,8 @@ instance ( ] pqVariables = 42 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -834,8 +837,8 @@ instance ( ] pqVariables = 43 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -859,8 +862,8 @@ instance ( ] pqVariables = 44 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -885,8 +888,8 @@ instance ( ] pqVariables = 45 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -911,8 +914,8 @@ instance ( ] pqVariables = 46 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -937,8 +940,8 @@ instance ( ] pqVariables = 47 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -963,8 +966,8 @@ instance ( ] pqVariables = 48 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 @@ -991,8 +994,8 @@ instance ( ] pqVariables = 49 -instance ( - PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 +instance + ( PQFormat t1, PQFormat t2, PQFormat t3, PQFormat t4, PQFormat t5, PQFormat t6 , PQFormat t7, PQFormat t8, PQFormat t9, PQFormat t10, PQFormat t11, PQFormat t12 , PQFormat t13, PQFormat t14, PQFormat t15, PQFormat t16, PQFormat t17, PQFormat t18 , PQFormat t19, PQFormat t20, PQFormat t21, PQFormat t22, PQFormat t23, PQFormat t24 diff --git a/src/Database/PostgreSQL/PQTypes/FromRow.hs b/src/Database/PostgreSQL/PQTypes/FromRow.hs index cbb223f..004bf7c 100644 --- a/src/Database/PostgreSQL/PQTypes/FromRow.hs +++ b/src/Database/PostgreSQL/PQTypes/FromRow.hs @@ -1,16 +1,17 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.FromRow ( - FromRow(..) + +module Database.PostgreSQL.PQTypes.FromRow + ( FromRow (..) , fromRow' ) where +import Control.Exception qualified as E +import Data.ByteString.Unsafe qualified as BS import Data.Functor.Identity import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import qualified Control.Exception as E -import qualified Data.ByteString.Unsafe as BS import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromSQL @@ -30,12 +31,13 @@ convert res tuple column base = do rethrowWithConvError :: E.SomeException -> IO a rethrowWithConvError (E.SomeException e) = do colname <- safePeekCString' =<< c_PQfname res column - E.throwIO ConversionError { - convColumn = fromIntegral column + 1 - , convColumnName = colname - , convRow = fromIntegral tuple + 1 - , convError = e - } + E.throwIO + ConversionError + { convColumn = fromIntegral column + 1 + , convColumnName = colname + , convRow = fromIntegral tuple + 1 + , convError = e + } -- | 'verifyPQTRes' specialized for usage in 'fromRow'. verify :: Ptr PGerror -> CInt -> IO () @@ -53,14 +55,21 @@ fromRow' res b i = alloca $ \err -> fromRow res err b i -- | Class which represents \"from SQL row to Haskell tuple\" transformation. class PQFormat row => FromRow row where -- | Extract SQL row from 'PGresult' and convert it into a tuple. - fromRow :: Ptr PGresult -- ^ Source result. - -> Ptr PGerror -- ^ Local error info. - -> CInt -- ^ Base position for c_PQgetf. - -> CInt -- ^ Index of row to be extracted. - -> IO row + fromRow + :: Ptr PGresult + -- ^ Source result. + -> Ptr PGerror + -- ^ Local error info. + -> CInt + -- ^ Base position for c_PQgetf. + -> CInt + -- ^ Index of row to be extracted. + -> IO row + +{- FOURMOLU_DISABLE -} -instance ( - FromRow row1, FromRow row2 +instance + ( FromRow row1, FromRow row2 ) => FromRow (row1 :*: row2) where fromRow res err b i = (:*:) <$> fromRow res err b i @@ -77,8 +86,8 @@ instance FromSQL t => FromRow (Identity t) where t <- peek p1 >>= convert res i b return (Identity t) -instance ( - FromSQL t1, FromSQL t2 +instance + ( FromSQL t1, FromSQL t2 ) => FromRow (t1, t2) where fromRow res err b i = withFormat $ \fmt -> alloca $ \p0 -> alloca $ \p1 -> do @@ -86,8 +95,8 @@ instance ( (,) <$> (peek p0 >>= convert res i b) <*> (peek p1 >>= convert res i (b+1)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3 ) => FromRow (t1, t2, t3) where fromRow res err b i = withFormat $ \fmt -> alloca $ \p0 -> alloca $ \p1 -> alloca $ \p2 -> do @@ -96,8 +105,8 @@ instance ( <$> (peek p0 >>= convert res i b) <*> (peek p1 >>= convert res i (b+1)) <*> (peek p2 >>= convert res i (b+2)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4 ) => FromRow (t1, t2, t3, t4) where fromRow res err b i = withFormat $ \fmt -> alloca $ \p0 -> alloca $ \p1 -> alloca $ \p2 -> alloca $ \p3 -> do @@ -106,8 +115,8 @@ instance ( <$> (peek p0 >>= convert res i b) <*> (peek p1 >>= convert res i (b+1)) <*> (peek p2 >>= convert res i (b+2)) <*> (peek p3 >>= convert res i (b+3)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5 ) => FromRow (t1, t2, t3, t4, t5) where fromRow res err b i = withFormat $ \fmt -> alloca $ \p0 -> alloca $ \p1 -> alloca $ \p2 -> alloca $ \p3 -> alloca $ \p4 -> do @@ -117,8 +126,8 @@ instance ( <*> (peek p2 >>= convert res i (b+2)) <*> (peek p3 >>= convert res i (b+3)) <*> (peek p4 >>= convert res i (b+4)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 ) => FromRow (t1, t2, t3, t4, t5, t6) where fromRow res err b i = withFormat $ \fmt -> alloca $ \p0 -> alloca $ \p1 -> alloca $ \p2 -> alloca $ \p3 -> alloca $ \p4 -> @@ -129,8 +138,8 @@ instance ( <*> (peek p2 >>= convert res i (b+2)) <*> (peek p3 >>= convert res i (b+3)) <*> (peek p4 >>= convert res i (b+4)) <*> (peek p5 >>= convert res i (b+5)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7 ) => FromRow (t1, t2, t3, t4, t5, t6, t7) where fromRow res err b i = withFormat $ \fmt -> @@ -143,8 +152,8 @@ instance ( <*> (peek p4 >>= convert res i (b+4)) <*> (peek p5 >>= convert res i (b+5)) <*> (peek p6 >>= convert res i (b+6)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8) where fromRow res err b i = withFormat $ \fmt -> @@ -157,8 +166,8 @@ instance ( <*> (peek p4 >>= convert res i (b+4)) <*> (peek p5 >>= convert res i (b+5)) <*> (peek p6 >>= convert res i (b+6)) <*> (peek p7 >>= convert res i (b+7)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9) where fromRow res err b i = withFormat $ \fmt -> @@ -172,8 +181,8 @@ instance ( <*> (peek p6 >>= convert res i (b+6)) <*> (peek p7 >>= convert res i (b+7)) <*> (peek p8 >>= convert res i (b+8)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) where fromRow res err b i = withFormat $ \fmt -> @@ -187,8 +196,8 @@ instance ( <*> (peek p6 >>= convert res i (b+6)) <*> (peek p7 >>= convert res i (b+7)) <*> (peek p8 >>= convert res i (b+8)) <*> (peek p9 >>= convert res i (b+9)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11) where fromRow res err b i = withFormat $ \fmt -> @@ -204,8 +213,8 @@ instance ( <*> (peek p8 >>= convert res i (b+8)) <*> (peek p9 >>= convert res i (b+9)) <*> (peek p10 >>= convert res i (b+10)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12) where fromRow res err b i = withFormat $ \fmt -> @@ -221,8 +230,8 @@ instance ( <*> (peek p8 >>= convert res i (b+8)) <*> (peek p9 >>= convert res i (b+9)) <*> (peek p10 >>= convert res i (b+10)) <*> (peek p11 >>= convert res i (b+11)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13) where @@ -240,8 +249,8 @@ instance ( <*> (peek p10 >>= convert res i (b+10)) <*> (peek p11 >>= convert res i (b+11)) <*> (peek p12 >>= convert res i (b+12)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14) where @@ -259,8 +268,8 @@ instance ( <*> (peek p10 >>= convert res i (b+10)) <*> (peek p11 >>= convert res i (b+11)) <*> (peek p12 >>= convert res i (b+12)) <*> (peek p13 >>= convert res i (b+13)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15) where @@ -279,8 +288,8 @@ instance ( <*> (peek p12 >>= convert res i (b+12)) <*> (peek p13 >>= convert res i (b+13)) <*> (peek p14 >>= convert res i (b+14)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16) where @@ -300,8 +309,8 @@ instance ( <*> (peek p12 >>= convert res i (b+12)) <*> (peek p13 >>= convert res i (b+13)) <*> (peek p14 >>= convert res i (b+14)) <*> (peek p15 >>= convert res i (b+15)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17) where @@ -322,8 +331,8 @@ instance ( <*> (peek p14 >>= convert res i (b+14)) <*> (peek p15 >>= convert res i (b+15)) <*> (peek p16 >>= convert res i (b+16)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 ) => FromRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18) where @@ -344,8 +353,8 @@ instance ( <*> (peek p14 >>= convert res i (b+14)) <*> (peek p15 >>= convert res i (b+15)) <*> (peek p16 >>= convert res i (b+16)) <*> (peek p17 >>= convert res i (b+17)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19 @@ -368,8 +377,8 @@ instance ( <*> (peek p16 >>= convert res i (b+16)) <*> (peek p17 >>= convert res i (b+17)) <*> (peek p18 >>= convert res i (b+18)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20 @@ -392,8 +401,8 @@ instance ( <*> (peek p16 >>= convert res i (b+16)) <*> (peek p17 >>= convert res i (b+17)) <*> (peek p18 >>= convert res i (b+18)) <*> (peek p19 >>= convert res i (b+19)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21 @@ -418,8 +427,8 @@ instance ( <*> (peek p18 >>= convert res i (b+18)) <*> (peek p19 >>= convert res i (b+19)) <*> (peek p20 >>= convert res i (b+20)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22 @@ -444,8 +453,8 @@ instance ( <*> (peek p18 >>= convert res i (b+18)) <*> (peek p19 >>= convert res i (b+19)) <*> (peek p20 >>= convert res i (b+20)) <*> (peek p21 >>= convert res i (b+21)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23 @@ -471,8 +480,8 @@ instance ( <*> (peek p20 >>= convert res i (b+20)) <*> (peek p21 >>= convert res i (b+21)) <*> (peek p22 >>= convert res i (b+22)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -498,8 +507,8 @@ instance ( <*> (peek p20 >>= convert res i (b+20)) <*> (peek p21 >>= convert res i (b+21)) <*> (peek p22 >>= convert res i (b+22)) <*> (peek p23 >>= convert res i (b+23)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -527,8 +536,8 @@ instance ( <*> (peek p22 >>= convert res i (b+22)) <*> (peek p23 >>= convert res i (b+23)) <*> (peek p24 >>= convert res i (b+24)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -557,8 +566,8 @@ instance ( <*> (peek p22 >>= convert res i (b+22)) <*> (peek p23 >>= convert res i (b+23)) <*> (peek p24 >>= convert res i (b+24)) <*> (peek p25 >>= convert res i (b+25)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -588,8 +597,8 @@ instance ( <*> (peek p24 >>= convert res i (b+24)) <*> (peek p25 >>= convert res i (b+25)) <*> (peek p26 >>= convert res i (b+26)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -619,8 +628,8 @@ instance ( <*> (peek p24 >>= convert res i (b+24)) <*> (peek p25 >>= convert res i (b+25)) <*> (peek p26 >>= convert res i (b+26)) <*> (peek p27 >>= convert res i (b+27)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -651,8 +660,8 @@ instance ( <*> (peek p26 >>= convert res i (b+26)) <*> (peek p27 >>= convert res i (b+27)) <*> (peek p28 >>= convert res i (b+28)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -683,8 +692,8 @@ instance ( <*> (peek p26 >>= convert res i (b+26)) <*> (peek p27 >>= convert res i (b+27)) <*> (peek p28 >>= convert res i (b+28)) <*> (peek p29 >>= convert res i (b+29)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -718,8 +727,8 @@ instance ( <*> (peek p28 >>= convert res i (b+28)) <*> (peek p29 >>= convert res i (b+29)) <*> (peek p30 >>= convert res i (b+30)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -753,8 +762,8 @@ instance ( <*> (peek p28 >>= convert res i (b+28)) <*> (peek p29 >>= convert res i (b+29)) <*> (peek p30 >>= convert res i (b+30)) <*> (peek p31 >>= convert res i (b+31)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -789,8 +798,8 @@ instance ( <*> (peek p30 >>= convert res i (b+30)) <*> (peek p31 >>= convert res i (b+31)) <*> (peek p32 >>= convert res i (b+32)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -825,8 +834,8 @@ instance ( <*> (peek p30 >>= convert res i (b+30)) <*> (peek p31 >>= convert res i (b+31)) <*> (peek p32 >>= convert res i (b+32)) <*> (peek p33 >>= convert res i (b+33)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -862,8 +871,8 @@ instance ( <*> (peek p32 >>= convert res i (b+32)) <*> (peek p33 >>= convert res i (b+33)) <*> (peek p34 >>= convert res i (b+34)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -900,8 +909,8 @@ instance ( <*> (peek p32 >>= convert res i (b+32)) <*> (peek p33 >>= convert res i (b+33)) <*> (peek p34 >>= convert res i (b+34)) <*> (peek p35 >>= convert res i (b+35)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -940,8 +949,8 @@ instance ( <*> (peek p34 >>= convert res i (b+34)) <*> (peek p35 >>= convert res i (b+35)) <*> (peek p36 >>= convert res i (b+36)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -980,8 +989,8 @@ instance ( <*> (peek p34 >>= convert res i (b+34)) <*> (peek p35 >>= convert res i (b+35)) <*> (peek p36 >>= convert res i (b+36)) <*> (peek p37 >>= convert res i (b+37)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1021,8 +1030,8 @@ instance ( <*> (peek p36 >>= convert res i (b+36)) <*> (peek p37 >>= convert res i (b+37)) <*> (peek p38 >>= convert res i (b+38)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1062,8 +1071,8 @@ instance ( <*> (peek p36 >>= convert res i (b+36)) <*> (peek p37 >>= convert res i (b+37)) <*> (peek p38 >>= convert res i (b+38)) <*> (peek p39 >>= convert res i (b+39)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1105,8 +1114,8 @@ instance ( <*> (peek p38 >>= convert res i (b+38)) <*> (peek p39 >>= convert res i (b+39)) <*> (peek p40 >>= convert res i (b+40)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1148,8 +1157,8 @@ instance ( <*> (peek p38 >>= convert res i (b+38)) <*> (peek p39 >>= convert res i (b+39)) <*> (peek p40 >>= convert res i (b+40)) <*> (peek p41 >>= convert res i (b+41)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1193,8 +1202,8 @@ instance ( <*> (peek p40 >>= convert res i (b+40)) <*> (peek p41 >>= convert res i (b+41)) <*> (peek p42 >>= convert res i (b+42)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1238,8 +1247,8 @@ instance ( <*> (peek p40 >>= convert res i (b+40)) <*> (peek p41 >>= convert res i (b+41)) <*> (peek p42 >>= convert res i (b+42)) <*> (peek p43 >>= convert res i (b+43)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1284,8 +1293,8 @@ instance ( <*> (peek p42 >>= convert res i (b+42)) <*> (peek p43 >>= convert res i (b+43)) <*> (peek p44 >>= convert res i (b+44)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1331,8 +1340,8 @@ instance ( <*> (peek p42 >>= convert res i (b+42)) <*> (peek p43 >>= convert res i (b+43)) <*> (peek p44 >>= convert res i (b+44)) <*> (peek p45 >>= convert res i (b+45)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1379,8 +1388,8 @@ instance ( <*> (peek p44 >>= convert res i (b+44)) <*> (peek p45 >>= convert res i (b+45)) <*> (peek p46 >>= convert res i (b+46)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1427,8 +1436,8 @@ instance ( <*> (peek p44 >>= convert res i (b+44)) <*> (peek p45 >>= convert res i (b+45)) <*> (peek p46 >>= convert res i (b+46)) <*> (peek p47 >>= convert res i (b+47)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 @@ -1477,8 +1486,8 @@ instance ( <*> (peek p46 >>= convert res i (b+46)) <*> (peek p47 >>= convert res i (b+47)) <*> (peek p48 >>= convert res i (b+48)) -instance ( - FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 +instance + ( FromSQL t1, FromSQL t2, FromSQL t3, FromSQL t4, FromSQL t5, FromSQL t6 , FromSQL t7, FromSQL t8, FromSQL t9, FromSQL t10, FromSQL t11, FromSQL t12 , FromSQL t13, FromSQL t14, FromSQL t15, FromSQL t16, FromSQL t17, FromSQL t18 , FromSQL t19, FromSQL t20, FromSQL t21, FromSQL t22, FromSQL t23, FromSQL t24 diff --git a/src/Database/PostgreSQL/PQTypes/FromSQL.hs b/src/Database/PostgreSQL/PQTypes/FromSQL.hs index 1b7f882..bd1f94b 100644 --- a/src/Database/PostgreSQL/PQTypes/FromSQL.hs +++ b/src/Database/PostgreSQL/PQTypes/FromSQL.hs @@ -1,21 +1,21 @@ -module Database.PostgreSQL.PQTypes.FromSQL ( - FromSQL(..) +module Database.PostgreSQL.PQTypes.FromSQL + ( FromSQL (..) ) where +import Control.Exception qualified as E +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy.Char8 qualified as BSL import Data.Int import Data.Kind (Type) import Data.Ratio +import Data.Text qualified as T import Data.Text.Encoding +import Data.Text.Lazy qualified as TL import Data.Time +import Data.UUID.Types qualified as U import Data.Word import Foreign.C import Foreign.Storable -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.UUID.Types as U import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.Internal.C.Types @@ -26,16 +26,19 @@ import Database.PostgreSQL.PQTypes.Internal.Utils class (PQFormat t, Storable (PQBase t)) => FromSQL t where -- | Base type (used by libpqtypes). type PQBase t :: Type + -- | Convert value of base type to target one. - fromSQL :: Maybe (PQBase t) -- ^ base value (Nothing if NULL was delivered) - -> IO t + fromSQL + :: Maybe (PQBase t) + -- ^ base value (Nothing if NULL was delivered) + -> IO t -- NULLables instance FromSQL t => FromSQL (Maybe t) where type PQBase (Maybe t) = PQBase t fromSQL mbase = case mbase of - Just _ -> Just <$> fromSQL mbase + Just _ -> Just <$> fromSQL mbase Nothing -> return Nothing -- NUMERICS @@ -132,7 +135,7 @@ instance FromSQL TimeOfDay where instance FromSQL LocalTime where type PQBase LocalTime = PGtimestamp fromSQL Nothing = unexpectedNULL - fromSQL (Just PGtimestamp{..}) = return $ LocalTime day tod + fromSQL (Just PGtimestamp {..}) = return $ LocalTime day tod where day = pgDateToDay pgTimestampDate tod = pgTimeToTimeOfDay pgTimestampTime @@ -145,7 +148,7 @@ instance FromSQL LocalTime where instance FromSQL UTCTime where type PQBase UTCTime = PGtimestamp fromSQL Nothing = unexpectedNULL - fromSQL jts@(Just PGtimestamp{..}) = do + fromSQL jts@(Just PGtimestamp {..}) = do localTime <- fromSQL jts case rest of 0 -> return . localTimeToUTC (minutesToTimeZone mins) $ localTime @@ -167,12 +170,12 @@ instance FromSQL Bool where -- | Convert PGtime to Day. pgDateToDay :: PGdate -> Day -pgDateToDay PGdate{..} = fromGregorian year mon mday +pgDateToDay PGdate {..} = fromGregorian year mon mday where year = adjustBC $ fromIntegral pgDateYear -- Note: libpqtypes represents months as numbers in range -- [0, 11], whereas Haskell uses [1, 12], hence plus one. - mon = fromIntegral $ pgDateMon + 1 + mon = fromIntegral $ pgDateMon + 1 mday = fromIntegral pgDateMDay -- Note: PostgreSQL has no notion of '0th year', it's 1 AD -- and then before that 1 BC for it. Since Haskell represents @@ -183,9 +186,9 @@ pgDateToDay PGdate{..} = fromGregorian year mon mday -- | Convert PGtime to TimeOfDay. pgTimeToTimeOfDay :: PGtime -> TimeOfDay -pgTimeToTimeOfDay PGtime{..} = TimeOfDay hour mins $ sec + fromRational (usec % 1000000) +pgTimeToTimeOfDay PGtime {..} = TimeOfDay hour mins $ sec + fromRational (usec % 1000000) where hour = fromIntegral pgTimeHour mins = fromIntegral pgTimeMin - sec = fromIntegral pgTimeSec + sec = fromIntegral pgTimeSec usec = fromIntegral pgTimeUSec diff --git a/src/Database/PostgreSQL/PQTypes/Internal/C/Get.hs b/src/Database/PostgreSQL/PQTypes/Internal/C/Get.hs index 2b95294..0fc57b1 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/C/Get.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/C/Get.hs @@ -12,537 +12,2951 @@ import Database.PostgreSQL.PQTypes.Internal.C.Types -- See https://www.haskell.org/ghc/blog/20210709-capi-usage.html. foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf1 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 - -> IO CInt + c_PQgetf1 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf2 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 - -> IO CInt + c_PQgetf2 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf3 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 - -> IO CInt + c_PQgetf3 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf4 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> IO CInt + c_PQgetf4 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf5 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 - -> IO CInt + c_PQgetf5 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf6 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 - -> IO CInt + c_PQgetf6 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf7 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 - -> IO CInt + c_PQgetf7 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf8 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> IO CInt + c_PQgetf8 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf9 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> IO CInt + c_PQgetf9 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf10 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 - -> IO CInt + c_PQgetf10 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf11 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 - -> IO CInt + c_PQgetf11 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf12 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> IO CInt + c_PQgetf12 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf13 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> IO CInt + c_PQgetf13 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf14 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 - -> IO CInt + c_PQgetf14 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf15 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 - -> IO CInt + c_PQgetf15 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf16 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> IO CInt + c_PQgetf16 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf17 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 - -> IO CInt + c_PQgetf17 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf18 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf19 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf20 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf21 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf22 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf23 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf24 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf25 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf26 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf27 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf28 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf29 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf30 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf31 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf32 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf33 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf34 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf35 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf36 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf37 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf38 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf39 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf40 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf41 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf42 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf43 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf44 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf45 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf46 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 -> CInt -> Ptr t46 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf47 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 -> CInt -> Ptr t46 -> CInt -> Ptr t47 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf48 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 -> CInt -> Ptr t46 -> CInt -> Ptr t47 -> CInt -> Ptr t48 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf49 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 -> CInt -> Ptr t46 -> CInt -> Ptr t47 -> CInt -> Ptr t48 - -> CInt -> Ptr t49 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQgetf" - c_PQgetf50 :: Ptr PGresult -> Ptr PGerror -> CInt -> CString - -> CInt -> Ptr t1 -> CInt -> Ptr t2 -> CInt -> Ptr t3 -> CInt -> Ptr t4 - -> CInt -> Ptr t5 -> CInt -> Ptr t6 -> CInt -> Ptr t7 -> CInt -> Ptr t8 - -> CInt -> Ptr t9 -> CInt -> Ptr t10 -> CInt -> Ptr t11 -> CInt -> Ptr t12 - -> CInt -> Ptr t13 -> CInt -> Ptr t14 -> CInt -> Ptr t15 -> CInt -> Ptr t16 - -> CInt -> Ptr t17 -> CInt -> Ptr t18 -> CInt -> Ptr t19 -> CInt -> Ptr t20 - -> CInt -> Ptr t21 -> CInt -> Ptr t22 -> CInt -> Ptr t23 -> CInt -> Ptr t24 - -> CInt -> Ptr t25 -> CInt -> Ptr t26 -> CInt -> Ptr t27 -> CInt -> Ptr t28 - -> CInt -> Ptr t29 -> CInt -> Ptr t30 -> CInt -> Ptr t31 -> CInt -> Ptr t32 - -> CInt -> Ptr t33 -> CInt -> Ptr t34 -> CInt -> Ptr t35 -> CInt -> Ptr t36 - -> CInt -> Ptr t37 -> CInt -> Ptr t38 -> CInt -> Ptr t39 -> CInt -> Ptr t40 - -> CInt -> Ptr t41 -> CInt -> Ptr t42 -> CInt -> Ptr t43 -> CInt -> Ptr t44 - -> CInt -> Ptr t45 -> CInt -> Ptr t46 -> CInt -> Ptr t47 -> CInt -> Ptr t48 - -> CInt -> Ptr t49 -> CInt -> Ptr t50 - -> IO CInt + c_PQgetf18 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf19 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf20 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf21 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf22 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf23 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf24 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf25 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf26 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf27 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf28 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf29 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf30 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf31 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf32 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf33 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf34 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf35 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf36 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf37 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf38 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf39 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf40 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf41 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf42 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf43 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf44 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf45 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf46 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> CInt + -> Ptr t46 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf47 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> CInt + -> Ptr t46 + -> CInt + -> Ptr t47 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf48 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> CInt + -> Ptr t46 + -> CInt + -> Ptr t47 + -> CInt + -> Ptr t48 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf49 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> CInt + -> Ptr t46 + -> CInt + -> Ptr t47 + -> CInt + -> Ptr t48 + -> CInt + -> Ptr t49 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQgetf" + c_PQgetf50 + :: Ptr PGresult + -> Ptr PGerror + -> CInt + -> CString + -> CInt + -> Ptr t1 + -> CInt + -> Ptr t2 + -> CInt + -> Ptr t3 + -> CInt + -> Ptr t4 + -> CInt + -> Ptr t5 + -> CInt + -> Ptr t6 + -> CInt + -> Ptr t7 + -> CInt + -> Ptr t8 + -> CInt + -> Ptr t9 + -> CInt + -> Ptr t10 + -> CInt + -> Ptr t11 + -> CInt + -> Ptr t12 + -> CInt + -> Ptr t13 + -> CInt + -> Ptr t14 + -> CInt + -> Ptr t15 + -> CInt + -> Ptr t16 + -> CInt + -> Ptr t17 + -> CInt + -> Ptr t18 + -> CInt + -> Ptr t19 + -> CInt + -> Ptr t20 + -> CInt + -> Ptr t21 + -> CInt + -> Ptr t22 + -> CInt + -> Ptr t23 + -> CInt + -> Ptr t24 + -> CInt + -> Ptr t25 + -> CInt + -> Ptr t26 + -> CInt + -> Ptr t27 + -> CInt + -> Ptr t28 + -> CInt + -> Ptr t29 + -> CInt + -> Ptr t30 + -> CInt + -> Ptr t31 + -> CInt + -> Ptr t32 + -> CInt + -> Ptr t33 + -> CInt + -> Ptr t34 + -> CInt + -> Ptr t35 + -> CInt + -> Ptr t36 + -> CInt + -> Ptr t37 + -> CInt + -> Ptr t38 + -> CInt + -> Ptr t39 + -> CInt + -> Ptr t40 + -> CInt + -> Ptr t41 + -> CInt + -> Ptr t42 + -> CInt + -> Ptr t43 + -> CInt + -> Ptr t44 + -> CInt + -> Ptr t45 + -> CInt + -> Ptr t46 + -> CInt + -> Ptr t47 + -> CInt + -> Ptr t48 + -> CInt + -> Ptr t49 + -> CInt + -> Ptr t50 + -> IO CInt diff --git a/src/Database/PostgreSQL/PQTypes/Internal/C/Interface.hs b/src/Database/PostgreSQL/PQTypes/Internal/C/Interface.hs index cea4551..6cb8258 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/C/Interface.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/C/Interface.hs @@ -1,6 +1,6 @@ -- | Exports a set of FFI-imported libpq/libpqtypes functions. -module Database.PostgreSQL.PQTypes.Internal.C.Interface ( - -- * libpq imports +module Database.PostgreSQL.PQTypes.Internal.C.Interface + ( -- * libpq imports c_PQfreemem , c_PQstatus , c_PQerrorMessage @@ -19,7 +19,8 @@ module Database.PostgreSQL.PQTypes.Internal.C.Interface ( , c_PQcancel , c_PQconnectdb , c_PQfinish - -- * libpqtypes imports + + -- * libpqtypes imports , c_PQinitTypes , c_PQregisterTypes , c_PQparamExec @@ -28,16 +29,17 @@ module Database.PostgreSQL.PQTypes.Internal.C.Interface ( , c_PQparamCreate , c_PQparamClear , c_PQparamCount - -- * misc imports + + -- * misc imports , nullStringCStringLen - ) where + ) where +import Control.Exception qualified as E import Foreign.C import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Foreign.Ptr import System.Posix.Types -import qualified Control.Exception as E import Database.PostgreSQL.PQTypes.Internal.C.Types @@ -173,8 +175,9 @@ foreign import ccall safe "PQparamExecPrepared" -- prevent memory leaks. c_PQparamExec :: Ptr PGconn -> Ptr PGerror -> Ptr PGparam -> CString -> ResultFormat -> IO (ForeignPtr PGresult) c_PQparamExec conn err param fmt mode = do - E.mask_ $ newForeignPtr c_ptr_PQclear - =<< c_rawPQparamExec conn err param fmt mode + E.mask_ $ + newForeignPtr c_ptr_PQclear + =<< c_rawPQparamExec conn err param fmt mode -- | Safe wrapper for 'c_rawPQprepare'. Wraps result returned by -- 'c_rawPQprepare' in 'ForeignPtr' with asynchronous exceptions masked to @@ -187,8 +190,9 @@ c_PQparamPrepare -> CString -> IO (ForeignPtr PGresult) c_PQparamPrepare conn err param queryName query = do - E.mask_ $ newForeignPtr c_ptr_PQclear - =<< c_rawPQparamPrepare conn err param queryName query + E.mask_ $ + newForeignPtr c_ptr_PQclear + =<< c_rawPQparamPrepare conn err param queryName query -- | Safe wrapper for 'c_rawPQparamExecPrepared'. Wraps result returned by -- 'c_rawPQparamExecPrepared' in 'ForeignPtr' with asynchronous exceptions @@ -201,8 +205,9 @@ c_PQparamExecPrepared -> ResultFormat -> IO (ForeignPtr PGresult) c_PQparamExecPrepared conn err param queryName mode = do - E.mask_ $ newForeignPtr c_ptr_PQclear - =<< c_rawPQparamExecPrepared conn err param queryName mode + E.mask_ $ + newForeignPtr c_ptr_PQclear + =<< c_rawPQparamExecPrepared conn err param queryName mode ---------------------------------------- -- Miscellaneous diff --git a/src/Database/PostgreSQL/PQTypes/Internal/C/Put.hs b/src/Database/PostgreSQL/PQTypes/Internal/C/Put.hs index aa3a87c..da92014 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/C/Put.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/C/Put.hs @@ -12,405 +12,1626 @@ import Database.PostgreSQL.PQTypes.Internal.C.Types -- See https://www.haskell.org/ghc/blog/20210709-capi-usage.html. foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf1 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t - -> IO CInt + c_PQputf1 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf2 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 - -> IO CInt + c_PQputf2 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf3 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 - -> IO CInt + c_PQputf3 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf4 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 - -> IO CInt + c_PQputf4 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf5 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 - -> IO CInt + c_PQputf5 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf6 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 - -> IO CInt + c_PQputf6 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf7 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> IO CInt + c_PQputf7 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf8 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 - -> IO CInt + c_PQputf8 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf9 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 - -> IO CInt + c_PQputf9 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf10 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 - -> IO CInt + c_PQputf10 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf11 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 - -> IO CInt + c_PQputf11 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf12 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 - -> IO CInt + c_PQputf12 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf13 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 - -> IO CInt + c_PQputf13 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf14 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> IO CInt + c_PQputf14 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf15 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 - -> IO CInt + c_PQputf15 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf16 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 - -> IO CInt + c_PQputf16 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf17 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 - -> IO CInt + c_PQputf17 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf18 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 - -> IO CInt + c_PQputf18 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf19 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 - -> IO CInt + c_PQputf19 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf20 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 - -> IO CInt + c_PQputf20 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf21 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> IO CInt + c_PQputf21 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf22 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 - -> IO CInt + c_PQputf22 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf23 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 - -> IO CInt + c_PQputf23 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf24 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 - -> IO CInt + c_PQputf24 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf25 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 - -> IO CInt + c_PQputf25 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf26 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 - -> IO CInt + c_PQputf26 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> IO CInt foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf27 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf28 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf29 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf30 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf31 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf32 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf33 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf34 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf35 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf36 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf37 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf38 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf39 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf40 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf41 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf42 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf43 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf44 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf45 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf46 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 -> Ptr t46 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf47 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 -> Ptr t46 -> Ptr t47 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf48 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 -> Ptr t46 -> Ptr t47 -> Ptr t48 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf49 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 -> Ptr t46 -> Ptr t47 -> Ptr t48 -> Ptr t49 - -> IO CInt - -foreign import capi unsafe "libpqtypes.h PQputf" - c_PQputf50 :: Ptr PGparam -> Ptr PGerror -> CString - -> Ptr t1 -> Ptr t2 -> Ptr t3 -> Ptr t4 -> Ptr t5 -> Ptr t6 -> Ptr t7 - -> Ptr t8 -> Ptr t9 -> Ptr t10 -> Ptr t11 -> Ptr t12 -> Ptr t13 -> Ptr t14 - -> Ptr t15 -> Ptr t16 -> Ptr t17 -> Ptr t18 -> Ptr t19 -> Ptr t20 -> Ptr t21 - -> Ptr t22 -> Ptr t23 -> Ptr t24 -> Ptr t25 -> Ptr t26 -> Ptr t27 -> Ptr t28 - -> Ptr t29 -> Ptr t30 -> Ptr t31 -> Ptr t32 -> Ptr t33 -> Ptr t34 -> Ptr t35 - -> Ptr t36 -> Ptr t37 -> Ptr t38 -> Ptr t39 -> Ptr t40 -> Ptr t41 -> Ptr t42 - -> Ptr t43 -> Ptr t44 -> Ptr t45 -> Ptr t46 -> Ptr t47 -> Ptr t48 -> Ptr t49 - -> Ptr t50 - -> IO CInt + c_PQputf27 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf28 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf29 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf30 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf31 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf32 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf33 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf34 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf35 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf36 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf37 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf38 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf39 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf40 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf41 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf42 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf43 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf44 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf45 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf46 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> Ptr t46 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf47 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> Ptr t46 + -> Ptr t47 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf48 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> Ptr t46 + -> Ptr t47 + -> Ptr t48 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf49 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> Ptr t46 + -> Ptr t47 + -> Ptr t48 + -> Ptr t49 + -> IO CInt + +foreign import capi unsafe "libpqtypes.h PQputf" + c_PQputf50 + :: Ptr PGparam + -> Ptr PGerror + -> CString + -> Ptr t1 + -> Ptr t2 + -> Ptr t3 + -> Ptr t4 + -> Ptr t5 + -> Ptr t6 + -> Ptr t7 + -> Ptr t8 + -> Ptr t9 + -> Ptr t10 + -> Ptr t11 + -> Ptr t12 + -> Ptr t13 + -> Ptr t14 + -> Ptr t15 + -> Ptr t16 + -> Ptr t17 + -> Ptr t18 + -> Ptr t19 + -> Ptr t20 + -> Ptr t21 + -> Ptr t22 + -> Ptr t23 + -> Ptr t24 + -> Ptr t25 + -> Ptr t26 + -> Ptr t27 + -> Ptr t28 + -> Ptr t29 + -> Ptr t30 + -> Ptr t31 + -> Ptr t32 + -> Ptr t33 + -> Ptr t34 + -> Ptr t35 + -> Ptr t36 + -> Ptr t37 + -> Ptr t38 + -> Ptr t39 + -> Ptr t40 + -> Ptr t41 + -> Ptr t42 + -> Ptr t43 + -> Ptr t44 + -> Ptr t45 + -> Ptr t46 + -> Ptr t47 + -> Ptr t48 + -> Ptr t49 + -> Ptr t50 + -> IO CInt diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Composite.hs b/src/Database/PostgreSQL/PQTypes/Internal/Composite.hs index dcef500..a0f3ba4 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Composite.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Composite.hs @@ -1,13 +1,13 @@ -module Database.PostgreSQL.PQTypes.Internal.Composite ( - registerComposites +module Database.PostgreSQL.PQTypes.Internal.Composite + ( registerComposites ) where +import Data.Text qualified as T import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Ptr -import qualified Data.Text as T import Database.PostgreSQL.PQTypes.Internal.C.Interface import Database.PostgreSQL.PQTypes.Internal.C.Types @@ -24,8 +24,9 @@ registerComposites conn names = do >>= verifyPQTRes err "registerComposites" mapM_ touchForeignPtr cnames where - nameToTypeRep name = PGregisterType { - pgRegisterTypeTypName = unsafeForeignPtrToPtr name - , pgRegisterTypeTypPut = nullFunPtr - , pgRegisterTypeTypGet = nullFunPtr - } + nameToTypeRep name = + PGregisterType + { pgRegisterTypeTypName = unsafeForeignPtrToPtr name + , pgRegisterTypeTypPut = nullFunPtr + , pgRegisterTypeTypGet = nullFunPtr + } diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs b/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs index 06caa28..de26d92 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs @@ -1,45 +1,46 @@ module Database.PostgreSQL.PQTypes.Internal.Connection ( -- * Connection - Connection(..) - , ConnectionData(..) + Connection (..) + , ConnectionData (..) , withConnectionData - , ConnectionStats(..) - , ConnectionSettings(..) + , ConnectionStats (..) + , ConnectionSettings (..) , defaultConnectionSettings - , ConnectionSourceM(..) - , ConnectionSource(..) + , ConnectionSourceM (..) + , ConnectionSource (..) , simpleSource , poolSource , connect , disconnect + -- * Running queries , runQueryIO - , QueryName(..) + , QueryName (..) , runPreparedQueryIO ) where import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM +import Control.Exception qualified as E import Control.Monad import Control.Monad.Base import Control.Monad.Catch import Data.Bifunctor +import Data.ByteString.Char8 qualified as BS +import Data.Foldable qualified as F import Data.IORef import Data.Kind import Data.Pool +import Data.Set qualified as S import Data.String +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Foreign.C.String import Foreign.ForeignPtr import Foreign.Ptr import GHC.Conc (closeFdWith) import GHC.Stack -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS -import qualified Data.Foldable as F -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Database.PostgreSQL.PQTypes.Internal.C.Interface import Database.PostgreSQL.PQTypes.Internal.C.Types @@ -53,16 +54,17 @@ import Database.PostgreSQL.PQTypes.SQL.Raw import Database.PostgreSQL.PQTypes.ToSQL data ConnectionSettings = ConnectionSettings - { -- | Connection info string. - csConnInfo :: !T.Text - -- | Client-side encoding. If set to 'Nothing', database encoding is used. + { csConnInfo :: !T.Text + -- ^ Connection info string. , csClientEncoding :: !(Maybe T.Text) - -- | A custom role to set with "SET ROLE". - , csRole :: !(Maybe (RawSQL ())) - -- | A list of composite types to register. In order to be able to - -- (de)serialize specific composite types, you need to register them. - , csComposites :: ![T.Text] - } deriving (Eq, Ord, Show) + -- ^ Client-side encoding. If set to 'Nothing', database encoding is used. + , csRole :: !(Maybe (RawSQL ())) + -- ^ A custom role to set with "SET ROLE". + , csComposites :: ![T.Text] + -- ^ A list of composite types to register. In order to be able to + -- (de)serialize specific composite types, you need to register them. + } + deriving (Eq, Ord, Show) -- | Default connection settings. Note that all strings sent to PostgreSQL by -- the library are encoded as UTF-8, so don't alter client encoding unless you @@ -70,34 +72,36 @@ data ConnectionSettings = ConnectionSettings defaultConnectionSettings :: ConnectionSettings defaultConnectionSettings = ConnectionSettings - { csConnInfo = T.empty - , csClientEncoding = Just "UTF-8" - , csRole = Nothing - , csComposites = [] - } + { csConnInfo = T.empty + , csClientEncoding = Just "UTF-8" + , csRole = Nothing + , csComposites = [] + } ---------------------------------------- -- | Simple connection statistics. data ConnectionStats = ConnectionStats - { -- | Number of queries executed so far. - statsQueries :: !Int - -- | Number of rows fetched from the database. - , statsRows :: !Int - -- | Number of values fetched from the database. - , statsValues :: !Int - -- | Number of parameters sent to the database. - , statsParams :: !Int - } deriving (Eq, Ord, Show) + { statsQueries :: !Int + -- ^ Number of queries executed so far. + , statsRows :: !Int + -- ^ Number of rows fetched from the database. + , statsValues :: !Int + -- ^ Number of values fetched from the database. + , statsParams :: !Int + -- ^ Number of parameters sent to the database. + } + deriving (Eq, Ord, Show) -- | Initial connection statistics. initialStats :: ConnectionStats -initialStats = ConnectionStats { - statsQueries = 0 -, statsRows = 0 -, statsValues = 0 -, statsParams = 0 -} +initialStats = + ConnectionStats + { statsQueries = 0 + , statsRows = 0 + , statsValues = 0 + , statsParams = 0 + } -- | Representation of a connection object. -- @@ -108,18 +112,18 @@ initialStats = ConnectionStats { -- -- See https://gitlab.haskell.org/ghc/ghc/-/issues/10975 for more info. data ConnectionData = ConnectionData - { cdPtr :: !(Ptr PGconn) + { cdPtr :: !(Ptr PGconn) -- ^ Pointer to connection object. - , cdStats :: !ConnectionStats + , cdStats :: !ConnectionStats -- ^ Statistics associated with the connection. , cdPreparedQueries :: !(IORef (S.Set T.Text)) -- ^ A set of named prepared statements of the connection. } -- | Wrapper for hiding representation of a connection object. -newtype Connection = Connection { - unConnection :: MVar (Maybe ConnectionData) -} +newtype Connection = Connection + { unConnection :: MVar (Maybe ConnectionData) + } withConnectionData :: Connection @@ -132,23 +136,25 @@ withConnectionData (Connection mvc) fname f = Just cd -> first Just <$> f cd -- | Database connection supplier. -newtype ConnectionSourceM m = ConnectionSourceM { - withConnection :: forall r. (Connection -> m r) -> m r -} +newtype ConnectionSourceM m = ConnectionSourceM + { withConnection :: forall r. (Connection -> m r) -> m r + } -- | Wrapper for a polymorphic connection source. -newtype ConnectionSource (cs :: [(Type -> Type) -> Constraint]) = ConnectionSource { - unConnectionSource :: forall m. MkConstraint m cs => ConnectionSourceM m -} +newtype ConnectionSource (cs :: [(Type -> Type) -> Constraint]) = ConnectionSource + { unConnectionSource :: forall m. MkConstraint m cs => ConnectionSourceM m + } -- | Default connection supplier. It establishes new -- database connection each time 'withConnection' is called. simpleSource :: ConnectionSettings -> ConnectionSource [MonadBase IO, MonadMask] -simpleSource cs = ConnectionSource $ ConnectionSourceM { - withConnection = bracket (liftBase $ connect cs) (liftBase . disconnect) -} +simpleSource cs = + ConnectionSource $ + ConnectionSourceM + { withConnection = bracket (liftBase $ connect cs) (liftBase . disconnect) + } -- | Pooled source. It uses striped pool from @resource-pool@ package to cache -- established connections and reuse them. @@ -162,21 +168,25 @@ poolSource -> IO (ConnectionSource [MonadBase IO, MonadMask]) poolSource cs mkPoolConfig = do pool <- newPool $ mkPoolConfig (connect cs) disconnect - return $ ConnectionSource $ ConnectionSourceM { - withConnection = doWithConnection pool . (clearStats >=>) - } + return $ + ConnectionSource $ + ConnectionSourceM + { withConnection = doWithConnection pool . (clearStats >=>) + } where - doWithConnection pool m = fst <$> generalBracket - (liftBase $ takeResource pool) - (\(resource, local) -> \case - ExitCaseSuccess _ -> liftBase $ putResource local resource - _ -> liftBase $ destroyResource pool local resource - ) - (\(resource, _) -> m resource) + doWithConnection pool m = + fst + <$> generalBracket + (liftBase $ takeResource pool) + ( \(resource, local) -> \case + ExitCaseSuccess _ -> liftBase $ putResource local resource + _ -> liftBase $ destroyResource pool local resource + ) + (\(resource, _) -> m resource) clearStats conn@(Connection mv) = do liftBase . modifyMVar_ mv $ \mconn -> - return $ (\cd -> cd { cdStats = initialStats }) <$> mconn + return $ (\cd -> cd {cdStats = initialStats}) <$> mconn return conn ---------------------------------------- @@ -187,7 +197,7 @@ poolSource cs mkPoolConfig = do -- /Warning:/ the 'Connection' needs to be explicitly destroyed with -- 'disconnect', otherwise there will be a resource leak. connect :: ConnectionSettings -> IO Connection -connect ConnectionSettings{..} = mask $ \unmask -> do +connect ConnectionSettings {..} = mask $ \unmask -> do connPtr <- BS.useAsCString (T.encodeUtf8 csConnInfo) (openConnection unmask) (`onException` c_PQfinish connPtr) . unmask $ do status <- c_PQstatus connPtr @@ -201,11 +211,13 @@ connect ConnectionSettings{..} = mask $ \unmask -> do registerComposites connPtr csComposites conn <- do preparedQueries <- newIORef S.empty - fmap Connection . newMVar $ Just ConnectionData - { cdPtr = connPtr - , cdStats = initialStats - , cdPreparedQueries = preparedQueries - } + fmap Connection . newMVar $ + Just + ConnectionData + { cdPtr = connPtr + , cdStats = initialStats + , cdPreparedQueries = preparedQueries + } F.forM_ csRole $ \role -> runQueryIO conn $ "SET ROLE " <> role pure conn where @@ -228,15 +240,17 @@ connect ConnectionSettings{..} = mask $ \unmask -> do runningVar <- newTVarIO True _ <- forkIO $ do conn <- c_PQconnectdb conninfo - join . atomically $ readTVar runningVar >>= \case - True -> do - putTMVar connVar conn - pure $ pure () - False -> pure $ c_PQfinish conn - conn <- atomically (takeTMVar connVar) `onException` do - join . atomically $ do - writeTVar runningVar False - maybe (pure ()) c_PQfinish <$> tryTakeTMVar connVar + join . atomically $ + readTVar runningVar >>= \case + True -> do + putTMVar connVar conn + pure $ pure () + False -> pure $ c_PQfinish conn + conn <- + atomically (takeTMVar connVar) `onException` do + join . atomically $ do + writeTVar runningVar False + maybe (pure ()) c_PQfinish <$> tryTakeTMVar connVar (`onException` c_PQfinish conn) . unmask $ do when (conn == nullPtr) $ do throwError "PQconnectdb returned a null pointer" @@ -266,7 +280,6 @@ disconnect (Connection mvconn) = modifyMVar_ mvconn $ \mconn -> do c_PQsocket conn >>= \case -1 -> c_PQfinish conn -- can happen if the connection is bad/lost fd -> closeFdWith (\_ -> c_PQfinish conn) fd - Nothing -> E.throwIO (HPQTypesError "disconnect: no connection (shouldn't happen)") return Nothing @@ -280,11 +293,12 @@ runQueryIO -> sql -> IO (Int, ForeignPtr PGresult) runQueryIO conn sql = do - runQueryImpl "runQueryIO" conn sql $ \ConnectionData{..} -> do + runQueryImpl "runQueryIO" conn sql $ \ConnectionData {..} -> do let allocParam = ParamAllocator $ withPGparam cdPtr - withSQL sql allocParam $ \param query -> (,) - <$> (fromIntegral <$> c_PQparamCount param) - <*> c_PQparamExec cdPtr nullPtr param query c_RESULT_BINARY + withSQL sql allocParam $ \param query -> + (,) + <$> (fromIntegral <$> c_PQparamCount param) + <*> c_PQparamExec cdPtr nullPtr param query c_RESULT_BINARY -- | Name of a prepared query. newtype QueryName = QueryName T.Text @@ -298,13 +312,14 @@ runPreparedQueryIO -> sql -> IO (Int, ForeignPtr PGresult) runPreparedQueryIO conn (QueryName queryName) sql = do - runQueryImpl "runPreparedQueryIO" conn sql $ \ConnectionData{..} -> do + runQueryImpl "runPreparedQueryIO" conn sql $ \ConnectionData {..} -> do when (T.null queryName) $ do - E.throwIO DBException - { dbeQueryContext = sql - , dbeError = HPQTypesError "runPreparedQueryIO: unnamed prepared query is not supported" - , dbeCallStack = callStack - } + E.throwIO + DBException + { dbeQueryContext = sql + , dbeError = HPQTypesError "runPreparedQueryIO: unnamed prepared query is not supported" + , dbeCallStack = callStack + } let allocParam = ParamAllocator $ withPGparam cdPtr withSQL sql allocParam $ \param query -> do preparedQueries <- readIORef cdPreparedQueries @@ -316,8 +331,9 @@ runPreparedQueryIO conn (QueryName queryName) sql = do res <- c_PQparamPrepare cdPtr nullPtr param cname query void . withForeignPtr res $ verifyResult sql cdPtr modifyIORef' cdPreparedQueries $ S.insert queryName - (,) <$> (fromIntegral <$> c_PQparamCount param) - <*> c_PQparamExecPrepared cdPtr nullPtr param cname c_RESULT_BINARY + (,) + <$> (fromIntegral <$> c_PQparamCount param) + <*> c_PQparamExecPrepared cdPtr nullPtr param cname c_RESULT_BINARY -- | Shared implementation of 'runQueryIO' and 'runPreparedQueryIO'. runQueryImpl @@ -328,7 +344,7 @@ runQueryImpl -> (ConnectionData -> IO (Int, ForeignPtr PGresult)) -> IO (Int, ForeignPtr PGresult) runQueryImpl fname conn sql execSql = do - withConnDo $ \cd@ConnectionData{..} -> E.mask $ \restore -> do + withConnDo $ \cd@ConnectionData {..} -> E.mask $ \restore -> do -- While the query runs, the current thread will not be able to receive -- asynchronous exceptions. This prevents clients of the library from -- interrupting execution of the query. To remedy that we spawn a separate @@ -339,20 +355,23 @@ runQueryImpl fname conn sql execSql = do (paramCount, res) <- execSql cd affected <- withForeignPtr res $ verifyResult sql cdPtr stats' <- case affected of - Left _ -> return cdStats { - statsQueries = statsQueries cdStats + 1 - , statsParams = statsParams cdStats + paramCount - } + Left _ -> + return + cdStats + { statsQueries = statsQueries cdStats + 1 + , statsParams = statsParams cdStats + paramCount + } Right rows -> do columns <- fromIntegral <$> withForeignPtr res c_PQnfields - return ConnectionStats { - statsQueries = statsQueries cdStats + 1 - , statsRows = statsRows cdStats + rows - , statsValues = statsValues cdStats + (rows * columns) - , statsParams = statsParams cdStats + paramCount - } + return + ConnectionStats + { statsQueries = statsQueries cdStats + 1 + , statsRows = statsRows cdStats + rows + , statsValues = statsValues cdStats + (rows * columns) + , statsParams = statsParams cdStats + paramCount + } -- Force evaluation of modified stats to squash a space leak. - stats' `seq` return (cd { cdStats = stats' }, (either id id affected, res)) + stats' `seq` return (cd {cdStats = stats'}, (either id id affected, res)) -- If we receive an exception while waiting for the execution to complete, -- we need to send a request to PostgreSQL for query cancellation and wait -- for the query runner thread to terminate. It is paramount we make the @@ -368,11 +387,12 @@ runQueryImpl fname conn sql execSql = do -- weird is going on. Maybe the cancellation request went through when -- the thread wasn't making a request to the server? In any case, try to -- cancel again and wait for the thread to terminate. - Just _ -> poll queryRunner >>= \case - Just _ -> return () - Nothing -> do - void $ c_PQcancel cdPtr - cancel queryRunner + Just _ -> + poll queryRunner >>= \case + Just _ -> return () + Nothing -> do + void $ c_PQcancel cdPtr + cancel queryRunner where withConnDo = withConnectionData conn fname @@ -391,37 +411,46 @@ verifyResult sql conn res = do case BS.readInt sn of Nothing | BS.null sn -> return . Left $ 0 - | otherwise -> throwParseError sn + | otherwise -> throwParseError sn Just (n, rest) | rest /= BS.empty -> throwParseError sn - | otherwise -> return . Left $ n - _ | rst == c_PGRES_TUPLES_OK -> Right . fromIntegral <$> c_PQntuples res - _ | rst == c_PGRES_FATAL_ERROR -> throwSQLError + | otherwise -> return . Left $ n + _ | rst == c_PGRES_TUPLES_OK -> Right . fromIntegral <$> c_PQntuples res + _ | rst == c_PGRES_FATAL_ERROR -> throwSQLError _ | rst == c_PGRES_BAD_RESPONSE -> throwSQLError - _ | otherwise -> return . Left $ 0 - where - throwSQLError = rethrowWithContext sql =<< if res == nullPtr - then return . E.toException . QueryError - =<< safePeekCString' =<< c_PQerrorMessage conn - else E.toException <$> (DetailedQueryError - <$> field c_PG_DIAG_SEVERITY - <*> (stringToErrorCode <$> field c_PG_DIAG_SQLSTATE) - <*> field c_PG_DIAG_MESSAGE_PRIMARY - <*> mfield c_PG_DIAG_MESSAGE_DETAIL - <*> mfield c_PG_DIAG_MESSAGE_HINT - <*> ((mread =<<) <$> mfield c_PG_DIAG_STATEMENT_POSITION) - <*> ((mread =<<) <$> mfield c_PG_DIAG_INTERNAL_POSITION) - <*> mfield c_PG_DIAG_INTERNAL_QUERY - <*> mfield c_PG_DIAG_CONTEXT - <*> mfield c_PG_DIAG_SOURCE_FILE - <*> ((mread =<<) <$> mfield c_PG_DIAG_SOURCE_LINE) - <*> mfield c_PG_DIAG_SOURCE_FUNCTION) - where - field f = maybe "" id <$> mfield f - mfield f = safePeekCString =<< c_PQresultErrorField res f + _ | otherwise -> return . Left $ 0 + where + throwSQLError = + rethrowWithContext sql + =<< if res == nullPtr + then + return . E.toException . QueryError + =<< safePeekCString' + =<< c_PQerrorMessage conn + else + E.toException + <$> ( DetailedQueryError + <$> field c_PG_DIAG_SEVERITY + <*> (stringToErrorCode <$> field c_PG_DIAG_SQLSTATE) + <*> field c_PG_DIAG_MESSAGE_PRIMARY + <*> mfield c_PG_DIAG_MESSAGE_DETAIL + <*> mfield c_PG_DIAG_MESSAGE_HINT + <*> ((mread =<<) <$> mfield c_PG_DIAG_STATEMENT_POSITION) + <*> ((mread =<<) <$> mfield c_PG_DIAG_INTERNAL_POSITION) + <*> mfield c_PG_DIAG_INTERNAL_QUERY + <*> mfield c_PG_DIAG_CONTEXT + <*> mfield c_PG_DIAG_SOURCE_FILE + <*> ((mread =<<) <$> mfield c_PG_DIAG_SOURCE_LINE) + <*> mfield c_PG_DIAG_SOURCE_FUNCTION + ) + where + field f = maybe "" id <$> mfield f + mfield f = safePeekCString =<< c_PQresultErrorField res f - throwParseError sn = E.throwIO DBException { - dbeQueryContext = sql - , dbeError = HPQTypesError ("verifyResult: string returned by PQcmdTuples is not a valid number: " ++ show sn) - , dbeCallStack = callStack - } + throwParseError sn = + E.throwIO + DBException + { dbeQueryContext = sql + , dbeError = HPQTypesError ("verifyResult: string returned by PQcmdTuples is not a valid number: " ++ show sn) + , dbeCallStack = callStack + } diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Error.hs b/src/Database/PostgreSQL/PQTypes/Internal/Error.hs index 8b35bcf..65d2f49 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Error.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Error.hs @@ -1,39 +1,40 @@ -- | Definitions of exception types. -module Database.PostgreSQL.PQTypes.Internal.Error ( - DetailedQueryError(..) - , QueryError(..) - , HPQTypesError(..) - , LibPQError(..) - , ConversionError(..) - , ArrayItemError(..) - , InvalidValue(..) - , RangeError(..) - , ArrayDimensionMismatch(..) - , RowLengthMismatch(..) - , AffectedRowsMismatch(..) +module Database.PostgreSQL.PQTypes.Internal.Error + ( DetailedQueryError (..) + , QueryError (..) + , HPQTypesError (..) + , LibPQError (..) + , ConversionError (..) + , ArrayItemError (..) + , InvalidValue (..) + , RangeError (..) + , ArrayDimensionMismatch (..) + , RowLengthMismatch (..) + , AffectedRowsMismatch (..) ) where +import Control.Exception qualified as E import Data.Typeable -import qualified Control.Exception as E import Database.PostgreSQL.PQTypes.Internal.Error.Code -- | SQL query error. Reference: description of PQresultErrorField -- at . data DetailedQueryError = DetailedQueryError - { qeSeverity :: !String - , qeErrorCode :: !ErrorCode - , qeMessagePrimary :: !String - , qeMessageDetail :: !(Maybe String) - , qeMessageHint :: !(Maybe String) + { qeSeverity :: !String + , qeErrorCode :: !ErrorCode + , qeMessagePrimary :: !String + , qeMessageDetail :: !(Maybe String) + , qeMessageHint :: !(Maybe String) , qeStatementPosition :: !(Maybe Int) - , qeInternalPosition :: !(Maybe Int) - , qeInternalQuery :: !(Maybe String) - , qeContext :: !(Maybe String) - , qeSourceFile :: !(Maybe String) - , qeSourceLine :: !(Maybe Int) - , qeSourceFunction :: !(Maybe String) - } deriving (Eq, Ord, Show) + , qeInternalPosition :: !(Maybe Int) + , qeInternalQuery :: !(Maybe String) + , qeContext :: !(Maybe String) + , qeSourceFile :: !(Maybe String) + , qeSourceLine :: !(Maybe Int) + , qeSourceFunction :: !(Maybe String) + } + deriving (Eq, Ord, Show) -- | Simple SQL query error. Thrown when there is no -- PGresult object corresponding to query execution. @@ -57,14 +58,14 @@ instance Show LibPQError where -- | Data conversion error. Since it's polymorphic in error type, -- it nicely reports arbitrarily nested conversion errors. data ConversionError = forall e. E.Exception e => ConversionError - { -- | Column number (Starts with 1). - convColumn :: !Int - -- | Name of the column. + { convColumn :: !Int + -- ^ Column number (Starts with 1). , convColumnName :: !String - -- | Row number (Starts with 1). - , convRow :: !Int - -- | Exact error. - , convError :: !e + -- ^ Name of the column. + , convRow :: !Int + -- ^ Row number (Starts with 1). + , convError :: !e + -- ^ Exact error. } deriving instance Show ConversionError @@ -72,55 +73,60 @@ deriving instance Show ConversionError -- | Array item error. Polymorphic in error type -- for the same reason as 'ConversionError'. data ArrayItemError = forall e. E.Exception e => ArrayItemError - { -- | Item index (Starts with 1). - arrItemIndex :: !Int - -- | Exact error. + { arrItemIndex :: !Int + -- ^ Item index (Starts with 1). , arrItemError :: !e -} + -- ^ Exact error. + } deriving instance Show ArrayItemError -- | \"Invalid value\" error for various data types. data InvalidValue t = InvalidValue - { -- | Invalid value. - ivValue :: t - -- Optional list of valid values. - , ivValidValues :: Maybe [t] - } deriving (Eq, Ord, Show) + { ivValue :: t + -- ^ Invalid value. + , -- Optional list of valid values. + ivValidValues :: Maybe [t] + } + deriving (Eq, Ord, Show) -- | Range error for various data types. data RangeError t = RangeError - { -- | Allowed range (sum of acceptable ranges). - reRange :: [(t, t)] - -- | Provided value which is not in above range. + { reRange :: [(t, t)] + -- ^ Allowed range (sum of acceptable ranges). , reValue :: t - } deriving (Eq, Ord, Show) + -- ^ Provided value which is not in above range. + } + deriving (Eq, Ord, Show) -- | Array dimenstion mismatch error. data ArrayDimensionMismatch = ArrayDimensionMismatch - { -- | Dimension expected by the library. - arrDimExpected :: !Int - -- | Dimension provided by the database. + { arrDimExpected :: !Int + -- ^ Dimension expected by the library. , arrDimDelivered :: !Int - } deriving (Eq, Ord, Show) + -- ^ Dimension provided by the database. + } + deriving (Eq, Ord, Show) -- | Row length mismatch error. data RowLengthMismatch = RowLengthMismatch - { -- | Length expected by the library. - lengthExpected :: !Int - -- | Length delivered by the database. + { lengthExpected :: !Int + -- ^ Length expected by the library. , lengthDelivered :: !Int - } deriving (Eq, Ord, Show) + -- ^ Length delivered by the database. + } + deriving (Eq, Ord, Show) -- | Affected/returned rows mismatch error. data AffectedRowsMismatch = AffectedRowsMismatch - { -- | Number of rows expected by the library, expressed as sum of acceptable - -- ranges, eg. [(1,2), (5,10)] means that it would accept 1, 2, 5, 6, 7, 8, - -- 9 or 10 affected/returned rows. - rowsExpected :: ![(Int, Int)] - -- | Number of affected/returned rows by the database. + { rowsExpected :: ![(Int, Int)] + -- ^ Number of rows expected by the library, expressed as sum of acceptable + -- ranges, eg. [(1,2), (5,10)] means that it would accept 1, 2, 5, 6, 7, 8, + -- 9 or 10 affected/returned rows. , rowsDelivered :: !Int - } deriving (Eq, Ord, Show) + -- ^ Number of affected/returned rows by the database. + } + deriving (Eq, Ord, Show) instance E.Exception DetailedQueryError instance E.Exception QueryError diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Error/Code.hs b/src/Database/PostgreSQL/PQTypes/Internal/Error/Code.hs index dac94a9..1057ee7 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Error/Code.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Error/Code.hs @@ -1,15 +1,15 @@ -module Database.PostgreSQL.PQTypes.Internal.Error.Code ( - ErrorCode(..) +module Database.PostgreSQL.PQTypes.Internal.Error.Code + ( ErrorCode (..) , stringToErrorCode ) where -- | SQL error code. Reference: -- . data ErrorCode - -- Class 00 — Successful Completion - = SuccessfulCompletion - -- Class 01 — Warning - | Warning + = -- Class 00 — Successful Completion + SuccessfulCompletion + | -- Class 01 — Warning + Warning | DynamicResultSetsReturned | ImplicitZeroBitPadding | NullValueEliminatedInSetFunction @@ -17,42 +17,42 @@ data ErrorCode | PrivilegeNotRevoked | StringDataRightTruncation_01 | DeprecatedFeature - -- Class 02 — No Data (this is also a warning class per the SQL standard) - | NoData + | -- Class 02 — No Data (this is also a warning class per the SQL standard) + NoData | NoAdditionalDynamicResultSetsReturned - -- Class 03 — SQL Statement Not Yet Complete - | SqlStatementNotYetComplete - -- Class 08 — Connection Exception - | ConnectionException + | -- Class 03 — SQL Statement Not Yet Complete + SqlStatementNotYetComplete + | -- Class 08 — Connection Exception + ConnectionException | ConnectionDoesNotExist | ConnectionFailure | SqlclientUnableToEstablishSqlconnection | SqlserverRejectedEstablishmentOfSqlconnection | TransactionResolutionUnknown | ProtocolViolation - -- Class 09 — Triggered Action Exception - | TriggeredActionException - -- Class 0A — Feature Not Supported - | FeatureNotSupported - -- Class 0B — Invalid Transaction Initiation - | InvalidTransactionInitiation - -- Class 0F — Locator Exception - | LocatorException + | -- Class 09 — Triggered Action Exception + TriggeredActionException + | -- Class 0A — Feature Not Supported + FeatureNotSupported + | -- Class 0B — Invalid Transaction Initiation + InvalidTransactionInitiation + | -- Class 0F — Locator Exception + LocatorException | InvalidLocatorSpecification - -- Class 0L — Invalid Grantor - | InvalidGrantor + | -- Class 0L — Invalid Grantor + InvalidGrantor | InvalidGrantOperation - -- Class 0P — Invalid Role Specification - | InvalidRoleSpecification - -- Class 0Z — Diagnostics Exception - | DiagnosticsException + | -- Class 0P — Invalid Role Specification + InvalidRoleSpecification + | -- Class 0Z — Diagnostics Exception + DiagnosticsException | StackedDiagnosticsAccessedWithoutActiveHandler - -- Class 20 — Case Not Found - | CaseNotFound - -- Class 21 — Cardinality Violation - | CardinalityViolation - -- Class 22 — Data Exception - | DataException + | -- Class 20 — Case Not Found + CaseNotFound + | -- Class 21 — Cardinality Violation + CardinalityViolation + | -- Class 22 — Data Exception + DataException | ArraySubscriptError | CharacterNotInRepertoire | DatetimeFieldOverflow @@ -99,18 +99,18 @@ data ErrorCode | InvalidXmlContent | InvalidXmlComment | InvalidXmlProcessingInstruction - -- Class 23 — Integrity Constraint Violation - | IntegrityConstraintViolation + | -- Class 23 — Integrity Constraint Violation + IntegrityConstraintViolation | RestrictViolation | NotNullViolation | ForeignKeyViolation | UniqueViolation | CheckViolation | ExclusionViolation - -- Class 24 — Invalid Cursor State - | InvalidCursorState - -- Class 25 — Invalid Transaction State - | InvalidTransactionState + | -- Class 24 — Invalid Cursor State + InvalidCursorState + | -- Class 25 — Invalid Transaction State + InvalidTransactionState | ActiveSqlTransaction | BranchTransactionAlreadyActive | HeldCursorRequiresSameIsolationLevel @@ -121,53 +121,53 @@ data ErrorCode | SchemaAndDataStatementMixingNotSupported | NoActiveSqlTransaction | InFailedSqlTransaction - -- Class 26 — Invalid SQL Statement Name - | InvalidSqlStatementName - -- Class 27 — Triggered Data Change Violation - | TriggeredDataChangeViolation - -- Class 28 — Invalid Authorization Specification - | InvalidAuthorizationSpecification + | -- Class 26 — Invalid SQL Statement Name + InvalidSqlStatementName + | -- Class 27 — Triggered Data Change Violation + TriggeredDataChangeViolation + | -- Class 28 — Invalid Authorization Specification + InvalidAuthorizationSpecification | InvalidPassword - -- Class 2B — Dependent Privilege Descriptors Still Exist - | DependentPrivilegeDescriptorsStillExist + | -- Class 2B — Dependent Privilege Descriptors Still Exist + DependentPrivilegeDescriptorsStillExist | DependentObjectsStillExist - -- Class 2D — Invalid Transaction Termination - | InvalidTransactionTermination - -- Class 2F — SQL Routine Exception - | SqlRoutineException + | -- Class 2D — Invalid Transaction Termination + InvalidTransactionTermination + | -- Class 2F — SQL Routine Exception + SqlRoutineException | FunctionExecutedNoReturnStatement | ModifyingSqlDataNotPermitted_2F | ProhibitedSqlStatementAttempted_2F | ReadingSqlDataNotPermitted_2F - -- Class 34 — Invalid Cursor Name - | InvalidCursorName - -- Class 38 — External Routine Exception - | ExternalRoutineException + | -- Class 34 — Invalid Cursor Name + InvalidCursorName + | -- Class 38 — External Routine Exception + ExternalRoutineException | ContainingSqlNotPermitted | ModifyingSqlDataNotPermitted_38 | ProhibitedSqlStatementAttempted_38 | ReadingSqlDataNotPermitted_38 - -- Class 39 — External Routine Invocation Exception - | ExternalRoutineInvocationException + | -- Class 39 — External Routine Invocation Exception + ExternalRoutineInvocationException | InvalidSqlstateReturned | NullValueNotAllowed_39 | TriggerProtocolViolated | SrfProtocolViolated - -- Class 3B — Savepoint Exception - | SavepointException + | -- Class 3B — Savepoint Exception + SavepointException | InvalidSavepointSpecification - -- Class 3D — Invalid Catalog Name - | InvalidCatalogName - -- Class 3F — Invalid Schema Name - | InvalidSchemaName - -- Class 40 — Transaction Rollback - | TransactionRollback + | -- Class 3D — Invalid Catalog Name + InvalidCatalogName + | -- Class 3F — Invalid Schema Name + InvalidSchemaName + | -- Class 40 — Transaction Rollback + TransactionRollback | TransactionIntegrityConstraintViolation | SerializationFailure | StatementCompletionUnknown | DeadlockDetected - -- Class 42 — Syntax Error or Access Rule Violation - | SyntaxErrorOrAccessRuleViolation + | -- Class 42 — Syntax Error or Access Rule Violation + SyntaxErrorOrAccessRuleViolation | SyntaxError | InsufficientPrivilege | CannotCoerce @@ -210,41 +210,41 @@ data ErrorCode | InvalidSchemaDefinition | InvalidTableDefinition | InvalidObjectDefinition - -- Class 44 — WITH CHECK OPTION Violation - | WithCheckOptionViolation - -- Class 53 — Insufficient Resources - | InsufficientResources + | -- Class 44 — WITH CHECK OPTION Violation + WithCheckOptionViolation + | -- Class 53 — Insufficient Resources + InsufficientResources | DiskFull | OutOfMemory | TooManyConnections | ConfigurationLimitExceeded - -- Class 54 — Program Limit Exceeded - | ProgramLimitExceeded + | -- Class 54 — Program Limit Exceeded + ProgramLimitExceeded | StatementTooComplex | TooManyColumns | TooManyArguments - -- Class 55 — Object Not In Prerequisite State - | ObjectNotInPrerequisiteState + | -- Class 55 — Object Not In Prerequisite State + ObjectNotInPrerequisiteState | ObjectInUse | CantChangeRuntimeParam | LockNotAvailable - -- Class 57 — Operator Intervention - | OperatorIntervention + | -- Class 57 — Operator Intervention + OperatorIntervention | QueryCanceled | AdminShutdown | CrashShutdown | CannotConnectNow | DatabaseDropped - -- Class 58 — System Error (errors external to PostgreSQL itself) - | SystemError + | -- Class 58 — System Error (errors external to PostgreSQL itself) + SystemError | IoError | UndefinedFile | DuplicateFile - -- Class F0 — Configuration File Error - | ConfigFileError + | -- Class F0 — Configuration File Error + ConfigFileError | LockFileExists - -- Class HV — Foreign Data Wrapper Error (SQL/MED) - | FdwError + | -- Class HV — Foreign Data Wrapper Error (SQL/MED) + FdwError | FdwColumnNameNotFound | FdwDynamicParameterValueNeeded | FdwFunctionSequenceError @@ -271,17 +271,17 @@ data ErrorCode | FdwUnableToCreateExecution | FdwUnableToCreateReply | FdwUnableToEstablishConnection - -- Class P0 — PL/pgSQL Error - | PlpgsqlError + | -- Class P0 — PL/pgSQL Error + PlpgsqlError | RaiseException | NoDataFound | TooManyRows - -- Class XX — Internal Error - | InternalError + | -- Class XX — Internal Error + InternalError | DataCorrupted | IndexCorrupted - -- Unknown error code - | UnknownErrorCode String + | -- Unknown error code + UnknownErrorCode String deriving (Eq, Ord, Show) -- | Convert 'String' to corresponding 'ErrorCode'. @@ -562,4 +562,4 @@ stringToErrorCode code = case code of "XX001" -> DataCorrupted "XX002" -> IndexCorrupted -- Unknown error code - _ -> UnknownErrorCode code + _ -> UnknownErrorCode code diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Exception.hs b/src/Database/PostgreSQL/PQTypes/Internal/Exception.hs index ae5c7fe..d0433c0 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Exception.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Exception.hs @@ -1,22 +1,22 @@ -- | Definition of main exception type. -module Database.PostgreSQL.PQTypes.Internal.Exception ( - DBException(..) +module Database.PostgreSQL.PQTypes.Internal.Exception + ( DBException (..) , rethrowWithContext ) where +import Control.Exception qualified as E import GHC.Stack -import qualified Control.Exception as E import Database.PostgreSQL.PQTypes.SQL.Class -- | Main exception type. All exceptions thrown by -- the library are additionally wrapped in this type. data DBException = forall e sql. (E.Exception e, Show sql) => DBException - { -- | Last SQL query that was executed. - dbeQueryContext :: !sql - -- | Specific error. - , dbeError :: !e - , dbeCallStack :: CallStack + { dbeQueryContext :: !sql + -- ^ Last SQL query that was executed. + , dbeError :: !e + -- ^ Specific error. + , dbeCallStack :: CallStack } deriving instance Show DBException @@ -25,8 +25,10 @@ instance E.Exception DBException -- | Rethrow supplied exception enriched with given SQL. rethrowWithContext :: (HasCallStack, IsSQL sql) => sql -> E.SomeException -> IO a -rethrowWithContext sql (E.SomeException e) = E.throwIO DBException { - dbeQueryContext = sql - , dbeError = e - , dbeCallStack = callStack - } +rethrowWithContext sql (E.SomeException e) = + E.throwIO + DBException + { dbeQueryContext = sql + , dbeError = e + , dbeCallStack = callStack + } diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs b/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs index 3320c09..43fedda 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs @@ -1,5 +1,5 @@ -module Database.PostgreSQL.PQTypes.Internal.Monad ( - DBT_(..) +module Database.PostgreSQL.PQTypes.Internal.Monad + ( DBT_ (..) , DBT , runDBT , mapDBT @@ -11,14 +11,14 @@ import Control.Monad import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Error.Class +import Control.Monad.Fail qualified as MF import Control.Monad.Reader.Class import Control.Monad.State.Strict import Control.Monad.Trans.Control +import Control.Monad.Trans.State.Strict qualified as S import Control.Monad.Writer.Class import Data.Bifunctor import GHC.Stack -import qualified Control.Monad.Trans.State.Strict as S -import qualified Control.Monad.Fail as MF import Database.PostgreSQL.PQTypes.Class import Database.PostgreSQL.PQTypes.Internal.Connection @@ -35,7 +35,7 @@ type InnerDBT m = StateT (DBState m) -- | Monad transformer for adding database -- interaction capabilities to the underlying monad. -newtype DBT_ m n a = DBT { unDBT :: InnerDBT m n a } +newtype DBT_ m n a = DBT {unDBT :: InnerDBT m n a} deriving (Alternative, Applicative, Functor, Monad, MF.MonadFail, MonadBase b, MonadCatch, MonadIO, MonadMask, MonadPlus, MonadThrow, MonadTrans) type DBT m = DBT_ m m @@ -49,18 +49,21 @@ runDBT -> DBT m a -> m a runDBT cs ts m = withConnection cs $ \conn -> do - evalStateT action $ DBState { - dbConnection = conn - , dbConnectionSource = cs - , dbTransactionSettings = ts - , dbLastQuery = SomeSQL (mempty::SQL) - , dbRecordLastQuery = True - , dbQueryResult = Nothing - } + evalStateT action $ + DBState + { dbConnection = conn + , dbConnectionSource = cs + , dbTransactionSettings = ts + , dbLastQuery = SomeSQL (mempty :: SQL) + , dbRecordLastQuery = True + , dbQueryResult = Nothing + } where - action = unDBT $ if tsAutoTransaction ts - then withTransaction' (ts { tsAutoTransaction = False }) m - else m + action = + unDBT $ + if tsAutoTransaction ts + then withTransaction' (ts {tsAutoTransaction = False}) m + else m -- | Transform the underlying monad. mapDBT @@ -81,9 +84,9 @@ instance (m ~ n, MonadBase IO m, MonadMask m) => MonadDB (DBT_ m n) where getLastQuery = DBT . gets $ dbLastQuery withFrozenLastQuery callback = DBT . StateT $ \st -> do - let st' = st { dbRecordLastQuery = False } + let st' = st {dbRecordLastQuery = False} (x, st'') <- runStateT (unDBT callback) st' - pure (x, st'' { dbRecordLastQuery = dbRecordLastQuery st }) + pure (x, st'' {dbRecordLastQuery = dbRecordLastQuery st}) getConnectionStats = withFrozenCallStack $ do mconn <- DBT $ liftBase . readMVar =<< gets (unConnection . dbConnection) @@ -92,13 +95,14 @@ instance (m ~ n, MonadBase IO m, MonadMask m) => MonadDB (DBT_ m n) where Just cd -> return $ cdStats cd getQueryResult = DBT . gets $ \st -> dbQueryResult st - clearQueryResult = DBT . modify $ \st -> st { dbQueryResult = Nothing } + clearQueryResult = DBT . modify $ \st -> st {dbQueryResult = Nothing} getTransactionSettings = DBT . gets $ dbTransactionSettings - setTransactionSettings ts = DBT . modify $ \st -> st { dbTransactionSettings = ts } + setTransactionSettings ts = DBT . modify $ \st -> st {dbTransactionSettings = ts} - getNotification time = DBT . StateT $ \st -> (, st) - <$> liftBase (getNotificationIO st time) + getNotification time = DBT . StateT $ \st -> + (,st) + <$> liftBase (getNotificationIO st time) withNewConnection m = DBT . StateT $ \st -> do let cs = dbConnectionSource st @@ -116,7 +120,7 @@ instance MonadTransControl (DBT_ m) where instance (m ~ n, MonadBaseControl b m) => MonadBaseControl b (DBT_ m n) where type StM (DBT_ m n) a = ComposeSt (DBT_ m) m a liftBaseWith = defaultLiftBaseWith - restoreM = defaultRestoreM + restoreM = defaultRestoreM instance (m ~ n, MonadError e m) => MonadError e (DBT_ m n) where throwError = lift . throwError diff --git a/src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs b/src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs index ae8cd19..f6906b9 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.Internal.QueryResult ( - QueryResult(..) + +module Database.PostgreSQL.PQTypes.Internal.QueryResult + ( QueryResult (..) , ntuples , nfields @@ -9,6 +10,7 @@ module Database.PostgreSQL.PQTypes.Internal.QueryResult ( , foldlImpl ) where +import Control.Exception qualified as E import Control.Monad import Data.Coerce import Data.Foldable @@ -19,7 +21,6 @@ import Foreign.Marshal.Alloc import Foreign.Ptr import GHC.Stack import System.IO.Unsafe -import qualified Control.Exception as E import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromRow @@ -33,8 +34,8 @@ import Database.PostgreSQL.PQTypes.SQL.Class -- and 'Foldable' instances for data transformation and -- extraction appropriately. data QueryResult t = forall row. FromRow row => QueryResult - { qrSQL :: !SomeSQL - , qrResult :: !(ForeignPtr PGresult) + { qrSQL :: !SomeSQL + , qrResult :: !(ForeignPtr PGresult) , qrFromRow :: !(row -> t) } @@ -42,11 +43,11 @@ instance Functor QueryResult where f `fmap` QueryResult ctx fres g = QueryResult ctx fres (f . g) instance Foldable QueryResult where - foldr f acc = runIdentity . foldrImpl False (coerce f) acc - foldr' f acc = runIdentity . foldrImpl True (coerce f) acc + foldr f acc = runIdentity . foldrImpl False (coerce f) acc + foldr' f acc = runIdentity . foldrImpl True (coerce f) acc - foldl f acc = runIdentity . foldlImpl False (coerce f) acc - foldl' f acc = runIdentity . foldlImpl True (coerce f) acc + foldl f acc = runIdentity . foldlImpl False (coerce f) acc + foldl' f acc = runIdentity . foldlImpl True (coerce f) acc foldrImpl :: (HasCallStack, Monad m) @@ -82,28 +83,31 @@ foldImpl initCtr termCtr advCtr strict f iacc (QueryResult (SomeSQL ctx) fres g) -- FrowRow and FromSQL instances are (the ones provided -- by the library fulfil this requirement). rowlen <- fromIntegral <$> c_PQnfields res - when (rowlen /= pqVariablesP rowp) $ E.throwIO DBException { - dbeQueryContext = ctx - , dbeError = RowLengthMismatch { - lengthExpected = pqVariablesP rowp - , lengthDelivered = rowlen - } - , dbeCallStack = callStack - } + when (rowlen /= pqVariablesP rowp) $ + E.throwIO + DBException + { dbeQueryContext = ctx + , dbeError = + RowLengthMismatch + { lengthExpected = pqVariablesP rowp + , lengthDelivered = rowlen + } + , dbeCallStack = callStack + } alloca $ \err -> do n <- termCtr res let worker acc i = if i == n - then return acc - else do - -- mask asynchronous exceptions so they won't be wrapped in DBException - obj <- E.mask_ (g <$> fromRow res err 0 i `E.catch` rethrowWithContext ctx) - worker `apply` (f obj =<< acc) $ advCtr i + then return acc + else do + -- mask asynchronous exceptions so they won't be wrapped in DBException + obj <- E.mask_ (g <$> fromRow res err 0 i `E.catch` rethrowWithContext ctx) + worker `apply` (f obj =<< acc) $ advCtr i worker (pure iacc) =<< initCtr res where -- ⊥ of existential type hidden in QueryResult - row = let _ = g row in row - rowp = pure row + row = let _ = g row in row + rowp = pure row apply = if strict then ($!) else ($) diff --git a/src/Database/PostgreSQL/PQTypes/Internal/State.hs b/src/Database/PostgreSQL/PQTypes/Internal/State.hs index 6587bd6..1d23b3b 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/State.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/State.hs @@ -1,6 +1,6 @@ -- | Definition of internal DBT state. module Database.PostgreSQL.PQTypes.Internal.State - ( DBState(..) + ( DBState (..) , updateStateWith ) where @@ -15,26 +15,29 @@ import Database.PostgreSQL.PQTypes.Transaction.Settings -- | Internal DB state. data DBState m = DBState - { -- | Active connection. - dbConnection :: !Connection - -- | Supplied connection source. - , dbConnectionSource :: !(ConnectionSourceM m) - -- | Current transaction settings. + { dbConnection :: !Connection + -- ^ Active connection. + , dbConnectionSource :: !(ConnectionSourceM m) + -- ^ Supplied connection source. , dbTransactionSettings :: !TransactionSettings - -- | Last SQL query that was executed. - , dbLastQuery :: !SomeSQL - -- | Whether running query should override 'dbLastQuery'. - , dbRecordLastQuery :: !Bool - -- | Current query result. - , dbQueryResult :: !(forall row. FromRow row => Maybe (QueryResult row)) + -- ^ Current transaction settings. + , dbLastQuery :: !SomeSQL + -- ^ Last SQL query that was executed. + , dbRecordLastQuery :: !Bool + -- ^ Whether running query should override 'dbLastQuery'. + , dbQueryResult :: !(forall row. FromRow row => Maybe (QueryResult row)) + -- ^ Current query result. } updateStateWith :: IsSQL sql => DBState m -> sql -> ForeignPtr PGresult -> DBState m -updateStateWith st sql res = st - { dbLastQuery = if dbRecordLastQuery st then SomeSQL sql else dbLastQuery st - , dbQueryResult = Just QueryResult - { qrSQL = SomeSQL sql - , qrResult = res - , qrFromRow = id +updateStateWith st sql res = + st + { dbLastQuery = if dbRecordLastQuery st then SomeSQL sql else dbLastQuery st + , dbQueryResult = + Just + QueryResult + { qrSQL = SomeSQL sql + , qrResult = res + , qrFromRow = id + } } - } diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Utils.hs b/src/Database/PostgreSQL/PQTypes/Internal/Utils.hs index 94c6ef1..2b233ed 100644 --- a/src/Database/PostgreSQL/PQTypes/Internal/Utils.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Utils.hs @@ -1,5 +1,5 @@ -module Database.PostgreSQL.PQTypes.Internal.Utils ( - MkConstraint +module Database.PostgreSQL.PQTypes.Internal.Utils + ( MkConstraint , mread , safePeekCString , safePeekCString' @@ -15,9 +15,12 @@ module Database.PostgreSQL.PQTypes.Internal.Utils ( , unexpectedNULL ) where +import Control.Exception qualified as E import Control.Monad import Data.ByteString.Unsafe import Data.Kind (Type) +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Foreign.C import Foreign.ForeignPtr import Foreign.Marshal.Alloc @@ -25,16 +28,17 @@ import Foreign.Marshal.Utils import Foreign.Ptr import Foreign.Storable import GHC.Exts -import qualified Control.Exception as E -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Database.PostgreSQL.PQTypes.Internal.C.Interface import Database.PostgreSQL.PQTypes.Internal.C.Types import Database.PostgreSQL.PQTypes.Internal.Error -type family MkConstraint (m :: Type -> Type) - (cs :: [(Type -> Type) -> Constraint]) :: Constraint where +type family + MkConstraint + (m :: Type -> Type) + (cs :: [(Type -> Type) -> Constraint]) + :: Constraint + where MkConstraint m '[] = () MkConstraint m (c ': cs) = (c m, MkConstraint m cs) @@ -48,7 +52,7 @@ mread s = do safePeekCString :: CString -> IO (Maybe String) safePeekCString cs | cs == nullPtr = return Nothing - | otherwise = Just <$> peekCString cs + | otherwise = Just <$> peekCString cs -- | Safely peek C string and return "" if NULL. safePeekCString' :: CString -> IO String @@ -56,14 +60,15 @@ safePeekCString' cs = maybe "" id <$> safePeekCString cs -- | Convert C string to 'PGbytea'. cStringLenToBytea :: CStringLen -> PGbytea -cStringLenToBytea (cs, len) = PGbytea { - pgByteaLen = fromIntegral len -, pgByteaData = cs -} +cStringLenToBytea (cs, len) = + PGbytea + { pgByteaLen = fromIntegral len + , pgByteaData = cs + } -- | Convert 'PGbytea' to C string. byteaToCStringLen :: PGbytea -> CStringLen -byteaToCStringLen PGbytea{..} = (pgByteaData, fromIntegral pgByteaLen) +byteaToCStringLen PGbytea {..} = (pgByteaData, fromIntegral pgByteaLen) -- | Convert 'Text' to UTF-8 encoded C string wrapped by foreign pointer. textToCString :: T.Text -> IO (ForeignPtr CChar) @@ -71,14 +76,14 @@ textToCString bs = unsafeUseAsCStringLen (T.encodeUtf8 bs) $ \(cs, len) -> do fptr <- mallocForeignPtrBytes (len + 1) withForeignPtr fptr $ \ptr -> do copyBytes ptr cs len - pokeByteOff ptr len (0::CChar) + pokeByteOff ptr len (0 :: CChar) return fptr -- | Check return value of a function from libpqtypes -- and if it indicates an error, throw appropriate exception. verifyPQTRes :: Ptr PGerror -> String -> CInt -> IO () verifyPQTRes err ctx 0 = throwLibPQTypesError err ctx -verifyPQTRes _ _ _ = return () +verifyPQTRes _ _ _ = return () -- 'alloca'-like function for managing usage of 'PGparam' object. withPGparam :: Ptr PGconn -> (Ptr PGparam -> IO r) -> IO r @@ -96,23 +101,24 @@ withPGparam conn = E.bracket create c_PQparamClear throwLibPQError :: Ptr PGconn -> String -> IO a throwLibPQError conn ctx = do msg <- safePeekCString' =<< c_PQerrorMessage conn - E.throwIO . LibPQError - $ if null ctx then msg else ctx ++ ": " ++ msg + E.throwIO . LibPQError $ + if null ctx then msg else ctx ++ ": " ++ msg -- | Throw libpqtypes specific error. throwLibPQTypesError :: Ptr PGerror -> String -> IO a throwLibPQTypesError err ctx = do msg <- pgErrorMsg <$> peek err - E.throwIO . LibPQError - $ if null ctx then msg else ctx ++ ": " ++ msg + E.throwIO . LibPQError $ + if null ctx then msg else ctx ++ ": " ++ msg -- | Rethrow supplied exception enriched with array index. rethrowWithArrayError :: CInt -> E.SomeException -> IO a rethrowWithArrayError i (E.SomeException e) = - E.throwIO ArrayItemError { - arrItemIndex = fromIntegral i + 1 - , arrItemError = e - } + E.throwIO + ArrayItemError + { arrItemIndex = fromIntegral i + 1 + , arrItemError = e + } -- | Throw 'HPQTypesError exception. hpqTypesError :: String -> IO a diff --git a/src/Database/PostgreSQL/PQTypes/JSON.hs b/src/Database/PostgreSQL/PQTypes/JSON.hs index 6aa67ae..0d89825 100644 --- a/src/Database/PostgreSQL/PQTypes/JSON.hs +++ b/src/Database/PostgreSQL/PQTypes/JSON.hs @@ -1,16 +1,17 @@ {-# LANGUAGE TypeApplications #-} + module Database.PostgreSQL.PQTypes.JSON - ( JSON(..) - , JSONB(..) + ( JSON (..) + , JSONB (..) , aesonFromSQL , aesonToSQL ) where +import Control.Exception qualified as E import Data.Aeson +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy.Char8 qualified as BSL import Foreign.Ptr -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BSL import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromSQL @@ -18,7 +19,7 @@ import Database.PostgreSQL.PQTypes.Internal.C.Types import Database.PostgreSQL.PQTypes.ToSQL -- | Wrapper for (de)serializing underlying type as 'json'. -newtype JSON json = JSON { unJSON :: json } +newtype JSON json = JSON {unJSON :: json} deriving (Eq, Functor, Ord, Show) instance PQFormat (JSON json) where @@ -51,7 +52,7 @@ instance ToSQL (JSON Value) where ---------------------------------------- -- | Wrapper for (de)serializing underlying type as 'jsonb'. -newtype JSONB jsonb = JSONB { unJSONB :: jsonb } +newtype JSONB jsonb = JSONB {unJSONB :: jsonb} deriving (Eq, Functor, Ord, Show) instance PQFormat (JSONB jsonb) where diff --git a/src/Database/PostgreSQL/PQTypes/Notification.hs b/src/Database/PostgreSQL/PQTypes/Notification.hs index 703e825..2a6251f 100644 --- a/src/Database/PostgreSQL/PQTypes/Notification.hs +++ b/src/Database/PostgreSQL/PQTypes/Notification.hs @@ -1,6 +1,6 @@ -module Database.PostgreSQL.PQTypes.Notification ( - Channel(..) - , Notification(..) +module Database.PostgreSQL.PQTypes.Notification + ( Channel (..) + , Notification (..) , listen , unlisten , unlistenAll @@ -30,5 +30,6 @@ unlistenAll = runSQL_ "UNLISTEN *" -- | Generate a notification on a given channel. notify :: (HasCallStack, MonadDB m) => Channel -> Text -> m () -notify (Channel chan) payload = runQuery_ - $ rawSQL "SELECT pg_notify($1, $2)" (unRawSQL chan, payload) +notify (Channel chan) payload = + runQuery_ $ + rawSQL "SELECT pg_notify($1, $2)" (unRawSQL chan, payload) diff --git a/src/Database/PostgreSQL/PQTypes/SQL.hs b/src/Database/PostgreSQL/PQTypes/SQL.hs index 1fcc38e..c6cf836 100644 --- a/src/Database/PostgreSQL/PQTypes/SQL.hs +++ b/src/Database/PostgreSQL/PQTypes/SQL.hs @@ -1,6 +1,7 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.SQL ( - SQL + +module Database.PostgreSQL.PQTypes.SQL + ( SQL , mkSQL , sqlParam , () @@ -8,17 +9,17 @@ module Database.PostgreSQL.PQTypes.SQL ( ) where import Control.Concurrent.MVar +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Unsafe qualified as BS +import Data.Foldable qualified as F import Data.Monoid +import Data.Semigroup qualified as SG +import Data.Sequence qualified as S import Data.String +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Foreign.Marshal.Alloc import TextShow -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Unsafe as BS -import qualified Data.Foldable as F -import qualified Data.Semigroup as SG -import qualified Data.Sequence as S -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Data.Monoid.Utils import Database.PostgreSQL.PQTypes.Format @@ -29,7 +30,7 @@ import Database.PostgreSQL.PQTypes.ToSQL data SqlChunk where SqlString :: !T.Text -> SqlChunk - SqlParam :: forall t. (Show t, ToSQL t) => !t -> SqlChunk + SqlParam :: forall t. (Show t, ToSQL t) => !t -> SqlChunk -- | Primary SQL type that supports efficient -- concatenation and variable number of parameters. @@ -47,16 +48,16 @@ instance IsString SQL where instance IsSQL SQL where withSQL sql pa@(ParamAllocator allocParam) execute = do alloca $ \err -> allocParam $ \param -> do - nums <- newMVar (1::Int) + nums <- newMVar (1 :: Int) query <- T.concat <$> mapM (f param err nums) (unSQL sql) BS.useAsCString (T.encodeUtf8 query) (execute param) where f param err nums chunk = case chunk of SqlString s -> return s - SqlParam (v::t) -> toSQL v pa $ \base -> + SqlParam (v :: t) -> toSQL v pa $ \base -> BS.unsafeUseAsCString (pqFormat0 @t) $ \fmt -> do verifyPQTRes err "withSQL (SQL)" =<< c_PQputf1 param err fmt base - modifyMVar nums $ \n -> return . (, "$" <> showt n) $! n+1 + modifyMVar nums $ \n -> return . (,"$" <> showt n) $! n + 1 instance SG.Semigroup SQL where SQL a <> SQL b = SQL (a S.>< b) @@ -85,9 +86,9 @@ sqlParam = SQL . S.singleton . SqlParam -- -- > f :: Int32 -> String -> SQL -- > f idx name = "SELECT foo FROM bar WHERE id =" idx <+> "AND name =" name --- () :: (Show t, ToSQL t) => SQL -> t -> SQL s v = s <+> sqlParam v + infixr 7 ---------------------------------------- @@ -97,4 +98,4 @@ isSqlEmpty :: SQL -> Bool isSqlEmpty (SQL chunks) = getAll $ F.foldMap (All . cmp) chunks where cmp (SqlString s) = s == T.empty - cmp (SqlParam _) = False + cmp (SqlParam _) = False diff --git a/src/Database/PostgreSQL/PQTypes/SQL/Class.hs b/src/Database/PostgreSQL/PQTypes/SQL/Class.hs index 3b9c0e9..6fa07fd 100644 --- a/src/Database/PostgreSQL/PQTypes/SQL/Class.hs +++ b/src/Database/PostgreSQL/PQTypes/SQL/Class.hs @@ -1,6 +1,6 @@ -module Database.PostgreSQL.PQTypes.SQL.Class ( - SomeSQL(..) - , IsSQL(..) +module Database.PostgreSQL.PQTypes.SQL.Class + ( SomeSQL (..) + , IsSQL (..) , unsafeSQL ) where @@ -18,12 +18,15 @@ data SomeSQL = forall sql. IsSQL sql => SomeSQL sql class Show sql => IsSQL sql where -- | Convert 'sql' to libpqtypes representation and pass -- it to supplied continuation (usually for execution). - withSQL :: sql - -> ParamAllocator -- ^ 'PGparam' allocator. - -> (Ptr PGparam -> CString -> IO r) -- ^ Continuation which takes 'sql' - -- converted to libpqtypes specific representation, ie. 'PGparam' object - -- containing query parameters and C string containing the query itself. - -> IO r + withSQL + :: sql + -> ParamAllocator + -- ^ 'PGparam' allocator. + -> (Ptr PGparam -> CString -> IO r) + -- ^ Continuation which takes 'sql' + -- converted to libpqtypes specific representation, ie. 'PGparam' object + -- containing query parameters and C string containing the query itself. + -> IO r ---------------------------------------- diff --git a/src/Database/PostgreSQL/PQTypes/SQL/Raw.hs b/src/Database/PostgreSQL/PQTypes/SQL/Raw.hs index d13163f..fa078bf 100644 --- a/src/Database/PostgreSQL/PQTypes/SQL/Raw.hs +++ b/src/Database/PostgreSQL/PQTypes/SQL/Raw.hs @@ -1,15 +1,15 @@ -module Database.PostgreSQL.PQTypes.SQL.Raw ( - RawSQL +module Database.PostgreSQL.PQTypes.SQL.Raw + ( RawSQL , rawSQL , unRawSQL ) where +import Data.ByteString.Char8 qualified as BS +import Data.Semigroup qualified as SG import Data.String +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Foreign.Marshal.Alloc -import qualified Data.ByteString.Char8 as BS -import qualified Data.Semigroup as SG -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Database.PostgreSQL.PQTypes.SQL.Class import Database.PostgreSQL.PQTypes.ToRow diff --git a/src/Database/PostgreSQL/PQTypes/ToRow.hs b/src/Database/PostgreSQL/PQTypes/ToRow.hs index 29ca7cc..b932fec 100644 --- a/src/Database/PostgreSQL/PQTypes/ToRow.hs +++ b/src/Database/PostgreSQL/PQTypes/ToRow.hs @@ -1,14 +1,15 @@ {-# LANGUAGE TypeApplications #-} -module Database.PostgreSQL.PQTypes.ToRow ( - ToRow(..) + +module Database.PostgreSQL.PQTypes.ToRow + ( ToRow (..) , toRow' ) where +import Data.ByteString.Unsafe qualified as BS import Data.Functor.Identity import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr -import qualified Data.ByteString.Unsafe as BS import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.Internal.C.Put @@ -33,14 +34,21 @@ toRow' row pa param = alloca $ \err -> toRow row pa param err -- | Class which represents \"from Haskell tuple to SQL row\" transformation. class PQFormat row => ToRow row where -- | Put supplied tuple into 'PGparam' using given format string. - toRow :: row -- ^ Tuple to be put into 'PGparam'. - -> ParamAllocator -- ^ 'PGparam' allocator for 'toSQL'. - -> Ptr PGparam -- ^ 'PGparam' to put tuple into. - -> Ptr PGerror -- ^ Local error info. - -> IO () + toRow + :: row + -- ^ Tuple to be put into 'PGparam'. + -> ParamAllocator + -- ^ 'PGparam' allocator for 'toSQL'. + -> Ptr PGparam + -- ^ 'PGparam' to put tuple into. + -> Ptr PGerror + -- ^ Local error info. + -> IO () + +{- FOURMOLU_DISABLE -} -instance ( - ToRow row1, ToRow row2 +instance + ( ToRow row1, ToRow row2 ) => ToRow (row1 :*: row2) where toRow (row1 :*: row2) pa param err = do toRow row1 pa param err @@ -55,8 +63,8 @@ instance ToSQL t => ToRow (Identity t) where where Identity t = row -instance ( - ToSQL t1, ToSQL t2 +instance + ( ToSQL t1, ToSQL t2 ) => ToRow (t1, t2) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> @@ -64,8 +72,8 @@ instance ( where (t1, t2) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3 ) => ToRow (t1, t2, t3) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> toSQL t3 pa $ \p3 -> @@ -73,8 +81,8 @@ instance ( where (t1, t2, t3) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4 ) => ToRow (t1, t2, t3, t4) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> toSQL t3 pa $ \p3 -> @@ -83,8 +91,8 @@ instance ( where (t1, t2, t3, t4) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5 ) => ToRow (t1, t2, t3, t4, t5) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> toSQL t3 pa $ \p3 -> @@ -93,8 +101,8 @@ instance ( where (t1, t2, t3, t4, t5) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6 ) => ToRow (t1, t2, t3, t4, t5, t6) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> toSQL t3 pa $ \p3 -> @@ -103,8 +111,8 @@ instance ( where (t1, t2, t3, t4, t5, t6) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 ) => ToRow (t1, t2, t3, t4, t5, t6, t7) where toRow row pa param err = withFormat row $ \fmt -> toSQL t1 pa $ \p1 -> toSQL t2 pa $ \p2 -> toSQL t3 pa $ \p3 -> @@ -114,8 +122,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8) where toRow row pa param err = withFormat row $ \fmt -> @@ -126,8 +134,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9) where toRow row pa param err = withFormat row $ \fmt -> @@ -138,8 +146,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) where toRow row pa param err = withFormat row $ \fmt -> @@ -151,8 +159,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11) where toRow row pa param err = withFormat row $ \fmt -> @@ -164,8 +172,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12) where toRow row pa param err = withFormat row $ \fmt -> @@ -177,8 +185,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13) where toRow row pa param err = withFormat row $ \fmt -> @@ -191,8 +199,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14) where toRow row pa param err = withFormat row $ \fmt -> @@ -205,8 +213,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15) where @@ -220,8 +228,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16) where @@ -236,8 +244,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17) where @@ -252,8 +260,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18) where @@ -268,8 +276,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19) where @@ -285,8 +293,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20) where @@ -302,8 +310,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 ) => ToRow (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21) where @@ -319,8 +327,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22 @@ -338,8 +346,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23 @@ -357,8 +365,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24 @@ -376,8 +384,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25 @@ -396,8 +404,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26 @@ -416,8 +424,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27 @@ -436,8 +444,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -457,8 +465,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -479,8 +487,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -501,8 +509,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -524,8 +532,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -547,8 +555,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -570,8 +578,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -594,8 +602,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -618,8 +626,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -643,8 +651,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -669,8 +677,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -695,8 +703,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -721,8 +729,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -748,8 +756,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -775,8 +783,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -802,8 +810,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -831,8 +839,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -860,8 +868,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -889,8 +897,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -919,8 +927,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -949,8 +957,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -979,8 +987,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47, t48) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 @@ -1010,8 +1018,8 @@ instance ( where (t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, t26, t27, t28, t29, t30, t31, t32, t33, t34, t35, t36, t37, t38, t39, t40, t41, t42, t43, t44, t45, t46, t47, t48, t49) = row -instance ( - ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 +instance + ( ToSQL t1, ToSQL t2, ToSQL t3, ToSQL t4, ToSQL t5, ToSQL t6, ToSQL t7 , ToSQL t8, ToSQL t9, ToSQL t10, ToSQL t11, ToSQL t12, ToSQL t13, ToSQL t14 , ToSQL t15, ToSQL t16, ToSQL t17, ToSQL t18, ToSQL t19, ToSQL t20, ToSQL t21 , ToSQL t22, ToSQL t23, ToSQL t24, ToSQL t25, ToSQL t26, ToSQL t27, ToSQL t28 diff --git a/src/Database/PostgreSQL/PQTypes/ToSQL.hs b/src/Database/PostgreSQL/PQTypes/ToSQL.hs index 54f61ce..061a3e2 100644 --- a/src/Database/PostgreSQL/PQTypes/ToSQL.hs +++ b/src/Database/PostgreSQL/PQTypes/ToSQL.hs @@ -1,24 +1,24 @@ -module Database.PostgreSQL.PQTypes.ToSQL ( - ParamAllocator(..) - , ToSQL(..) +module Database.PostgreSQL.PQTypes.ToSQL + ( ParamAllocator (..) + , ToSQL (..) , putAsPtr ) where +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy.Char8 qualified as BSL import Data.ByteString.Unsafe import Data.Int import Data.Kind (Type) +import Data.Text qualified as T import Data.Text.Encoding +import Data.Text.Lazy qualified as TL import Data.Time +import Data.UUID.Types qualified as U import Data.Word import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as BSL -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.UUID.Types as U import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.Internal.C.Interface @@ -33,12 +33,17 @@ newtype ParamAllocator = ParamAllocator (forall r. (Ptr PGparam -> IO r) -> IO r class PQFormat t => ToSQL t where -- | Destination type (used by libpqtypes). type PQDest t :: Type + -- | Put supplied value into inner 'PGparam'. - toSQL :: t -- ^ Value to be put. - -> ParamAllocator -- ^ 'PGparam' allocator. - -> (Ptr (PQDest t) -> IO r) -- ^ Continuation that puts - -- converted value into inner 'PGparam'. - -> IO r + toSQL + :: t + -- ^ Value to be put. + -> ParamAllocator + -- ^ 'PGparam' allocator. + -> (Ptr (PQDest t) -> IO r) + -- ^ Continuation that puts + -- converted value into inner 'PGparam'. + -> IO r -- | Function that abstracts away common elements of most 'ToSQL' -- instance definitions to make them easier to write and less verbose. @@ -51,7 +56,7 @@ instance ToSQL t => ToSQL (Maybe t) where type PQDest (Maybe t) = PQDest t toSQL mt allocParam conv = case mt of Nothing -> conv nullPtr - Just t -> toSQL t allocParam conv + Just t -> toSQL t allocParam conv -- NUMERICS @@ -153,65 +158,74 @@ instance ToSQL TimeOfDay where instance ToSQL LocalTime where type PQDest LocalTime = PGtimestamp - toSQL LocalTime{..} _ = putAsPtr PGtimestamp { - pgTimestampEpoch = 0 - , pgTimestampDate = dayToPGdate localDay - , pgTimestampTime = timeOfDayToPGtime localTimeOfDay - } + toSQL LocalTime {..} _ = + putAsPtr + PGtimestamp + { pgTimestampEpoch = 0 + , pgTimestampDate = dayToPGdate localDay + , pgTimestampTime = timeOfDayToPGtime localTimeOfDay + } -- TIMESTAMPTZ instance ToSQL UTCTime where type PQDest UTCTime = PGtimestamp - toSQL UTCTime{..} _ = putAsPtr PGtimestamp { - pgTimestampEpoch = 0 - , pgTimestampDate = dayToPGdate utctDay - , pgTimestampTime = timeOfDayToPGtime $ timeToTimeOfDay utctDayTime - } + toSQL UTCTime {..} _ = + putAsPtr + PGtimestamp + { pgTimestampEpoch = 0 + , pgTimestampDate = dayToPGdate utctDay + , pgTimestampTime = timeOfDayToPGtime $ timeToTimeOfDay utctDayTime + } instance ToSQL ZonedTime where type PQDest ZonedTime = PGtimestamp - toSQL ZonedTime{..} _ = putAsPtr PGtimestamp { - pgTimestampEpoch = 0 - , pgTimestampDate = dayToPGdate $ localDay zonedTimeToLocalTime - , pgTimestampTime = (timeOfDayToPGtime $ localTimeOfDay zonedTimeToLocalTime) { - pgTimeGMTOff = fromIntegral (timeZoneMinutes zonedTimeZone) * 60 - } - } + toSQL ZonedTime {..} _ = + putAsPtr + PGtimestamp + { pgTimestampEpoch = 0 + , pgTimestampDate = dayToPGdate $ localDay zonedTimeToLocalTime + , pgTimestampTime = + (timeOfDayToPGtime $ localTimeOfDay zonedTimeToLocalTime) + { pgTimeGMTOff = fromIntegral (timeZoneMinutes zonedTimeZone) * 60 + } + } -- BOOL instance ToSQL Bool where type PQDest Bool = CInt - toSQL True _ = putAsPtr 1 + toSQL True _ = putAsPtr 1 toSQL False _ = putAsPtr 0 ---------------------------------------- timeOfDayToPGtime :: TimeOfDay -> PGtime -timeOfDayToPGtime TimeOfDay{..} = PGtime { - pgTimeHour = fromIntegral todHour - , pgTimeMin = fromIntegral todMin - , pgTimeSec = sec - , pgTimeUSec = usec - , pgTimeWithTZ = 0 - , pgTimeIsDST = 0 - , pgTimeGMTOff = 0 - , pgTimeTZAbbr = BS.empty - } +timeOfDayToPGtime TimeOfDay {..} = + PGtime + { pgTimeHour = fromIntegral todHour + , pgTimeMin = fromIntegral todMin + , pgTimeSec = sec + , pgTimeUSec = usec + , pgTimeWithTZ = 0 + , pgTimeIsDST = 0 + , pgTimeGMTOff = 0 + , pgTimeTZAbbr = BS.empty + } where (sec, usec) = floor ((toRational todSec) * 1000000) `divMod` 1000000 dayToPGdate :: Day -> PGdate -dayToPGdate day = PGdate { - pgDateIsBC = isBC - , pgDateYear = fromIntegral $ adjustBC year - , pgDateMon = fromIntegral $ mon - 1 - , pgDateMDay = fromIntegral mday - , pgDateJDay = 0 - , pgDateYDay = 0 - , pgDateWDay = 0 - } +dayToPGdate day = + PGdate + { pgDateIsBC = isBC + , pgDateYear = fromIntegral $ adjustBC year + , pgDateMon = fromIntegral $ mon - 1 + , pgDateMDay = fromIntegral mday + , pgDateJDay = 0 + , pgDateYDay = 0 + , pgDateWDay = 0 + } where (year, mon, mday) = toGregorian day diff --git a/src/Database/PostgreSQL/PQTypes/Transaction.hs b/src/Database/PostgreSQL/PQTypes/Transaction.hs index 559ea5a..bfff3c7 100644 --- a/src/Database/PostgreSQL/PQTypes/Transaction.hs +++ b/src/Database/PostgreSQL/PQTypes/Transaction.hs @@ -1,5 +1,5 @@ -module Database.PostgreSQL.PQTypes.Transaction ( - Savepoint(..) +module Database.PostgreSQL.PQTypes.Transaction + ( Savepoint (..) , withSavepoint , withTransaction , begin @@ -37,13 +37,15 @@ instance IsString Savepoint where -- -- See withSavepoint :: (HasCallStack, MonadDB m, MonadMask m) => Savepoint -> m a -> m a -withSavepoint (Savepoint savepoint) m = fst <$> generalBracket - (runQuery_ $ "SAVEPOINT" <+> savepoint) - (\() -> \case - ExitCaseSuccess _ -> runQuery_ sqlReleaseSavepoint - _ -> rollbackAndReleaseSavepoint - ) - (\() -> m) +withSavepoint (Savepoint savepoint) m = + fst + <$> generalBracket + (runQuery_ $ "SAVEPOINT" <+> savepoint) + ( \() -> \case + ExitCaseSuccess _ -> runQuery_ sqlReleaseSavepoint + _ -> rollbackAndReleaseSavepoint + ) + (\() -> m) where sqlReleaseSavepoint = "RELEASE SAVEPOINT" <+> savepoint rollbackAndReleaseSavepoint = do @@ -78,34 +80,40 @@ rollback = getTransactionSettings >>= rollback' -- | Execute monadic action within a transaction using given transaction -- settings. Note that it won't work as expected if a transaction is already -- active (in such case 'withSavepoint' should be used instead). -withTransaction' :: (HasCallStack, MonadDB m, MonadMask m) - => TransactionSettings -> m a -> m a +withTransaction' + :: (HasCallStack, MonadDB m, MonadMask m) + => TransactionSettings + -> m a + -> m a withTransaction' ts m = (`fix` 1) $ \loop n -> do -- Optimization for squashing possible space leaks. -- It looks like GHC doesn't like 'catch' and passes -- on introducing strictness in some cases. let maybeRestart = case tsRestartPredicate ts of - Just _ -> handleJust (expred n) (\_ -> loop $ n+1) + Just _ -> handleJust (expred n) (\_ -> loop $ n + 1) Nothing -> id - maybeRestart $ fst <$> generalBracket - (begin' ts) - (\() -> \case - ExitCaseSuccess _ -> commit' ts - _ -> rollback' ts - ) - (\() -> m) + maybeRestart $ + fst + <$> generalBracket + (begin' ts) + ( \() -> \case + ExitCaseSuccess _ -> commit' ts + _ -> rollback' ts + ) + (\() -> m) where expred :: Integer -> SomeException -> Maybe () expred !n e = do -- check if the predicate exists RestartPredicate f <- tsRestartPredicate ts -- cast exception to the type expected by the predicate - err <- msum [ - -- either cast the exception itself... - fromException e - -- ...or extract it from DBException - , fromException e >>= \DBException{..} -> cast dbeError - ] + err <- + msum + [ -- either cast the exception itself... + fromException e + , -- ...or extract it from DBException + fromException e >>= \DBException {..} -> cast dbeError + ] -- check if the predicate allows for the restart guard $ f err n @@ -114,14 +122,14 @@ begin' :: (HasCallStack, MonadDB m) => TransactionSettings -> m () begin' ts = runSQL_ . mintercalate " " $ ["BEGIN", isolationLevel, permissions] where isolationLevel = case tsIsolationLevel ts of - DefaultLevel -> "" - ReadCommitted -> "ISOLATION LEVEL READ COMMITTED" + DefaultLevel -> "" + ReadCommitted -> "ISOLATION LEVEL READ COMMITTED" RepeatableRead -> "ISOLATION LEVEL REPEATABLE READ" - Serializable -> "ISOLATION LEVEL SERIALIZABLE" + Serializable -> "ISOLATION LEVEL SERIALIZABLE" permissions = case tsPermissions ts of DefaultPermissions -> "" - ReadOnly -> "READ ONLY" - ReadWrite -> "READ WRITE" + ReadOnly -> "READ ONLY" + ReadWrite -> "READ WRITE" -- | Commit active transaction using given transaction settings. commit' :: (HasCallStack, MonadDB m) => TransactionSettings -> m () diff --git a/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs b/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs index 70cb991..58a4439 100644 --- a/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs +++ b/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs @@ -1,41 +1,44 @@ -module Database.PostgreSQL.PQTypes.Transaction.Settings ( - RestartPredicate(..) - , TransactionSettings(..) - , IsolationLevel(..) - , Permissions(..) +module Database.PostgreSQL.PQTypes.Transaction.Settings + ( RestartPredicate (..) + , TransactionSettings (..) + , IsolationLevel (..) + , Permissions (..) , defaultTransactionSettings ) where -import qualified Control.Exception as E +import Control.Exception qualified as E -- | Predicate that determines whether the transaction has to be restarted. -data RestartPredicate = forall e. E.Exception e - => RestartPredicate (e -> Integer -> Bool) +data RestartPredicate + = forall e. + E.Exception e => + RestartPredicate (e -> Integer -> Bool) instance Show RestartPredicate where - showsPrec _ RestartPredicate{} = (++) "RestartPredicate" + showsPrec _ RestartPredicate {} = (++) "RestartPredicate" data TransactionSettings = TransactionSettings - { -- | If set to True, transaction will be automatically started at the - -- beginning of database action and after each 'commit' / 'rollback'. If - -- set to False, no transaction will automatically start in either of above - -- cases. - tsAutoTransaction :: !Bool - -- | Isolation level of all transactions. - , tsIsolationLevel :: !IsolationLevel - -- | Defines behavior of 'withTransaction' in case exceptions thrown within - -- supplied monadic action are not caught and reach its body. If set to - -- 'Nothing', exceptions will be propagated as usual. If set to 'Just' f, - -- exceptions will be intercepted and passed to f along with a number that - -- indicates how many times the transaction block already failed. If f - -- returns 'True', the transaction is restarted. Otherwise the exception is - -- further propagated. This allows for restarting transactions e.g. in case - -- of serialization failure. It is up to the caller to ensure that is it - -- safe to execute supplied monadic action multiple times. + { tsAutoTransaction :: !Bool + -- ^ If set to True, transaction will be automatically started at the + -- beginning of database action and after each 'commit' / 'rollback'. If + -- set to False, no transaction will automatically start in either of above + -- cases. + , tsIsolationLevel :: !IsolationLevel + -- ^ Isolation level of all transactions. , tsRestartPredicate :: !(Maybe RestartPredicate) - -- | Permissions of all transactions. - , tsPermissions :: !Permissions - } deriving Show + -- ^ Defines behavior of 'withTransaction' in case exceptions thrown within + -- supplied monadic action are not caught and reach its body. If set to + -- 'Nothing', exceptions will be propagated as usual. If set to 'Just' f, + -- exceptions will be intercepted and passed to f along with a number that + -- indicates how many times the transaction block already failed. If f + -- returns 'True', the transaction is restarted. Otherwise the exception is + -- further propagated. This allows for restarting transactions e.g. in case + -- of serialization failure. It is up to the caller to ensure that is it + -- safe to execute supplied monadic action multiple times. + , tsPermissions :: !Permissions + -- ^ Permissions of all transactions. + } + deriving (Show) data IsolationLevel = DefaultLevel | ReadCommitted | RepeatableRead | Serializable deriving (Eq, Ord, Show) @@ -47,8 +50,8 @@ data Permissions = DefaultPermissions | ReadOnly | ReadWrite defaultTransactionSettings :: TransactionSettings defaultTransactionSettings = TransactionSettings - { tsAutoTransaction = True - , tsIsolationLevel = DefaultLevel - , tsRestartPredicate = Nothing - , tsPermissions = DefaultPermissions - } + { tsAutoTransaction = True + , tsIsolationLevel = DefaultLevel + , tsRestartPredicate = Nothing + , tsPermissions = DefaultPermissions + } diff --git a/src/Database/PostgreSQL/PQTypes/Utils.hs b/src/Database/PostgreSQL/PQTypes/Utils.hs index af26a3e..bfa291c 100644 --- a/src/Database/PostgreSQL/PQTypes/Utils.hs +++ b/src/Database/PostgreSQL/PQTypes/Utils.hs @@ -1,5 +1,5 @@ -module Database.PostgreSQL.PQTypes.Utils ( - throwDB +module Database.PostgreSQL.PQTypes.Utils + ( throwDB , raw , runQuery_ , runQuery01 @@ -35,14 +35,15 @@ import Database.PostgreSQL.PQTypes.SQL.Raw -- wrap it in 'DBException' with the current query context first. throwDB :: (HasCallStack, Exception e, MonadDB m, MonadThrow m) => e -> m a throwDB e = case fromException $ toException e of - Just (dbe::DBException) -> throwM dbe + Just (dbe :: DBException) -> throwM dbe Nothing -> do SomeSQL sql <- getLastQuery - throwM DBException { - dbeQueryContext = sql - , dbeError = e - , dbeCallStack = callStack - } + throwM + DBException + { dbeQueryContext = sql + , dbeError = e + , dbeCallStack = callStack + } ---------------------------------------- @@ -62,10 +63,12 @@ runQuery_ = withFrozenCallStack $ void . runQuery runQuery01 :: (HasCallStack, IsSQL sql, MonadDB m, MonadThrow m) => sql -> m Bool runQuery01 sql = withFrozenCallStack $ do n <- runQuery sql - when (n > 1) $ throwDB AffectedRowsMismatch { - rowsExpected = [(0, 1)] - , rowsDelivered = n - } + when (n > 1) $ + throwDB + AffectedRowsMismatch + { rowsExpected = [(0, 1)] + , rowsDelivered = n + } return $ n == 1 -- | Specialization of 'runQuery01' that discards the result. @@ -106,10 +109,12 @@ runPreparedQuery01 -> m Bool runPreparedQuery01 name sql = withFrozenCallStack $ do n <- runPreparedQuery name sql - when (n > 1) $ throwDB AffectedRowsMismatch { - rowsExpected = [(0, 1)] - , rowsDelivered = n - } + when (n > 1) $ + throwDB + AffectedRowsMismatch + { rowsExpected = [(0, 1)] + , rowsDelivered = n + } return $ n == 1 -- | Specialization of 'runPreparedQuery01' that discards the result. diff --git a/src/Database/PostgreSQL/PQTypes/XML.hs b/src/Database/PostgreSQL/PQTypes/XML.hs index 0e1b7e7..1e13074 100644 --- a/src/Database/PostgreSQL/PQTypes/XML.hs +++ b/src/Database/PostgreSQL/PQTypes/XML.hs @@ -1,9 +1,9 @@ -module Database.PostgreSQL.PQTypes.XML ( - XML(..) +module Database.PostgreSQL.PQTypes.XML + ( XML (..) ) where +import Data.ByteString.Char8 qualified as BSC import Data.Text -import qualified Data.ByteString.Char8 as BSC import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromSQL @@ -12,7 +12,7 @@ import Database.PostgreSQL.PQTypes.ToSQL -- | Representation of SQL XML types as 'Text'. Users of hpqtypes may -- want to add conversion instances for their favorite XML type around 'XML'. -newtype XML = XML { unXML :: Text } +newtype XML = XML {unXML :: Text} deriving (Eq, Ord, Read, Show) instance PQFormat XML where diff --git a/test/Main.hs b/test/Main.hs index 49d1234..8e6315b 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,19 +1,24 @@ {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} + module Main where import Control.Concurrent.Lifted import Control.Monad import Control.Monad.Base import Control.Monad.Catch +import Control.Monad.State qualified as S import Control.Monad.Trans.Control import Data.Aeson hiding (()) +import Data.ByteString qualified as BS import Data.Char import Data.Function import Data.Int import Data.Maybe +import Data.Text qualified as T import Data.Time import Data.Typeable +import Data.UUID.Types qualified as U import Data.Word import System.Environment import System.Exit @@ -26,10 +31,6 @@ import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.Random import TextShow -import qualified Control.Monad.State as S -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.UUID.Types as U import Data.Monoid.Utils import Database.PostgreSQL.PQTypes @@ -39,14 +40,23 @@ import Test.QuickCheck.Arbitrary.Instances type InnerTestEnv = S.StateT QCGen (DBT IO) -newtype TestEnv a = TestEnv { unTestEnv :: InnerTestEnv a } - deriving ( Applicative, Functor, Monad, MonadFail - , MonadBase IO, MonadCatch, MonadDB, MonadMask, MonadThrow) +newtype TestEnv a = TestEnv {unTestEnv :: InnerTestEnv a} + deriving + ( Applicative + , Functor + , Monad + , MonadFail + , MonadBase IO + , MonadCatch + , MonadDB + , MonadMask + , MonadThrow + ) instance MonadBaseControl IO TestEnv where type StM TestEnv a = StM InnerTestEnv a liftBaseWith f = TestEnv $ liftBaseWith $ \run -> - f $ run . unTestEnv + f $ run . unTestEnv restoreM = TestEnv . restoreM withQCGen :: (QCGen -> r) -> TestEnv r @@ -66,11 +76,11 @@ runTestEnv (env, connSettings) ts m = runDBT cs ts $ S.evalStateT (unTestEnv m) runTimes :: Monad m => Int -> m () -> m () runTimes !n m = case n of 0 -> return () - _ -> m >> runTimes (n-1) m + _ -> m >> runTimes (n - 1) m ---------------------------------------- -newtype AsciiChar = AsciiChar { unAsciiChar :: Char } +newtype AsciiChar = AsciiChar {unAsciiChar :: Char} deriving (Eq, Show) instance PQFormat AsciiChar where @@ -87,18 +97,19 @@ instance FromSQL AsciiChar where instance Arbitrary AsciiChar where -- QuickCheck >= 2.10 changed Arbitrary Char instance to include proper -- Unicode CharS, but PostgreSQL only accepts ASCII ones. - arbitrary = AsciiChar . chr <$> oneof [choose (0,127), choose (0,255)] - shrink = map AsciiChar . shrink . unAsciiChar + arbitrary = AsciiChar . chr <$> oneof [choose (0, 127), choose (0, 255)] + shrink = map AsciiChar . shrink . unAsciiChar instance Arbitrary Interval where - arbitrary = Interval - <$> abs `fmap` arbitrary - <*> choose (0, 11) - <*> choose (0, 364) - <*> choose (0, 23) - <*> choose (0, 59) - <*> choose (0, 59) - <*> choose (0, 999999) + arbitrary = + Interval + <$> abs `fmap` arbitrary + <*> choose (0, 11) + <*> choose (0, 364) + <*> choose (0, 23) + <*> choose (0, 59) + <*> choose (0, 59) + <*> choose (0, 999999) instance (Arbitrary a1, Arbitrary a2) => Arbitrary (a1 :*: a2) where arbitrary = (:*:) <$> arbitrary <*> arbitrary @@ -172,23 +183,26 @@ epsilon :: Fractional a => a epsilon = 0.00001 eqTOD :: TimeOfDay -> TimeOfDay -> Bool -eqTOD a b = and [ - todHour a == todHour b - , todMin a == todMin b - , abs (todSec a - todSec b) < epsilon - ] +eqTOD a b = + and + [ todHour a == todHour b + , todMin a == todMin b + , abs (todSec a - todSec b) < epsilon + ] eqLT :: LocalTime -> LocalTime -> Bool -eqLT a b = and [ - localDay a == localDay b - , localTimeOfDay a `eqTOD` localTimeOfDay b - ] +eqLT a b = + and + [ localDay a == localDay b + , localTimeOfDay a `eqTOD` localTimeOfDay b + ] eqUTCT :: UTCTime -> UTCTime -> Bool -eqUTCT a b = and [ - utctDay a == utctDay b - , abs (utctDayTime a - utctDayTime b) < epsilon - ] +eqUTCT a b = + and + [ utctDay a == utctDay b + , abs (utctDayTime a - utctDayTime b) < epsilon + ] eqZT :: ZonedTime -> ZonedTime -> Bool eqZT a b = zonedTimeToUTC a `eqUTCT` zonedTimeToUTC b @@ -206,20 +220,26 @@ eqCompositeArray2 a b = a == b ---------------------------------------- tsNoTrans :: TransactionSettings -tsNoTrans = defaultTransactionSettings { tsAutoTransaction = False } +tsNoTrans = defaultTransactionSettings {tsAutoTransaction = False} randomValue :: Arbitrary t => Int -> TestEnv t randomValue n = withQCGen $ \gen -> unGen arbitrary gen n -assertEqual :: (Show a, MonadBase IO m) - => String -> a -> a -> (a -> a -> Bool) -> m () +assertEqual + :: (Show a, MonadBase IO m) + => String + -> a + -> a + -> (a -> a -> Bool) + -> m () assertEqual preface expected actual eq = liftBase $ unless (actual `eq` expected) (assertFailure msg) where - msg = concat [ - if null preface then "" else preface ++ "\n" - , "expected: " ++ show expected ++ "\n but got: " ++ show actual - ] + msg = + concat + [ if null preface then "" else preface ++ "\n" + , "expected: " ++ show expected ++ "\n but got: " ++ show actual + ] assertEqualEq :: (Eq a, Show a, MonadBase IO m) => String -> a -> a -> m () assertEqualEq preface expected actual = assertEqual preface expected actual (==) @@ -227,63 +247,71 @@ assertEqualEq preface expected actual = assertEqual preface expected actual (==) ---------------------------------------- sqlGenInts :: Int32 -> SQL -sqlGenInts n = smconcat - [ "WITH RECURSIVE ints(n) AS" - , "( VALUES (1) UNION ALL SELECT n+1 FROM ints WHERE n <" n - , ") SELECT n FROM ints" - ] +sqlGenInts n = + smconcat + [ "WITH RECURSIVE ints(n) AS" + , "( VALUES (1) UNION ALL SELECT n+1 FROM ints WHERE n <" n + , ") SELECT n FROM ints" + ] cursorTest :: TestData -> Test -cursorTest td = testGroup "Cursors" - [ basicCursorWorks - , scrollableCursorWorks - , withHoldCursorWorks - , doubleCloseWorks - ] +cursorTest td = + testGroup + "Cursors" + [ basicCursorWorks + , scrollableCursorWorks + , withHoldCursorWorks + , doubleCloseWorks + ] where basicCursorWorks = testCase "Basic cursor works" $ do runTestEnv td defaultTransactionSettings $ do withCursor "ints" NoScroll NoHold (sqlGenInts 5) $ \cursor -> do - xs <- (`fix` []) $ \loop acc -> cursorFetch cursor CD_Next >>= \case - 0 -> return $ reverse acc - 1 -> do - (n::Int32) <- fetchOne runIdentity - loop $ n : acc - n -> error $ "Unexpected number of rows: " ++ show n - assertEqualEq "Data fetched correctly" [1..5] xs + xs <- (`fix` []) $ \loop acc -> + cursorFetch cursor CD_Next >>= \case + 0 -> return $ reverse acc + 1 -> do + (n :: Int32) <- fetchOne runIdentity + loop $ n : acc + n -> error $ "Unexpected number of rows: " ++ show n + assertEqualEq "Data fetched correctly" [1 .. 5] xs scrollableCursorWorks = testCase "Cursor declared as SCROLL works" $ do runTestEnv td defaultTransactionSettings $ do withCursor "ints" Scroll NoHold (sqlGenInts 10) $ \cursor -> do - checkMove cursor CD_Next 1 - checkMove cursor CD_Prior 0 - checkMove cursor CD_First 1 - checkMove cursor CD_Last 1 + checkMove cursor CD_Next 1 + checkMove cursor CD_Prior 0 + checkMove cursor CD_First 1 + checkMove cursor CD_Last 1 checkMove cursor CD_Backward_All 9 - checkMove cursor CD_Forward_All 10 + checkMove cursor CD_Forward_All 10 checkMove cursor (CD_Absolute 0) 0 checkMove cursor (CD_Relative 0) 0 - checkMove cursor (CD_Forward 5) 5 + checkMove cursor (CD_Forward 5) 5 checkMove cursor (CD_Backward 5) 4 cursorFetch_ cursor CD_Forward_All - xs1::[Int32] <- fetchMany runIdentity - assertEqualEq "xs1 is correct" [1..10] xs1 + xs1 :: [Int32] <- fetchMany runIdentity + assertEqualEq "xs1 is correct" [1 .. 10] xs1 cursorFetch_ cursor CD_Backward_All - xs2::[Int32] <- fetchMany runIdentity - assertEqualEq "xs2 is correct" (reverse [1..10]) xs2 + xs2 :: [Int32] <- fetchMany runIdentity + assertEqualEq "xs2 is correct" (reverse [1 .. 10]) xs2 where checkMove cursor cd expected = do moved <- cursorMove cursor cd - assertEqualEq ("Moving cursor with" <+> show cd - <+> "would fetch a correct amount of rows") - expected moved + assertEqualEq + ( "Moving cursor with" + <+> show cd + <+> "would fetch a correct amount of rows" + ) + expected + moved withHoldCursorWorks = testCase "Cursor declared as WITH HOLD works" $ do runTestEnv td tsNoTrans $ do withCursor "ints" NoScroll Hold (sqlGenInts 10) $ \cursor -> do cursorFetch_ cursor CD_Forward_All - sum_::Int32 <- sum . fmap runIdentity <$> queryResult + sum_ :: Int32 <- sum . fmap runIdentity <$> queryResult assertEqualEq "sum_ is correct" 55 sum_ doubleCloseWorks = testCase "Double CLOSE works on a cursor" $ do @@ -295,28 +323,30 @@ cursorTest td = testGroup "Cursors" queryInterruptionTest :: TestData -> Test queryInterruptionTest td = testCase "Queries are interruptible" $ do let sleep = "SELECT pg_sleep(2)" - ints = sqlGenInts 5000000 + ints = sqlGenInts 5000000 runTestEnv td tsNoTrans $ do testQuery id sleep testQuery id ints runTestEnv td defaultTransactionSettings $ do - testQuery (withSavepoint "ints") ints + testQuery (withSavepoint "ints") ints testQuery (withSavepoint "sleep") sleep - where - testQuery m sql = timeout 500000 (m $ runSQL_ sql) >>= \case - Just _ -> liftBase $ do - assertFailure $ "Query" <+> show sql <+> "wasn't interrupted in time" - Nothing -> return () + where + testQuery m sql = + timeout 500000 (m $ runSQL_ sql) >>= \case + Just _ -> liftBase $ do + assertFailure $ "Query" <+> show sql <+> "wasn't interrupted in time" + Nothing -> return () autocommitTest :: TestData -> Test -autocommitTest td = testCase "Autocommit mode works" . - runTestEnv td tsNoTrans $ do - let sint = Identity (1::Int32) - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint - withNewConnection $ do - n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint - assertEqualEq "Other connection sees autocommited data" 1 n - runQuery_ $ rawSQL "DELETE FROM test1_ WHERE a = $1" sint +autocommitTest td = testCase "Autocommit mode works" + . runTestEnv td tsNoTrans + $ do + let sint = Identity (1 :: Int32) + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint + withNewConnection $ do + n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint + assertEqualEq "Other connection sees autocommited data" 1 n + runQuery_ $ rawSQL "DELETE FROM test1_ WHERE a = $1" sint setRoleTest :: TestData -> Test setRoleTest td = do @@ -331,36 +361,39 @@ setRoleTest td = do testRole :: String testRole = "hpqtypes_test_role" - ConnectionSource roledCs = simpleSource $ (snd td) - { csRole = Just $ unsafeSQL testRole - } + ConnectionSource roledCs = + simpleSource $ + (snd td) + { csRole = Just $ unsafeSQL testRole + } createRole = runTestEnv td defaultTransactionSettings $ do try (runSQL_ $ "CREATE ROLE" <+> unsafeSQL testRole) >>= \case Right () -> pure True - Left DBException{} -> pure False + Left DBException {} -> pure False dropRole = \case False -> pure () - True -> runTestEnv td defaultTransactionSettings $ do + True -> runTestEnv td defaultTransactionSettings $ do runSQL_ $ "DROP ROLE" <+> unsafeSQL testRole preparedStatementTest :: TestData -> Test -preparedStatementTest td = testCase "Execution of prepared statements works" . - runTestEnv td defaultTransactionSettings $ do - let name = "select1" - - checkPrepared name "Statement is not prepared" 0 - execPrepared name 42 - checkPrepared name "Statement is prepared" 1 - execPrepared name 89 - - let i3 = "lalala" :: String - -- Changing parameter type in an already prepared statement shouldn't work. - o3 <- try $ runPreparedQuery_ name $ "SELECT" i3 - case o3 of - Left DBException{} -> pure () - Right r3 -> liftBase . assertFailure $ "Expected DBException, but got" <+> show r3 +preparedStatementTest td = testCase "Execution of prepared statements works" + . runTestEnv td defaultTransactionSettings + $ do + let name = "select1" + + checkPrepared name "Statement is not prepared" 0 + execPrepared name 42 + checkPrepared name "Statement is prepared" 1 + execPrepared name 89 + + let i3 = "lalala" :: String + -- Changing parameter type in an already prepared statement shouldn't work. + o3 <- try $ runPreparedQuery_ name $ "SELECT" i3 + case o3 of + Left DBException {} -> pure () + Right r3 -> liftBase . assertFailure $ "Expected DBException, but got" <+> show r3 where checkPrepared :: QueryName -> String -> Int -> TestEnv () checkPrepared (QueryName name) assertTitle expected = do @@ -374,43 +407,48 @@ preparedStatementTest td = testCase "Execution of prepared statements works" . assertEqualEq "Results match" input output readOnlyTest :: TestData -> Test -readOnlyTest td = testCase "Read only transaction mode works" . - runTestEnv td - defaultTransactionSettings {tsPermissions = ReadOnly} $ do - let sint = Identity (2::Int32) - eres <- try . runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint - case eres :: Either DBException () of - Left _ -> return () - Right _ -> liftBase . assertFailure $ "DBException wasn't thrown" - rollback - n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint - assertEqualEq "SELECT works in read only mode" 0 n +readOnlyTest td = testCase "Read only transaction mode works" + . runTestEnv + td + defaultTransactionSettings {tsPermissions = ReadOnly} + $ do + let sint = Identity (2 :: Int32) + eres <- try . runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint + case eres :: Either DBException () of + Left _ -> return () + Right _ -> liftBase . assertFailure $ "DBException wasn't thrown" + rollback + n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint + assertEqualEq "SELECT works in read only mode" 0 n savepointTest :: TestData -> Test -savepointTest td = testCase "Savepoint support works" . - runTestEnv td defaultTransactionSettings $ do - let int1 = 3 :: Int32 - int2 = 4 :: Int32 - - -- action executed within withSavepoint throws - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int1) - _ :: Either DBException () <- try . withSavepoint (Savepoint "test") $ do - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int2) - runSQL_ "SELECT * FROM table_that_is_not_there" - runQuery_ $ rawSQL "SELECT a FROM test1_ WHERE a IN ($1, $2)" (int1, int2) - res1 <- fetchMany runIdentity - assertEqualEq "Part of transaction was rolled back" [int1] res1 - - rollback - - -- action executed within withSavepoint doesn't throw - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int1) - withSavepoint (Savepoint "test") $ do - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int2) - runQuery_ $ rawSQL - "SELECT a FROM test1_ WHERE a IN ($1, $2) ORDER BY a" (int1, int2) - res2 <- fetchMany runIdentity - assertEqualEq "Result of all queries is visible" [int1, int2] res2 +savepointTest td = testCase "Savepoint support works" + . runTestEnv td defaultTransactionSettings + $ do + let int1 = 3 :: Int32 + int2 = 4 :: Int32 + + -- action executed within withSavepoint throws + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int1) + _ :: Either DBException () <- try . withSavepoint (Savepoint "test") $ do + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int2) + runSQL_ "SELECT * FROM table_that_is_not_there" + runQuery_ $ rawSQL "SELECT a FROM test1_ WHERE a IN ($1, $2)" (int1, int2) + res1 <- fetchMany runIdentity + assertEqualEq "Part of transaction was rolled back" [int1] res1 + + rollback + + -- action executed within withSavepoint doesn't throw + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int1) + withSavepoint (Savepoint "test") $ do + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int2) + runQuery_ $ + rawSQL + "SELECT a FROM test1_ WHERE a IN ($1, $2) ORDER BY a" + (int1, int2) + res2 <- fetchMany runIdentity + assertEqualEq "Result of all queries is visible" [int1, int2] res2 notifyTest :: TestData -> Test notifyTest td = testCase "Notifications work" . runTestEnv td tsNoTrans $ do @@ -440,41 +478,60 @@ notifyTest td = testCase "Notifications work" . runTestEnv td tsNoTrans $ do transactionTest :: TestData -> IsolationLevel -> Test transactionTest td lvl = testCase - ("Auto transaction works by default with isolation level" - <+> show lvl) . - runTestEnv td - defaultTransactionSettings {tsIsolationLevel = lvl} $ do - let sint = Identity (5::Int32) - runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint - withNewConnection $ do - n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint - assertEqualEq "Other connection doesn't see uncommited data" 0 n - rollback - -nullTest :: forall t. (Show t, ToSQL t, FromSQL t, Typeable t) - => TestData -> t -> Test -nullTest td t = testCase ("Attempt to get non-NULL value of type" - <+> show (typeOf t) <+> "fails if NULL is provided") . - runTestEnv td defaultTransactionSettings $ do - runSQL_ $ "SELECT" (Nothing::Maybe t) - eres <- try $ fetchOne runIdentity - case eres :: Either DBException t of - Left _ -> return () - Right _ -> liftBase . assertFailure $ "DBException wasn't thrown" - -putGetTest :: forall t. (Arbitrary t, Show t, ToSQL t, FromSQL t, Typeable t) - => TestData -> Int -> t -> (t -> t -> Bool) -> Test + ( "Auto transaction works by default with isolation level" + <+> show lvl + ) + . runTestEnv + td + defaultTransactionSettings {tsIsolationLevel = lvl} + $ do + let sint = Identity (5 :: Int32) + runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint + withNewConnection $ do + n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint + assertEqualEq "Other connection doesn't see uncommited data" 0 n + rollback + +nullTest + :: forall t + . (Show t, ToSQL t, FromSQL t, Typeable t) + => TestData + -> t + -> Test +nullTest td t = testCase + ( "Attempt to get non-NULL value of type" + <+> show (typeOf t) + <+> "fails if NULL is provided" + ) + . runTestEnv td defaultTransactionSettings + $ do + runSQL_ $ "SELECT" (Nothing :: Maybe t) + eres <- try $ fetchOne runIdentity + case eres :: Either DBException t of + Left _ -> return () + Right _ -> liftBase . assertFailure $ "DBException wasn't thrown" + +putGetTest + :: forall t + . (Arbitrary t, Show t, ToSQL t, FromSQL t, Typeable t) + => TestData + -> Int + -> t + -> (t -> t -> Bool) + -> Test putGetTest td n t eq = testCase - ("Putting value of type" - <+> show (typeOf t) - <+> "through database doesn't change its value") . - runTestEnv td defaultTransactionSettings . - runTimes 1000 $ do - v :: t <- randomValue n - --liftBase . putStrLn . show $ v - runSQL_ $ "SELECT" v - v' <- fetchOne runIdentity - assertEqual "Value doesn't change after getting through database" v v' eq + ( "Putting value of type" + <+> show (typeOf t) + <+> "through database doesn't change its value" + ) + . runTestEnv td defaultTransactionSettings + . runTimes 1000 + $ do + v :: t <- randomValue n + -- liftBase . putStrLn . show $ v + runSQL_ $ "SELECT" v + v' <- fetchOne runIdentity + assertEqual "Value doesn't change after getting through database" v v' eq uuidTest :: TestData -> Test uuidTest td = testCase "UUID encoding / decoding test" $ do @@ -490,29 +547,38 @@ uuidTest td = testCase "UUID encoding / decoding test" $ do assertEqual "UUID is encoded correctly" uuidStr uuidStr2 (==) xmlTest :: TestData -> Test -xmlTest td = testCase "Put and get XML value works" . - runTestEnv td defaultTransactionSettings $ do - runSQL_ $ "SET CLIENT_ENCODING TO 'UTF8'" - let v = XML "somestringå" - runSQL_ $ "SELECT XML 'somestringå'" - v' <- fetchOne runIdentity - assertEqualEq "XML value correct" v v' - runSQL_ $ "SELECT" v - v'' <- fetchOne runIdentity - assertEqualEq "XML value correct" v v'' - runSQL_ $ "SET CLIENT_ENCODING TO 'latin-1'" - -rowTest :: forall row. (Arbitrary row, Eq row, Show row, ToRow row, FromRow row) - => TestData -> row -> Test -rowTest td _r = testCase ("Putting row of length" - <+> show (pqVariables @row) - <+> "through database works") . - runTestEnv td defaultTransactionSettings . runTimes 100 $ do - row :: row <- randomValue 100 - let fmt = mintercalate ", " $ map (T.append "$" . showt) [1..pqVariables @row] - runQuery_ $ rawSQL ("SELECT" <+> fmt) row - row' <- fetchOne id - assertEqualEq "Row doesn't change after getting through database" row row' +xmlTest td = testCase "Put and get XML value works" + . runTestEnv td defaultTransactionSettings + $ do + runSQL_ $ "SET CLIENT_ENCODING TO 'UTF8'" + let v = XML "somestringå" + runSQL_ $ "SELECT XML 'somestringå'" + v' <- fetchOne runIdentity + assertEqualEq "XML value correct" v v' + runSQL_ $ "SELECT" v + v'' <- fetchOne runIdentity + assertEqualEq "XML value correct" v v'' + runSQL_ $ "SET CLIENT_ENCODING TO 'latin-1'" + +rowTest + :: forall row + . (Arbitrary row, Eq row, Show row, ToRow row, FromRow row) + => TestData + -> row + -> Test +rowTest td _r = testCase + ( "Putting row of length" + <+> show (pqVariables @row) + <+> "through database works" + ) + . runTestEnv td defaultTransactionSettings + . runTimes 100 + $ do + row :: row <- randomValue 100 + let fmt = mintercalate ", " $ map (T.append "$" . showt) [1 .. pqVariables @row] + runQuery_ $ rawSQL ("SELECT" <+> fmt) row + row' <- fetchOne id + assertEqualEq "Row doesn't change after getting through database" row row' _printTime :: MonadBase IO m => m a -> m a _printTime m = do @@ -534,120 +600,116 @@ tests td = , queryInterruptionTest td , cursorTest td , uuidTest td - ------------------------------------ , transactionTest td ReadCommitted , transactionTest td RepeatableRead , transactionTest td Serializable - ---------------------------------------- - , nullTest td (u::Int16) - , nullTest td (u::Int32) - , nullTest td (u::Int64) - , nullTest td (u::Float) - , nullTest td (u::Double) - , nullTest td (u::Bool) - , nullTest td (u::AsciiChar) - , nullTest td (u::Word8) - , nullTest td (u::String) - , nullTest td (u::BS.ByteString) - , nullTest td (u::T.Text) - , nullTest td (u::U.UUID) - , nullTest td (u::JSON Value) - , nullTest td (u::JSONB Value) - , nullTest td (u::XML) - , nullTest td (u::Interval) - , nullTest td (u::Day) - , nullTest td (u::TimeOfDay) - , nullTest td (u::LocalTime) - , nullTest td (u::UTCTime) - , nullTest td (u::Array1 Int32) - , nullTest td (u::Array2 Double) - , nullTest td (u::Composite Simple) - , nullTest td (u::CompositeArray1 Simple) - , nullTest td (u::CompositeArray2 Simple) - ---------------------------------------- - , putGetTest td 100 (u::Int16) (==) - , putGetTest td 100 (u::Int32) (==) - , putGetTest td 100 (u::Int64) (==) - , putGetTest td 10000 (u::Float) (==) - , putGetTest td 10000 (u::Double) (==) - , putGetTest td 100 (u::Bool) (==) - , putGetTest td 100 (u::AsciiChar) (==) - , putGetTest td 100 (u::Word8) (==) - , putGetTest td 1000 (u::String0) (==) - , putGetTest td 1000 (u::BS.ByteString) (==) - , putGetTest td 1000 (u::T.Text) (==) - , putGetTest td 1000 (u::U.UUID) (==) - , putGetTest td 50 (u::JSON Value0) (==) - , putGetTest td 50 (u::JSONB Value0) (==) - , putGetTest td 20 (u::Array1 (JSON Value0)) (==) - , putGetTest td 20 (u::Array1 (JSONB Value0)) (==) - , putGetTest td 50 (u::Interval) (==) - , putGetTest td 1000000 (u::Day) (==) - , putGetTest td 10000 (u::TimeOfDay) eqTOD - , putGetTest td 500000 (u::LocalTime) eqLT - , putGetTest td 500000 (u::UTCTime) eqUTCT - , putGetTest td 1000 (u::Array1 Int32) (==) - , putGetTest td 1000 (u::Array2 Double) eqArray2 - , putGetTest td 100000 (u::Composite Simple) (==) - , putGetTest td 1000 (u::CompositeArray1 Simple) (==) - , putGetTest td 1000 (u::CompositeArray2 Simple) eqCompositeArray2 - , putGetTest td 100000 (u::Composite Nested) (==) - , putGetTest td 1000 (u::CompositeArray1 Nested) (==) - , putGetTest td 1000 (u::CompositeArray2 Nested) eqCompositeArray2 - ---------------------------------------- - , rowTest td (u::Identity Int16) - , rowTest td (u::Identity T.Text :*: (Double, Int16)) - , rowTest td (u::(T.Text, Double) :*: Identity Int16) - , rowTest td (u::(Int16, T.Text, Int64, Double) :*: Identity Bool :*: (String0, AsciiChar)) - , rowTest td (u::(Int16, Int32)) - , rowTest td (u::(Int16, Int32, Int64)) - , rowTest td (u::(Int16, Int32, Int64, Float)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, U.UUID)) - , rowTest td (u::(Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, U.UUID, Day)) + , nullTest td (u :: Int16) + , nullTest td (u :: Int32) + , nullTest td (u :: Int64) + , nullTest td (u :: Float) + , nullTest td (u :: Double) + , nullTest td (u :: Bool) + , nullTest td (u :: AsciiChar) + , nullTest td (u :: Word8) + , nullTest td (u :: String) + , nullTest td (u :: BS.ByteString) + , nullTest td (u :: T.Text) + , nullTest td (u :: U.UUID) + , nullTest td (u :: JSON Value) + , nullTest td (u :: JSONB Value) + , nullTest td (u :: XML) + , nullTest td (u :: Interval) + , nullTest td (u :: Day) + , nullTest td (u :: TimeOfDay) + , nullTest td (u :: LocalTime) + , nullTest td (u :: UTCTime) + , nullTest td (u :: Array1 Int32) + , nullTest td (u :: Array2 Double) + , nullTest td (u :: Composite Simple) + , nullTest td (u :: CompositeArray1 Simple) + , nullTest td (u :: CompositeArray2 Simple) + , putGetTest td 100 (u :: Int16) (==) + , putGetTest td 100 (u :: Int32) (==) + , putGetTest td 100 (u :: Int64) (==) + , putGetTest td 10000 (u :: Float) (==) + , putGetTest td 10000 (u :: Double) (==) + , putGetTest td 100 (u :: Bool) (==) + , putGetTest td 100 (u :: AsciiChar) (==) + , putGetTest td 100 (u :: Word8) (==) + , putGetTest td 1000 (u :: String0) (==) + , putGetTest td 1000 (u :: BS.ByteString) (==) + , putGetTest td 1000 (u :: T.Text) (==) + , putGetTest td 1000 (u :: U.UUID) (==) + , putGetTest td 50 (u :: JSON Value0) (==) + , putGetTest td 50 (u :: JSONB Value0) (==) + , putGetTest td 20 (u :: Array1 (JSON Value0)) (==) + , putGetTest td 20 (u :: Array1 (JSONB Value0)) (==) + , putGetTest td 50 (u :: Interval) (==) + , putGetTest td 1000000 (u :: Day) (==) + , putGetTest td 10000 (u :: TimeOfDay) eqTOD + , putGetTest td 500000 (u :: LocalTime) eqLT + , putGetTest td 500000 (u :: UTCTime) eqUTCT + , putGetTest td 1000 (u :: Array1 Int32) (==) + , putGetTest td 1000 (u :: Array2 Double) eqArray2 + , putGetTest td 100000 (u :: Composite Simple) (==) + , putGetTest td 1000 (u :: CompositeArray1 Simple) (==) + , putGetTest td 1000 (u :: CompositeArray2 Simple) eqCompositeArray2 + , putGetTest td 100000 (u :: Composite Nested) (==) + , putGetTest td 1000 (u :: CompositeArray1 Nested) (==) + , putGetTest td 1000 (u :: CompositeArray2 Nested) eqCompositeArray2 + , rowTest td (u :: Identity Int16) + , rowTest td (u :: Identity T.Text :*: (Double, Int16)) + , rowTest td (u :: (T.Text, Double) :*: Identity Int16) + , rowTest td (u :: (Int16, T.Text, Int64, Double) :*: Identity Bool :*: (String0, AsciiChar)) + , rowTest td (u :: (Int16, Int32)) + , rowTest td (u :: (Int16, Int32, Int64)) + , rowTest td (u :: (Int16, Int32, Int64, Float)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, U.UUID)) + , rowTest td (u :: (Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, Day, Array1 Int32, Composite Simple, CompositeArray1 Simple, Composite Nested, CompositeArray1 Nested, Int16, Int32, Int64, Float, Double, Bool, AsciiChar, Word8, String0, BS.ByteString, T.Text, BS.ByteString, U.UUID, Day)) ] where u = undefined @@ -669,29 +731,34 @@ dropStructures cs = runDBT cs defaultTransactionSettings $ do runSQL_ "DROP TABLE test1_" getConnString :: IO (T.Text, [String]) -getConnString = getArgs >>= \case - connString : args -> return (T.pack connString, args) - [] -> lookupEnv "GITHUB_ACTIONS" >>= \case - Just "true" -> return ("host=postgres user=postgres password=postgres", []) - _ -> printUsage >> exitFailure +getConnString = + getArgs >>= \case + connString : args -> return (T.pack connString, args) + [] -> + lookupEnv "GITHUB_ACTIONS" >>= \case + Just "true" -> return ("host=postgres user=postgres password=postgres", []) + _ -> printUsage >> exitFailure where printUsage = do prog <- getProgName - putStrLn $ "Usage:" <+> prog - <+> " [test-framework args]" + putStrLn $ + "Usage:" + <+> prog + <+> " [test-framework args]" main :: IO () main = do (connString, args) <- getConnString - let connSettings = defaultConnectionSettings - { csConnInfo = connString - , csClientEncoding = Just "latin1" - } + let connSettings = + defaultConnectionSettings + { csConnInfo = connString + , csClientEncoding = Just "latin1" + } ConnectionSource connSource = simpleSource connSettings createStructures connSource gen <- newQCGen putStrLn $ "PRNG:" <+> show gen - finally (defaultMainWithArgs (tests (gen, connSettings { csComposites = ["simple_", "nested_"] })) $ args) $ do + finally (defaultMainWithArgs (tests (gen, connSettings {csComposites = ["simple_", "nested_"]})) $ args) $ do dropStructures connSource diff --git a/test/Prelude/Instances.hs b/test/Prelude/Instances.hs index 7ef4e45..be9d70d 100644 --- a/test/Prelude/Instances.hs +++ b/test/Prelude/Instances.hs @@ -1,235 +1,238 @@ {-# OPTIONS_GHC -Wno-orphans #-} + module Prelude.Instances where -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +{- FOURMOLU_DISABLE -} + +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48, Eq a49 ) => Eq (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49) -deriving instance ( - Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 +deriving instance + ( Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10 , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 @@ -238,181 +241,181 @@ deriving instance ( ---------------------------------------- -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35, Show a36 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35, Show a36, Show a37 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35, Show a36, Show a37, Show a38 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35, Show a36, Show a37, Show a38, Show a39 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 , Show a33, Show a34, Show a35, Show a36, Show a37, Show a38, Show a39, Show a40 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -420,8 +423,8 @@ deriving instance ( , Show a41 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -429,8 +432,8 @@ deriving instance ( , Show a41, Show a42 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -438,8 +441,8 @@ deriving instance ( , Show a41, Show a42, Show a43 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -447,8 +450,8 @@ deriving instance ( , Show a41, Show a42, Show a43, Show a44 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -456,8 +459,8 @@ deriving instance ( , Show a41, Show a42, Show a43, Show a44, Show a45 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -465,8 +468,8 @@ deriving instance ( , Show a41, Show a42, Show a43, Show a44, Show a45, Show a46 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -474,8 +477,8 @@ deriving instance ( , Show a41, Show a42, Show a43, Show a44, Show a45, Show a46, Show a47 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -483,8 +486,8 @@ deriving instance ( , Show a41, Show a42, Show a43, Show a44, Show a45, Show a46, Show a47, Show a48 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 @@ -493,8 +496,8 @@ deriving instance ( , Show a49 ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49) -deriving instance ( - Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 +deriving instance + ( Show a1, Show a2, Show a3, Show a4, Show a5, Show a6, Show a7, Show a8 , Show a9, Show a10, Show a11, Show a12, Show a13, Show a14, Show a15, Show a16 , Show a17, Show a18, Show a19, Show a20, Show a21, Show a22, Show a23, Show a24 , Show a25, Show a26, Show a27, Show a28, Show a29, Show a30, Show a31, Show a32 diff --git a/test/Test/Aeson/Compat.hs b/test/Test/Aeson/Compat.hs index 9bc163a..0628c78 100644 --- a/test/Test/Aeson/Compat.hs +++ b/test/Test/Aeson/Compat.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} + module Test.Aeson.Compat ( fromList , Value0 diff --git a/test/Test/QuickCheck/Arbitrary/Instances.hs b/test/Test/QuickCheck/Arbitrary/Instances.hs index ff443ae..c51506f 100644 --- a/test/Test/QuickCheck/Arbitrary/Instances.hs +++ b/test/Test/QuickCheck/Arbitrary/Instances.hs @@ -1,24 +1,25 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} + module Test.QuickCheck.Arbitrary.Instances where import Data.Aeson +import Data.ByteString qualified as BS import Data.Char import Data.Scientific +import Data.Text qualified as T import Data.Time +import Data.UUID.Types qualified as U +import Data.Vector qualified as V import Data.Word import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Data.UUID.Types as U import Database.PostgreSQL.PQTypes -import qualified Test.Aeson.Compat as C +import Test.Aeson.Compat qualified as C -newtype String0 = String0 { unString0 :: String } +newtype String0 = String0 {unString0 :: String} deriving (Eq, Ord, Show) instance PQFormat String0 where @@ -35,7 +36,7 @@ instance ToSQL String0 where instance Arbitrary String0 where arbitrary = String0 . map (chr . fromIntegral . unWord0) <$> arbitrary -newtype Word0 = Word0 { unWord0 :: Word8 } +newtype Word0 = Word0 {unWord0 :: Word8} deriving (Enum, Eq, Integral, Num, Ord, Real) instance Bounded Word0 where @@ -53,7 +54,7 @@ instance Arbitrary T.Text where arbitrary = T.pack . unString0 <$> arbitrary uuidFromWords :: (Word32, Word32, Word32, Word32) -> U.UUID -uuidFromWords (a,b,c,d) = U.fromWords a b c d +uuidFromWords (a, b, c, d) = U.fromWords a b c d instance Arbitrary U.UUID where arbitrary = uuidFromWords <$> arbitrary @@ -75,18 +76,18 @@ instance Arbitrary C.Value0 where | i == n = oneof branches | otherwise = oneof $ leafs ++ branches where - branches = [ - Object . C.fromList <$> shortListOf ((,) <$> arbitrary <*> subValue) - , Array . V.fromList <$> shortListOf subValue + branches = + [ Object . C.fromList <$> shortListOf ((,) <$> arbitrary <*> subValue) + , Array . V.fromList <$> shortListOf subValue ] - leafs = [ - String <$> arbitrary + leafs = + [ String <$> arbitrary , Number <$> arbitrary - , Bool <$> arbitrary + , Bool <$> arbitrary , pure Null ] - subValue = value (i-1) n + subValue = value (i - 1) n shortListOf = fmap (take depth) . listOf ---------------------------------------- @@ -111,53 +112,55 @@ instance Arbitrary UTCTime where return $ UTCTime day (realToFrac secs) instance Arbitrary TimeZone where - arbitrary = elements $ map hoursToTimeZone [-12..14] + arbitrary = elements $ map hoursToTimeZone [-12 .. 14] instance Arbitrary ZonedTime where arbitrary = ZonedTime <$> arbitrary <*> arbitrary ---------------------------------------- +{- FOURMOLU_DISABLE -} + #if !MIN_VERSION_QuickCheck(2,9,0) instance Arbitrary a => Arbitrary (Identity a) where arbitrary = Identity <$> arbitrary #endif #if !MIN_VERSION_QuickCheck(2,9,0) -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6 ) => Arbitrary (a1, a2, a3, a4, a5, a6) where arbitrary = (,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7) where arbitrary = (,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8) where arbitrary = (,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9) where arbitrary = (,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) where arbitrary = (,,,,,,,,,) @@ -165,8 +168,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) where @@ -175,8 +178,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) where @@ -185,8 +188,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) where @@ -195,8 +198,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) where @@ -205,8 +208,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 ) => Arbitrary (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) where @@ -215,8 +218,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16 @@ -227,8 +230,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17 @@ -239,8 +242,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18 @@ -251,8 +254,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19 @@ -263,8 +266,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -275,8 +278,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -289,8 +292,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -303,8 +306,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -317,8 +320,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -331,8 +334,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -345,8 +348,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -361,8 +364,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -377,8 +380,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -393,8 +396,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -409,8 +412,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -425,8 +428,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -443,8 +446,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -461,8 +464,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -479,8 +482,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -497,8 +500,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -515,8 +518,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -535,8 +538,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -555,8 +558,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -575,8 +578,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -595,8 +598,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -615,8 +618,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -637,8 +640,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -659,8 +662,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -681,8 +684,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -703,8 +706,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -725,8 +728,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -749,8 +752,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -773,8 +776,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -797,8 +800,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20 @@ -821,8 +824,8 @@ instance ( <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance ( - Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 +instance + ( Arbitrary a1, Arbitrary a2, Arbitrary a3, Arbitrary a4, Arbitrary a5 , Arbitrary a6, Arbitrary a7, Arbitrary a8, Arbitrary a9, Arbitrary a10 , Arbitrary a11, Arbitrary a12, Arbitrary a13, Arbitrary a14, Arbitrary a15 , Arbitrary a16, Arbitrary a17, Arbitrary a18, Arbitrary a19, Arbitrary a20