{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.Record.Query (
PreparedQuery, prepare, prepareQuery, withPrepareQuery,
fetch, fetchAll',
listToUnique, fetchUnique, fetchUnique',
runStatement',
runPreparedQuery',
runQuery',
foldlFetch, forFetch,
fetchAll,
runStatement,
runPreparedQuery,
runQuery,
) where
import Control.Applicative ((<$>), pure)
import Data.Monoid (mempty, (<>))
import Data.Maybe (listToMaybe)
import Data.DList (toList)
import Database.HDBC (IConnection, Statement, SqlValue)
import qualified Database.HDBC as HDBC
import Database.Relational (Query, untypeQuery)
import Database.Record (ToSql, FromSql, toRecord)
import Database.HDBC.Record.Statement
(unsafePrepare, withUnsafePrepare, PreparedStatement,
bind, BoundStatement,
executeBound, ExecutedStatement, executed)
type PreparedQuery p a = PreparedStatement p a
prepare :: IConnection conn
=> conn
-> Query p a
-> IO (PreparedQuery p a)
prepare :: conn -> Query p a -> IO (PreparedQuery p a)
prepare conn :: conn
conn = conn -> String -> IO (PreparedQuery p a)
forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn (String -> IO (PreparedQuery p a))
-> (Query p a -> String) -> Query p a -> IO (PreparedQuery p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query p a -> String
forall p a. Query p a -> String
untypeQuery
prepareQuery :: IConnection conn
=> conn
-> Query p a
-> IO (PreparedQuery p a)
prepareQuery :: conn -> Query p a -> IO (PreparedQuery p a)
prepareQuery = conn -> Query p a -> IO (PreparedQuery p a)
forall conn p a.
IConnection conn =>
conn -> Query p a -> IO (PreparedQuery p a)
prepare
withPrepareQuery :: IConnection conn
=> conn
-> Query p a
-> (PreparedQuery p a -> IO b)
-> IO b
withPrepareQuery :: conn -> Query p a -> (PreparedQuery p a -> IO b) -> IO b
withPrepareQuery conn :: conn
conn = conn -> String -> (PreparedQuery p a -> IO b) -> IO b
forall conn p a b.
IConnection conn =>
conn -> String -> (PreparedStatement p a -> IO b) -> IO b
withUnsafePrepare conn
conn (String -> (PreparedQuery p a -> IO b) -> IO b)
-> (Query p a -> String)
-> Query p a
-> (PreparedQuery p a -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query p a -> String
forall p a. Query p a -> String
untypeQuery
fetchRecords :: (Functor f, FromSql SqlValue a)
=> (Statement -> IO (f [SqlValue]) )
-> ExecutedStatement a
-> IO (f a)
fetchRecords :: (Statement -> IO (f [SqlValue])) -> ExecutedStatement a -> IO (f a)
fetchRecords fetchs :: Statement -> IO (f [SqlValue])
fetchs es :: ExecutedStatement a
es = do
f [SqlValue]
rows <- Statement -> IO (f [SqlValue])
fetchs (ExecutedStatement a -> Statement
forall a. ExecutedStatement a -> Statement
executed ExecutedStatement a
es)
f a -> IO (f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> IO (f a)) -> f a -> IO (f a)
forall a b. (a -> b) -> a -> b
$ ([SqlValue] -> a) -> f [SqlValue] -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SqlValue] -> a
forall q a. FromSql q a => [q] -> a
toRecord f [SqlValue]
rows
fetch :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetch :: ExecutedStatement a -> IO (Maybe a)
fetch = (Statement -> IO (Maybe [SqlValue]))
-> ExecutedStatement a -> IO (Maybe a)
forall (f :: * -> *) a.
(Functor f, FromSql SqlValue a) =>
(Statement -> IO (f [SqlValue])) -> ExecutedStatement a -> IO (f a)
fetchRecords Statement -> IO (Maybe [SqlValue])
HDBC.fetchRow
fetchAll :: FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll :: ExecutedStatement a -> IO [a]
fetchAll = (Statement -> IO [[SqlValue]]) -> ExecutedStatement a -> IO [a]
forall (f :: * -> *) a.
(Functor f, FromSql SqlValue a) =>
(Statement -> IO (f [SqlValue])) -> ExecutedStatement a -> IO (f a)
fetchRecords Statement -> IO [[SqlValue]]
HDBC.fetchAllRows
fetchAll' :: FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll' :: ExecutedStatement a -> IO [a]
fetchAll' = (Statement -> IO [[SqlValue]]) -> ExecutedStatement a -> IO [a]
forall (f :: * -> *) a.
(Functor f, FromSql SqlValue a) =>
(Statement -> IO (f [SqlValue])) -> ExecutedStatement a -> IO (f a)
fetchRecords Statement -> IO [[SqlValue]]
HDBC.fetchAllRows'
fetchUnique :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetchUnique :: ExecutedStatement a -> IO (Maybe a)
fetchUnique es :: ExecutedStatement a
es = do
[a]
recs <- ExecutedStatement a -> IO [a]
forall a. FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll ExecutedStatement a
es
let z' :: Maybe a
z' = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a]
recs
Maybe a
z <- Maybe a
z' Maybe a -> IO (Maybe a) -> IO (Maybe a)
forall a b. a -> b -> b
`seq` Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
z'
Statement -> IO ()
HDBC.finish (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ ExecutedStatement a -> Statement
forall a. ExecutedStatement a -> Statement
executed ExecutedStatement a
es
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
z
listToUnique :: [a] -> IO (Maybe a)
listToUnique :: [a] -> IO (Maybe a)
listToUnique = [a] -> IO (Maybe a)
forall (m :: * -> *) a. MonadFail m => [a] -> m (Maybe a)
d where
d :: [a] -> m (Maybe a)
d [] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
d [r :: a
r] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
r
d (_:_:_) = String -> m (Maybe a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "fetchUnique': more than one record found."
fetchUnique' :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetchUnique' :: ExecutedStatement a -> IO (Maybe a)
fetchUnique' es :: ExecutedStatement a
es = do
[a]
recs <- ExecutedStatement a -> IO [a]
forall a. FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll ExecutedStatement a
es
Maybe a
z <- [a] -> IO (Maybe a)
forall a. [a] -> IO (Maybe a)
listToUnique [a]
recs
Statement -> IO ()
HDBC.finish (Statement -> IO ()) -> Statement -> IO ()
forall a b. (a -> b) -> a -> b
$ ExecutedStatement a -> Statement
forall a. ExecutedStatement a -> Statement
executed ExecutedStatement a
es
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
z
foldlFetch :: FromSql SqlValue a
=> (b -> a -> IO b)
-> b
-> ExecutedStatement a
-> IO b
foldlFetch :: (b -> a -> IO b) -> b -> ExecutedStatement a -> IO b
foldlFetch f :: b -> a -> IO b
f z :: b
z st :: ExecutedStatement a
st =
b -> IO b
go b
z
where
go :: b -> IO b
go ac :: b
ac = do
let step :: a -> IO b
step = (b -> IO b
go (b -> IO b) -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO b -> IO b) -> (a -> IO b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> IO b
f b
ac
IO b -> (a -> IO b) -> Maybe a -> IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
ac) a -> IO b
step (Maybe a -> IO b) -> IO (Maybe a) -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExecutedStatement a -> IO (Maybe a)
forall a. FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)
fetch ExecutedStatement a
st
forFetch :: FromSql SqlValue a
=> ExecutedStatement a
-> (a -> IO b)
-> IO [b]
forFetch :: ExecutedStatement a -> (a -> IO b) -> IO [b]
forFetch st :: ExecutedStatement a
st action :: a -> IO b
action =
DList b -> [b]
forall a. DList a -> [a]
toList (DList b -> [b]) -> IO (DList b) -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(DList b -> a -> IO (DList b))
-> DList b -> ExecutedStatement a -> IO (DList b)
forall a b.
FromSql SqlValue a =>
(b -> a -> IO b) -> b -> ExecutedStatement a -> IO b
foldlFetch (\ac :: DList b
ac x :: a
x -> ((DList b
ac DList b -> DList b -> DList b
forall a. Semigroup a => a -> a -> a
<>) (DList b -> DList b) -> (b -> DList b) -> b -> DList b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> DList b
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (b -> DList b) -> IO b -> IO (DList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO b
action a
x) DList b
forall a. Monoid a => a
mempty ExecutedStatement a
st
runStatement :: FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement :: BoundStatement a -> IO [a]
runStatement = (IO (ExecutedStatement a)
-> (ExecutedStatement a -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutedStatement a -> IO [a]
forall a. FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll) (IO (ExecutedStatement a) -> IO [a])
-> (BoundStatement a -> IO (ExecutedStatement a))
-> BoundStatement a
-> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundStatement a -> IO (ExecutedStatement a)
forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound
runStatement' :: FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement' :: BoundStatement a -> IO [a]
runStatement' = (IO (ExecutedStatement a)
-> (ExecutedStatement a -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutedStatement a -> IO [a]
forall a. FromSql SqlValue a => ExecutedStatement a -> IO [a]
fetchAll') (IO (ExecutedStatement a) -> IO [a])
-> (BoundStatement a -> IO (ExecutedStatement a))
-> BoundStatement a
-> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundStatement a -> IO (ExecutedStatement a)
forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound
runPreparedQuery :: (ToSql SqlValue p, FromSql SqlValue a)
=> PreparedQuery p a
-> p
-> IO [a]
runPreparedQuery :: PreparedQuery p a -> p -> IO [a]
runPreparedQuery ps :: PreparedQuery p a
ps = BoundStatement a -> IO [a]
forall a. FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement (BoundStatement a -> IO [a])
-> (p -> BoundStatement a) -> p -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedQuery p a -> p -> BoundStatement a
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind PreparedQuery p a
ps
runPreparedQuery' :: (ToSql SqlValue p, FromSql SqlValue a)
=> PreparedQuery p a
-> p
-> IO [a]
runPreparedQuery' :: PreparedQuery p a -> p -> IO [a]
runPreparedQuery' ps :: PreparedQuery p a
ps = BoundStatement a -> IO [a]
forall a. FromSql SqlValue a => BoundStatement a -> IO [a]
runStatement' (BoundStatement a -> IO [a])
-> (p -> BoundStatement a) -> p -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedQuery p a -> p -> BoundStatement a
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind PreparedQuery p a
ps
runQuery :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
=> conn
-> Query p a
-> p
-> IO [a]
runQuery :: conn -> Query p a -> p -> IO [a]
runQuery conn :: conn
conn q :: Query p a
q p :: p
p = conn -> Query p a -> IO (PreparedQuery p a)
forall conn p a.
IConnection conn =>
conn -> Query p a -> IO (PreparedQuery p a)
prepare conn
conn Query p a
q IO (PreparedQuery p a) -> (PreparedQuery p a -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PreparedQuery p a -> p -> IO [a]
forall p a.
(ToSql SqlValue p, FromSql SqlValue a) =>
PreparedQuery p a -> p -> IO [a]
`runPreparedQuery` p
p)
runQuery' :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
=> conn
-> Query p a
-> p
-> IO [a]
runQuery' :: conn -> Query p a -> p -> IO [a]
runQuery' conn :: conn
conn q :: Query p a
q p :: p
p = conn -> Query p a -> (PreparedQuery p a -> IO [a]) -> IO [a]
forall conn p a b.
IConnection conn =>
conn -> Query p a -> (PreparedQuery p a -> IO b) -> IO b
withPrepareQuery conn
conn Query p a
q (PreparedQuery p a -> p -> IO [a]
forall p a.
(ToSql SqlValue p, FromSql SqlValue a) =>
PreparedQuery p a -> p -> IO [a]
`runPreparedQuery'` p
p)