hdbi 1.2.0 → 1.3.0
raw patch · 5 files changed
+310/−89 lines, 5 files
Files
- Database/HDBI.hs +0/−5
- Database/HDBI/SqlValue.hs +231/−12
- Database/HDBI/Types.hs +65/−60
- hdbi.cabal +1/−1
- testsrc/dummydriver.hs +13/−11
Database/HDBI.hs view
@@ -99,16 +99,11 @@ -- |* Finish other hdbi drivers, like mysql and sqlite ----- * Unify the testing and benchmarking with one package.--- -- * Create package hdbi-introspect with common interface to introspect and -- change the schema. Also it will be necessary to create packages -- hdbi-introspect-postgresql, hdbi-introspect-mysql and so on for each database -- using specific methods to introspect and change the schema. This is the base -- package for doing migrations like in Ruby on Rails.------ * Create hdbi-resourcet and hdbi-conduit to provide convenient and reliable--- way for finalizing statements and streaming processing the query results. -- -- * Port other high-level database interfaces, like ''persistent'' and -- ''haskelldb''. This will posibly lead to need to patch ''persistent'' and/or
Database/HDBI/SqlValue.hs view
@@ -35,6 +35,13 @@ , BitField(..) -- * SQL value marshalling , SqlValue(..)+ -- * Auxiliary convertion functions+ , one , onei , oned+ , onet , onetl , oneb , onebl+ , safeUnOne+ , unone , unonei , unoned+ , unonet , unonetl+ , unoneb , unonebl ) where@@ -96,6 +103,7 @@ fromSql s = case safeFromSql s of Left e -> throw e Right a -> a+ {-# INLINEABLE fromSql #-} class ToRow a where toRow :: a -> [SqlValue]@@ -107,6 +115,7 @@ fromRow sqls = case safeFromRow sqls of Left e -> throw e Right a -> a+ {-# INLINEABLE fromRow #-} wrongSqlList :: [SqlValue] -- ^ given list of SqlValues -> Int -- ^ expected length of list@@ -115,42 +124,56 @@ $ "Wrong count of SqlValues: " ++ (show $ length x) ++ " but expected: " ++ (show c) --- instance (ToSql a) => ToRow a where--- toRow a = [toSql a]+-- | instance for conveniently pass empty list of parameters+instance ToRow () where+ toRow _ = []+ {-# INLINEABLE toRow #-} --- instance (FromSql a) => FromRow a where--- safeFromRow [a] = safeFromSql a--- safeFromRow x = wrongSqlList x 1+-- | instance for convenient ignoring all the parameters+instance FromRow () where+ fromRow _ = ()+ {-# INLINEABLE fromRow #-}+ safeFromRow _ = Right ()+ {-# INLINEABLE safeFromRow #-} -instance (ToSql a) => ToRow [a] where- toRow a = map toSql a+-- instance (ToSql a) => ToRow [a] where+-- toRow a = map toSql a+-- {-# INLINEABLE toRow #-} -instance (FromSql a) => FromRow [a] where- safeFromRow a = mapM safeFromSql a+-- instance (FromSql a) => FromRow [a] where+-- safeFromRow a = mapM safeFromSql a+-- {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b) => ToRow (a, b) where toRow (a, b) = [toSql a, toSql b]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b) => FromRow (a, b) where safeFromRow [a, b] = (,) <$> safeFromSql a <*> safeFromSql b safeFromRow x = wrongSqlList x 2+ {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b, ToSql c) => ToRow (a, b, c) where toRow (a, b, c) = [toSql a, toSql b, toSql c]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b, FromSql c) => FromRow (a, b, c) where safeFromRow [a, b, c] = (,,) <$> safeFromSql a <*> safeFromSql b <*> safeFromSql c safeFromRow x = wrongSqlList x 3+ {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b, ToSql c, ToSql d) => ToRow (a, b, c, d) where toRow (a, b, c, d) = [toSql a, toSql b, toSql c, toSql d]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b, FromSql c, FromSql d) => FromRow (a, b, c, d) where safeFromRow [a, b, c, d] = (,,,) <$> safeFromSql a <*> safeFromSql b <*> safeFromSql c <*> safeFromSql d safeFromRow x = wrongSqlList x 4+ {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b, ToSql c, ToSql d, ToSql e) => ToRow (a, b, c, d, e) where toRow (a, b, c, d, e) = [toSql a, toSql b, toSql c, toSql d, toSql e]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b, FromSql c, FromSql d, FromSql e) => FromRow (a, b, c, d, e) where safeFromRow [a, b, c, d, e] = (,,,,)@@ -160,10 +183,12 @@ <*> safeFromSql d <*> safeFromSql e safeFromRow x = wrongSqlList x 5+ {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b, ToSql c, ToSql d, ToSql e, ToSql f) => ToRow (a, b, c, d, e, f) where toRow (a, b, c, d, e, f) = [toSql a, toSql b, toSql c, toSql d, toSql e, toSql f]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b, FromSql c, FromSql d, FromSql e, FromSql f) => FromRow (a, b, c, d, e, f) where safeFromRow [a, b, c, d, e, f] = (,,,,,)@@ -174,9 +199,11 @@ <*> safeFromSql e <*> safeFromSql f safeFromRow x = wrongSqlList x 6+ {-# INLINEABLE safeFromRow #-} instance (ToSql a, ToSql b, ToSql c, ToSql d, ToSql e, ToSql f, ToSql g) => ToRow (a, b, c, d, e, f, g) where toRow (a, b, c, d, e, f, g) = [toSql a, toSql b, toSql c, toSql d, toSql e, toSql f, toSql g]+ {-# INLINEABLE toRow #-} instance (FromSql a, FromSql b, FromSql c, FromSql d, FromSql e, FromSql f, FromSql g) => FromRow (a, b, c, d, e, f, g) where safeFromRow [a, b, c, d, e, f, g] = (,,,,,,)@@ -188,9 +215,9 @@ <*> safeFromSql f <*> safeFromSql g safeFromRow x = wrongSqlList x 7- - - + {-# INLINEABLE safeFromRow #-}++ -- | Show parser detail error showFail :: [String] -- ^ List of contexts of parser -> String -- ^ Error message@@ -390,6 +417,7 @@ instance ToSql Decimal where toSql = SqlDecimal+ {-# INLINEABLE toSql #-} instance FromSql Decimal where safeFromSql (SqlDecimal d) = Right d@@ -405,10 +433,12 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Decimal) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Decimal) safeFromSql SqlNull = nullConvertError (undefined :: Decimal)+ {-# INLINEABLE safeFromSql #-} instance ToSql Int where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Int where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -424,10 +454,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int) safeFromSql SqlNull = nullConvertError (undefined :: Int)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Int32 where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Int32 where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -443,10 +476,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int32) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int32) safeFromSql SqlNull = nullConvertError (undefined :: Int32)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Int64 where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Int64 where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -462,10 +498,12 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Int64) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Int64) safeFromSql SqlNull = nullConvertError (undefined :: Int64)+ {-# INLINEABLE safeFromSql #-} instance ToSql Integer where toSql = SqlInteger+ {-# INLINEABLE toSql #-} instance FromSql Integer where safeFromSql (SqlDecimal d) = Right $ truncate d@@ -481,10 +519,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Integer) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Integer) safeFromSql SqlNull = nullConvertError (undefined :: Integer)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Word32 where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Word32 where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -500,10 +541,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word32) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word32) safeFromSql SqlNull = nullConvertError (undefined :: Word32)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Word64 where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Word64 where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -519,10 +563,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word64) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word64) safeFromSql SqlNull = nullConvertError (undefined :: Word64)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Word where toSql i = SqlInteger $ toInteger i+ {-# INLINEABLE toSql #-} instance FromSql Word where safeFromSql (SqlDecimal d) = convertToBounded $ truncate d@@ -538,10 +585,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Word) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Word) safeFromSql SqlNull = nullConvertError (undefined :: Word)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Double where toSql = SqlDouble+ {-# INLINEABLE toSql #-} instance FromSql Double where safeFromSql (SqlDecimal d) = Right $ realToFrac d@@ -557,10 +607,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Double) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Double) safeFromSql SqlNull = nullConvertError (undefined :: Double)+ {-# INLINEABLE safeFromSql #-} + instance ToSql [Char] where toSql s = SqlText $ TL.pack s+ {-# INLINEABLE toSql #-} instance FromSql [Char] where safeFromSql (SqlDecimal d) = Right $ show d@@ -576,30 +629,39 @@ safeFromSql (SqlLocalTimeOfDay tod) = Right $ formatIsoTimeOfDay tod safeFromSql (SqlLocalTime lt) = Right $ formatIsoLocalTime lt safeFromSql SqlNull = nullConvertError (undefined :: String)+ {-# INLINEABLE safeFromSql #-} + instance ToSql TL.Text where toSql = SqlText+ {-# INLINEABLE toSql #-} instance FromSql TL.Text where safeFromSql (SqlText t) = Right t safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: TL.Text) safeFromSql SqlNull = nullConvertError (undefined :: TL.Text) safeFromSql x = TL.pack <$> safeFromSql x+ {-# INLINEABLE safeFromSql #-} + instance ToSql T.Text where toSql t = SqlText $ TL.fromChunks [t]+ {-# INLINEABLE toSql #-} instance FromSql T.Text where safeFromSql (SqlText t) = Right $ TL.toStrict t safeFromSql (SqlBlob b) = incompatibleTypes b (undefined :: T.Text) safeFromSql SqlNull = nullConvertError (undefined :: T.Text) safeFromSql x = T.pack <$> safeFromSql x+ {-# INLINEABLE safeFromSql #-} + instance ToSql B.ByteString where toSql = SqlBlob+ {-# INLINEABLE toSql #-} instance FromSql B.ByteString where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: B.ByteString)@@ -615,10 +677,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: B.ByteString) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: B.ByteString) safeFromSql SqlNull = nullConvertError (undefined :: B.ByteString)+ {-# INLINEABLE safeFromSql #-} + instance ToSql BL.ByteString where toSql b = SqlBlob $ BB.toByteString $ BB.fromLazyByteString b+ {-# INLINEABLE toSql #-} instance FromSql BL.ByteString where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: BL.ByteString)@@ -634,10 +699,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: BL.ByteString) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: BL.ByteString) safeFromSql SqlNull = nullConvertError (undefined :: BL.ByteString)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Bool where toSql = SqlBool+ {-# INLINEABLE toSql #-} instance FromSql Bool where safeFromSql (SqlDecimal d) = Right $ d /= 0@@ -661,10 +729,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Bool) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: Bool) safeFromSql SqlNull = nullConvertError (undefined :: Bool)+ {-# INLINEABLE safeFromSql #-} + instance ToSql BitField where toSql = SqlBitField+ {-# INLINEABLE toSql #-} instance FromSql BitField where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: BitField)@@ -680,10 +751,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: BitField) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: BitField) safeFromSql SqlNull = nullConvertError (undefined :: BitField)+ {-# INLINEABLE safeFromSql #-} + instance ToSql UUID where toSql = SqlUUID+ {-# INLINEABLE toSql #-} instance FromSql UUID where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: UUID)@@ -701,10 +775,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: UUID) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: UUID) safeFromSql SqlNull = nullConvertError (undefined :: UUID)+ {-# INLINEABLE safeFromSql #-} + instance ToSql UTCTime where toSql = SqlUTCTime+ {-# INLINEABLE toSql #-} instance FromSql UTCTime where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: UTCTime)@@ -720,10 +797,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: UTCTime) safeFromSql (SqlLocalTime lt) = incompatibleTypes lt (undefined :: UTCTime) safeFromSql SqlNull = nullConvertError (undefined :: UTCTime)+ {-# INLINEABLE safeFromSql #-} + instance ToSql Day where toSql = SqlLocalDate+ {-# INLINEABLE toSql #-} instance FromSql Day where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: Day)@@ -739,10 +819,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: Day) safeFromSql (SqlLocalTime lt) = Right $ localDay lt safeFromSql SqlNull = nullConvertError (undefined :: Day)+ {-# INLINEABLE safeFromSql #-} + instance ToSql TimeOfDay where toSql = SqlLocalTimeOfDay+ {-# INLINEABLE toSql #-} instance FromSql TimeOfDay where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: TimeOfDay)@@ -758,10 +841,13 @@ safeFromSql (SqlLocalTimeOfDay tod) = Right $ tod safeFromSql (SqlLocalTime lt) = Right $ localTimeOfDay lt safeFromSql SqlNull = nullConvertError (undefined :: TimeOfDay)+ {-# INLINEABLE safeFromSql #-} + instance ToSql LocalTime where toSql = SqlLocalTime+ {-# INLINEABLE toSql #-} instance FromSql LocalTime where safeFromSql (SqlDecimal d) = incompatibleTypes d (undefined :: LocalTime)@@ -777,21 +863,154 @@ safeFromSql (SqlLocalTimeOfDay tod) = incompatibleTypes tod (undefined :: LocalTime) safeFromSql (SqlLocalTime lt) = Right $ lt safeFromSql SqlNull = nullConvertError (undefined :: LocalTime)+ {-# INLINEABLE safeFromSql #-} instance (ToSql a) => ToSql (Maybe a) where toSql m = case m of Nothing -> SqlNull Just a -> toSql a+ {-# INLINEABLE toSql #-} instance (FromSql a) => FromSql (Maybe a) where safeFromSql SqlNull = Right Nothing safeFromSql x = Just <$> safeFromSql x+ {-# INLINEABLE safeFromSql #-} +-- | This instance must not be considered as (Maybe row) but as row with exactly+-- one nullable value+instance (ToSql a) => ToRow (Maybe a) where+ toRow a = [toSql a]+ {-# INLINEABLE toRow #-} +-- | This instance must not be considered as (Maybe row) but as row with exactly+-- one nullable value+instance (FromSql a) => FromRow (Maybe a) where+ safeFromRow [a] = safeFromSql a+ safeFromRow x = Left $ ConvertError $ "length of row must be 1, not" ++ (show $ length x)+ {-# INLINEABLE safeFromRow #-}+++instance (ToSql a, ToSql b) => ToSql (Either a b) where+ toSql (Left a) = toSql a+ toSql (Right b) = toSql b+ {-# INLINEABLE toSql #-}+++-- | Tries to convert to Left type first, if it fails try convert to Right type+instance (FromSql a, FromSql b) => FromSql (Either a b) where+ safeFromSql x = case safeFromSql x of+ Right a -> Right $ Left a+ Left _ -> case safeFromSql x of+ Right b -> Right $ Right b+ Left e -> Left e+ {-# INLINEABLE safeFromSql #-}++instance (ToSql a, ToSql b) => ToRow (Either a b) where+ toRow a = [toSql a]+ {-# INLINEABLE toRow #-}++instance (FromSql a, FromSql b) => FromRow (Either a b) where+ safeFromRow [a] = safeFromSql a+ safeFromRow x = Left $ ConvertError $ "length of row must be 1, not" ++ (show $ length x)+ {-# INLINEABLE safeFromRow #-}+ instance ToSql SqlValue where toSql = id+ {-# INLINEABLE toSql #-} instance FromSql SqlValue where safeFromSql x = Right x+ {-# INLINEABLE safeFromSql #-} fromSql = id+ {-# INLINEABLE fromSql #-}++instance ToRow SqlValue where+ toRow a = [a]+ {-# INLINEABLE toRow #-}++instance FromRow SqlValue where+ safeFromRow [a] = Right a+ safeFromRow x = Left $ ConvertError $ "length of row must be 1, not" ++ (show $ length x)+ {-# INLINEABLE safeFromRow #-}++instance ToRow [SqlValue] where+ toRow a = a+ {-# INLINEABLE toRow #-}++instance FromRow [SqlValue] where+ fromRow a = a+ {-# INLINEABLE fromRow #-}+ safeFromRow a = Right a+ {-# INLINEABLE safeFromRow #-}+++-- | creates row of one element+one :: (ToSql a) => a -> [SqlValue]+one a = [toSql a]+{-# INLINEABLE one #-}++-- | create row of one Integer element+onei :: Integer -> [SqlValue]+onei = one+{-# INLINEABLE onei #-}++-- | create row of one Double element+oned :: Double -> [SqlValue]+oned = one+{-# INLINEABLE oned #-}++onet :: T.Text -> [SqlValue]+onet = one+{-# INLINEABLE onet #-}++onetl :: TL.Text -> [SqlValue]+onetl = one+{-# INLINEABLE onetl #-}++oneb :: B.ByteString -> [SqlValue]+oneb = one+{-# INLINEABLE oneb #-}++onebl :: BL.ByteString -> [SqlValue]+onebl = one+{-# INLINEABLE onebl #-}++-- | unwrap the row of one element safely+safeUnOne :: (FromSql a) => [SqlValue] -> Either ConvertError a+safeUnOne [a] = safeFromSql a+safeUnOne x = Left $ ConvertError+ $ "safeUnOne: row must contain exactly ONE element, not " ++ (show $ length x)+{-# INLINEABLE safeUnOne #-}++-- | same as `safeUnOne` but throws an exception if not converted+unone :: (FromSql a) => [SqlValue] -> a+unone x = case safeUnOne x of+ Left e -> throw e+ Right a -> a+{-# INLINEABLE unone #-}++-- | unwrap row of one Integer+unonei :: [SqlValue] -> Integer+unonei = unone+{-# INLINEABLE unonei #-}++unoned :: [SqlValue] -> Double+unoned = unone+{-# INLINEABLE unoned #-}++unonet :: [SqlValue] -> T.Text+unonet = unone+{-# INLINEABLE unonet #-}++unonetl :: [SqlValue] -> TL.Text+unonetl = unone+{-# INLINEABLE unonetl #-}++unoneb :: [SqlValue] -> B.ByteString+unoneb = unone+{-# INLINEABLE unoneb #-}++unonebl :: [SqlValue] -> BL.ByteString+unonebl = unone+{-# INLINEABLE unonebl #-}
Database/HDBI/Types.hs view
@@ -1,10 +1,12 @@ {-# LANGUAGE TypeFamilies+ , CPP , DeriveDataTypeable , ExistentialQuantification , FlexibleContexts , ScopedTypeVariables , GeneralizedNewtypeDeriving+ , BangPatterns #-} {- |@@ -38,28 +40,27 @@ , castStatement , withTransaction , withStatement- , runRow- , runManyRows- , executeRow- , executeManyRows- , fetchRow- , fetchAllRows+ , runFetch+ , runFetchAll+ , runFetchOne ) where -+#if ! (MIN_VERSION_base(4,6,0)) import Prelude hiding (catch)-+#endif import Control.Applicative ((<$>)) import Control.DeepSeq (NFData(..)) import Control.Exception (Exception(..), SomeException, try, catch, throwIO, bracket) import Control.Monad (forM_) import Data.Data (Data(..))-import Data.Monoid (Monoid(..), Endo(..))+import Data.Monoid (Monoid(..)) import Data.String (IsString(..)) import Data.Typeable-import Database.HDBI.SqlValue (SqlValue, ToRow(..), FromRow(..))+import Database.HDBI.SqlValue (ToRow(..), FromRow(..), FromSql(..), ConvertError(..))+import qualified Data.Sequence as S import qualified Data.Text.Lazy as TL + -- | Error throwing by driver when database operation fails data SqlError = -- | Internal database error@@ -133,21 +134,26 @@ -- | Run query and safely finalize statement after that. Has default -- implementation through 'execute'.- run :: conn -> Query -> [SqlValue] -> IO ()- run conn query values = withStatement conn query $- \s -> execute s values-- -- | Run raw query without parameters and safely finalize statement. Has- -- default implementation through 'executeRaw'.- runRaw :: conn -> Query -> IO ()- runRaw conn query = withStatement conn query executeRaw+ run :: (ToRow row) => conn -> Query -> row -> IO ()+ run conn query row = withStatement conn query+ $ \s -> execute s row+ {-# INLINEABLE run #-} -- | Execute query with set of parameters. Has default implementation through -- 'executeMany'.- runMany :: conn -> Query -> [[SqlValue]] -> IO ()- runMany conn query values = withStatement conn query $- \s -> executeMany s values+ runMany :: (ToRow row) => conn -> Query -> [row] -> IO ()+ runMany conn query rows = withStatement conn query+ $ \s -> executeMany s rows+ {-# INLINEABLE runMany #-} + -- | Run raw query. Many databases has an ablility to run a raw queries+ -- separated by semicolon. Implementation of this method must use this+ -- ability.+ -- Has default implementation through 'run'+ runRaw :: conn -> Query -> IO ()+ runRaw con query = run con query ()+ {-# INLINEABLE runRaw #-}+ -- | Clone the database connection. Return new connection with the same -- settings clone :: conn -> IO conn@@ -180,8 +186,8 @@ connStatus (ConnWrapper conn) = connStatus conn prepare (ConnWrapper conn) str = StmtWrapper <$> prepare conn str run (ConnWrapper conn) = run conn- runRaw (ConnWrapper conn) = runRaw conn runMany (ConnWrapper conn) = runMany conn+ runRaw (ConnWrapper conn) = runRaw conn clone (ConnWrapper conn) = ConnWrapper <$> clone conn hdbiDriverName (ConnWrapper conn) = hdbiDriverName conn dbTransactionSupport (ConnWrapper conn) = dbTransactionSupport conn@@ -209,18 +215,13 @@ -- for PostgreSQL which uses placeholders like ''$1''. Application must ensure -- that the count of placeholders is equal to count of parameter, it is likely -- cause an error if it is not.- execute :: stmt -> [SqlValue] -> IO ()-- -- | Execute single query without parameters. Has default implementation- -- through 'execute'.- executeRaw :: stmt -> IO ()- executeRaw stmt = execute stmt []+ execute :: (ToRow row) => stmt -> row -> IO () -- | Execute one query many times with a list of paramters. Has default -- implementation through 'execute'.- executeMany :: stmt -> [[SqlValue]] -> IO ()- executeMany stmt vals = forM_ vals $ \val -> do- execute stmt val+ executeMany :: (ToRow row) => stmt -> [row] -> IO ()+ executeMany stmt rows = forM_ rows $ \row -> do+ execute stmt row reset stmt -- | Return the current statement's status.@@ -241,20 +242,18 @@ -- -- NOTE: You still need to explicitly finish the statement after receiving -- Nothing, unlike with old HDBC interface.- fetch :: stmt -> IO (Maybe [SqlValue])+ fetch :: (FromRow row) => stmt -> IO (Maybe row) -- | Optional method to strictly fetch all rows from statement. Has default -- implementation through 'fetch'.- fetchAll :: stmt -> IO [[SqlValue]]- fetchAll stmt = do- e <- f mempty- return $ (appEndo e) []+ fetchAll :: (FromRow row) => stmt -> IO (S.Seq row)+ fetchAll stmt = fetchAll' S.empty where- f acc = do- res <- fetchRow stmt- case res of- Just r -> f (acc `mappend` (Endo (r:)))- Nothing -> return acc+ fetchAll' !s = do+ r <- fetch stmt+ case r of+ Nothing -> return s+ Just row -> fetchAll' $ s S.|> row -- | Return list of column names of the result. getColumnNames :: stmt -> IO [TL.Text]@@ -262,7 +261,7 @@ -- | Return the number of columns representing the result. Has default -- implementation through 'getColumnNames' getColumnsCount :: stmt -> IO Int- getColumnsCount stmt = fmap length $ getColumnNames stmt+ getColumnsCount stmt = length <$> getColumnNames stmt -- | Return the original query the statement was prepared from. originalQuery :: stmt -> Query@@ -274,7 +273,6 @@ instance Statement StmtWrapper where execute (StmtWrapper stmt) = execute stmt- executeRaw (StmtWrapper stmt) = executeRaw stmt executeMany (StmtWrapper stmt) = executeMany stmt statementStatus (StmtWrapper stmt) = statementStatus stmt finish (StmtWrapper stmt) = finish stmt@@ -331,24 +329,31 @@ withStatement conn query = bracket (prepare conn query) finish+{-# INLINEABLE withStatement #-} --- | same as `run` but uses `ToRow` instance-runRow :: (Connection con, ToRow a) => con -> Query -> a -> IO ()-runRow con query row = run con query $ toRow row---- | same as `runMany` but uses `ToRow`-runManyRows :: (Connection con, ToRow a) => con -> Query -> [a] -> IO ()-runManyRows con query rows = runMany con query $ map toRow rows--executeRow :: (Statement stmt, ToRow a) => stmt -> a -> IO ()-executeRow stmt row = execute stmt $ toRow row--executeManyRows :: (Statement stmt, ToRow a) => stmt -> [a] -> IO ()-executeManyRows stmt rows = executeMany stmt $ map toRow rows+-- | Run query and return first row+runFetch :: (Connection con, ToRow params, FromRow row)+ => con -> Query -> params -> IO (Maybe row)+runFetch con query params = withStatement con query $ \stmt -> do+ execute stmt params+ fetch stmt -fetchRow :: (Statement stmt, FromRow a) => stmt -> IO (Maybe a)-fetchRow stmt = fetch stmt >>= return . (fromRow <$>)+runFetchAll :: (Connection con, ToRow params, FromRow row)+ => con -> Query -> params -> IO (S.Seq row)+runFetchAll con query params = withStatement con query $ \stmt -> do+ execute stmt params+ fetchAll stmt -fetchAllRows :: (Statement stmt, FromRow a) => stmt -> IO [a]-fetchAllRows stmt = fetchAll stmt >>= return . map fromRow+runFetchOne :: (Connection con, ToRow params, FromSql col)+ => con -> Query -> params -> IO (Maybe col)+runFetchOne con query params = withStatement con query $ \stmt -> do+ execute stmt params+ r <- fetch stmt+ case r of+ Nothing -> return Nothing+ (Just [col]) -> case safeFromSql col of+ Left e -> throwIO e+ Right row -> return $ Just row+ (Just x) -> throwIO $ ConvertError $ "Query \"" ++ (TL.unpack $ unQuery query)+ ++ "\" should return exactly ONE column, but returned " ++ (show $ length x)
hdbi.cabal view
@@ -1,5 +1,5 @@ Name: hdbi-Version: 1.2.0+Version: 1.3.0 License: BSD3 Maintainer: Aleksey Uymanov <s9gf4ult@gmail.com> Author: John Goerzen
testsrc/dummydriver.hs view
@@ -23,7 +23,7 @@ import Test.HUnit (Assertion) import Test.Hspec.Expectations import qualified Data.IntMap as M-+import qualified Data.Foldable as F data TStatus = TIdle | TInTransaction deriving (Eq, Show, Read, Typeable)@@ -118,7 +118,7 @@ instance Statement DummyStatement where- execute stmt params = modifyMVar_ (dsStatus stmt) $ \st -> do+ execute stmt prms = modifyMVar_ (dsStatus stmt) $ \st -> do case st of StatementNew -> do case originalQuery stmt of@@ -127,6 +127,8 @@ "select" -> modifyMVar (dsSelecting stmt) $ const $ return (Just 0, StatementExecuted) _ -> return StatementExecuted _ -> throwIO $ SqlError "6" $ "Statement has wrong status to execute query " ++ show st+ where+ params = toRow prms statementStatus = readMVar . dsStatus @@ -147,7 +149,7 @@ Just sl -> do dt <- readMVar $ dcData $ dsConnection stmt if (length dt) > sl- then return (Just $ sl+1, Just $ dt !! sl)+ then return (Just $ sl+1, Just $ fromRow $ dt !! sl) else return (Nothing, Nothing) @@ -162,7 +164,7 @@ intr <- inTransaction c intr `shouldBe` True stmt <- prepare c "throw" -- cause an exception throwing- executeRaw stmt+ execute stmt () ) `shouldThrow` (\(_ :: SqlError) -> True) intr <- inTransaction c intr `shouldBe` False -- after rollback@@ -175,7 +177,7 @@ intr1 `shouldBe` False withTransaction c $ do stmt <- prepare c "dummy query"- executeRaw stmt+ execute stmt () intr <- inTransaction c intr `shouldBe` True intr <- inTransaction c@@ -196,7 +198,7 @@ Just c -> do st1 <- prepare c "query 1" st2 <- prepare c "query 2"- executeRaw st2+ execute st2 () prts <- readTVarIO $ clList $ dcChilds c (length $ M.toList prts) `shouldBe` 2 @@ -245,9 +247,9 @@ execute s3 $ indt !! 2 finish s3 ss <- prepare c "select"- executeRaw ss+ execute ss () outdt <- fetchAll ss- outdt `shouldBe` indt+ F.toList outdt `shouldBe` indt noStatementsAfterDisconnect :: Assertion noStatementsAfterDisconnect = do@@ -266,11 +268,11 @@ sub c = do withStatement c "query string" $ \st -> do -- this statement should be -- finished- executeRaw st- _ <- fetch st+ execute st ()+ (_ :: Maybe ()) <- fetch st return () s <- prepare c "query string" -- but this should not- executeRaw s+ execute s () s2 <- prepare c "query string" return ()