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