{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.HDBC.Record.Query
-- Copyright   : 2013 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides typed 'Query' running sequence
-- which intermediate structures are typed.
module Database.HDBC.Record.Query (
  -- * Prepare
  PreparedQuery, prepare, prepareQuery, withPrepareQuery,

  -- * Fetch strictly
  fetch, fetchAll',
  listToUnique, fetchUnique, fetchUnique',

  runStatement',
  runPreparedQuery',
  runQuery',

  -- * Fetch loop
  foldlFetch, forFetch,

  -- * Fetch with Lazy-IO
  -- $fetchWithLazyIO
  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)


-- | Typed prepared query type.
type PreparedQuery p a = PreparedStatement p a

-- | Typed prepare query operation.
prepare :: IConnection conn
        => conn                   -- ^ Database connection
        -> Query p a              -- ^ Typed query
        -> IO (PreparedQuery p a) -- ^ Result typed prepared query with parameter type 'p' and result type '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

-- | Same as 'prepare'.
prepareQuery :: IConnection conn
             => conn                   -- ^ Database connection
             -> Query p a              -- ^ Typed query
             -> IO (PreparedQuery p a) -- ^ Result typed prepared query with parameter type 'p' and result type '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

-- | Bracketed prepare operation.
--   PreparedStatement is released on closing connection,
--   so connection pooling cases often cause resource leaks.
withPrepareQuery :: IConnection conn
                 => conn                        -- ^ Database connection
                 -> Query p a                   -- ^ Typed query
                 -> (PreparedQuery p a -> IO b) -- ^ Body action to use prepared statement
                 -> IO b                        -- ^ Result action
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

-- | Polymorphic fetch operation.
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

{- $fetchWithLazyIO
__CAUTION!!__

/Lazy-IO/ APIs may be harmful in complex transaction with RDBMs interfaces
which require sequential ordered calls of low-level APIs.
 -}

-- | Fetch a record.
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

-- | /Lazy-IO/ version of 'fetchAll''.
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

-- | Strictly fetch all records.
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'

-- | Fetch all records but get only first record.
--   Expecting result records is unique.
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

-- | Fetch expecting result records is unique.
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."

-- | Fetch all records but get only first record.
--   Expecting result records is unique.
--   Error when records count is more than one.
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

-- | Fetch fold-left loop convenient for
--   the sequence of cursor-solid lock actions.
--   Each action is executed after each fetch.
foldlFetch :: FromSql SqlValue a
           => (b -> a -> IO b)    -- ^ action executed after each fetch
           -> b                   -- ^ zero element of result
           -> ExecutedStatement a -- ^ statement to fetch from
           -> 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

-- | Fetch loop convenient for
--   the sequence of cursor-solid lock actions.
--   Each action is executed after each fetch.
forFetch :: FromSql SqlValue a
         => ExecutedStatement a -- ^ statement to fetch from
         -> (a -> IO b)         -- ^ action executed after each fetch
         -> 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

-- | /Lazy-IO/ version of 'runStatement''.
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

-- | Execute a parameter-bounded statement and strictly fetch all records.
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

-- | /Lazy-IO/ version of 'runPreparedQuery''.
runPreparedQuery :: (ToSql SqlValue p, FromSql SqlValue a)
                 => PreparedQuery p a -- ^ Statement to bind to
                 -> p                 -- ^ Parameter type
                 -> IO [a]            -- ^ Action to get records
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

-- | Bind parameters, execute statement and strictly fetch all records.
runPreparedQuery' :: (ToSql SqlValue p, FromSql SqlValue a)
                  => PreparedQuery p a -- ^ Statement to bind to
                  -> p                 -- ^ Parameter type
                  -> IO [a]            -- ^ Action to get records
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

-- | /Lazy-IO/ version of 'runQuery''.
runQuery :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
         => conn      -- ^ Database connection
         -> Query p a -- ^ Query to get record type 'a' requires parameter 'p'
         -> p         -- ^ Parameter type
         -> IO [a]    -- ^ Action to get records
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)

-- | Prepare SQL, bind parameters, execute statement and strictly fetch all records.
runQuery' :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)
          => conn      -- ^ Database connection
          -> Query p a -- ^ Query to get record type 'a' requires parameter 'p'
          -> p         -- ^ Parameter type
          -> IO [a]    -- ^ Action to get records
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)