    {-# LANGUAGE CPP #-}
    -- #hide
    {- |
       Module     : Database.HDBC.Utils
       Copyright  : Copyright (C) 2005-2011 John Goerzen
       License    : BSD3

       Maintainer : John Goerzen <jgoerzen@complete.org>
       Stability  : provisional
       Portability: portable

    Internal module -- not exported directly.

    Everything in here is expoerted by "Database.HDBC".  Please use -- and read --
    "Database.HDBC" directly.

    Written by John Goerzen, jgoerzen\@complete.org
    -}

    module Database.HDBC.Utils where
    import Database.HDBC.Types
    import qualified Data.Map as Map
    import Control.Exception
    import System.IO.Unsafe
    import Data.List(genericLength)

    -- import Data.Dynamic below for GHC < 6.10

    #if __GLASGOW_HASKELL__ >= 610
    {- | Execute the given IO action.

    If it raises a 'SqlError', then execute the supplied handler and return its
    return value.  Otherwise, proceed as normal. -}
    catchSql :: IO a -> (SqlError -> IO a) -> IO a
    catchSql :: forall a. IO a -> (SqlError -> IO a) -> IO a
    catchSql IO a
    action SqlError -> IO a
    handler =
        (SqlError -> Maybe SqlError) -> IO a -> (SqlError -> IO a) -> IO a
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
    catchJust SqlError -> Maybe SqlError
    sqlExceptions IO a
    action SqlError -> IO a
    handler

    {- | Like 'catchSql', with the order of arguments reversed. -}
    handleSql :: (SqlError -> IO a) -> IO a -> IO a
    handleSql :: forall a. (SqlError -> IO a) -> IO a -> IO a
    handleSql SqlError -> IO a
    h IO a
    f = IO a -> (SqlError -> IO a) -> IO a
    forall a. IO a -> (SqlError -> IO a) -> IO a
    catchSql IO a
    f SqlError -> IO a
    h

    {- | Given an Exception, return Just SqlError if it was an SqlError, or Nothing
    otherwise. Useful with functions like catchJust. -}
    sqlExceptions :: SqlError -> Maybe SqlError
    sqlExceptions :: SqlError -> Maybe SqlError
    sqlExceptions SqlError
    e = SqlError -> Maybe SqlError
    forall a. a -> Maybe a
    Just SqlError
    e

    #else
    import Data.Dynamic

    {- | Execute the given IO action.

    If it raises a 'SqlError', then execute the supplied handler and return its
    return value.  Otherwise, proceed as normal. -}
    catchSql :: IO a -> (SqlError -> IO a) -> IO a
    catchSql = catchDyn

    {- | Like 'catchSql', with the order of arguments reversed. -}
    handleSql :: (SqlError -> IO a) -> IO a -> IO a
    handleSql h f = catchDyn f h

    {- | Given an Exception, return Just SqlError if it was an SqlError, or Nothing
    otherwise. Useful with functions like catchJust. -}
    sqlExceptions :: Exception -> Maybe SqlError
    sqlExceptions e = dynExceptions e >>= fromDynamic
    #endif

    {- | Catches 'SqlError's, and re-raises them as IO errors with fail.
    Useful if you don't care to catch SQL errors, but want to see a sane
    error message if one happens.  One would often use this as a high-level
    wrapper around SQL calls. -}
    handleSqlError :: IO a -> IO a
    handleSqlError :: forall a. IO a -> IO a
    handleSqlError IO a
    action =
        IO a -> (SqlError -> IO a) -> IO a
    forall a. IO a -> (SqlError -> IO a) -> IO a
    catchSql IO a
    action SqlError -> IO a
    forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
    handler
        where handler :: a -> m a
    handler a
    e = String -> m a
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "SQL error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    e)

    {- | Like 'run', but take a list of Maybe Strings instead of 'SqlValue's. -}
    sRun :: IConnection conn => conn -> String -> [Maybe String] -> IO Integer
    sRun :: forall conn.
    IConnection conn =>
    conn -> String -> [Maybe String] -> IO Integer
    sRun conn
    conn String
    qry [Maybe String]
    lst =
        conn -> String -> [SqlValue] -> IO Integer
    forall conn.
    IConnection conn =>
    conn -> String -> [SqlValue] -> IO Integer
    run conn
    conn String
    qry ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe String -> SqlValue
    forall a. Convertible a SqlValue => a -> SqlValue
    toSql [Maybe String]
    lst)

    {- | Like 'execute', but take a list of Maybe Strings instead of
       'SqlValue's. -}
    sExecute :: Statement -> [Maybe String] -> IO Integer
    sExecute :: Statement -> [Maybe String] -> IO Integer
    sExecute Statement
    sth [Maybe String]
    lst = Statement -> [SqlValue] -> IO Integer
    execute Statement
    sth ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe String -> SqlValue
    forall a. Convertible a SqlValue => a -> SqlValue
    toSql [Maybe String]
    lst)

    {- | Like 'executeMany', but take a list of Maybe Strings instead of
       'SqlValue's. -}
    sExecuteMany :: Statement -> [[Maybe String]] -> IO ()
    sExecuteMany :: Statement -> [[Maybe String]] -> IO ()
    sExecuteMany Statement
    sth [[Maybe String]]
    lst =
        Statement -> [[SqlValue]] -> IO ()
    executeMany Statement
    sth (([Maybe String] -> [SqlValue]) -> [[Maybe String]] -> [[SqlValue]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Maybe String -> SqlValue) -> [Maybe String] -> [SqlValue]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe String -> SqlValue
    forall a. Convertible a SqlValue => a -> SqlValue
    toSql) [[Maybe String]]
    lst)

    {- | Like 'fetchRow', but return a list of Maybe Strings instead of
       'SqlValue's. -}
    sFetchRow :: Statement -> IO (Maybe [Maybe String])
    sFetchRow :: Statement -> IO (Maybe [Maybe String])
    sFetchRow Statement
    sth =
        do res <- Statement -> IO (Maybe [SqlValue])
    fetchRow Statement
    sth
           case res of
             Maybe [SqlValue]
    Nothing -> Maybe [Maybe String] -> IO (Maybe [Maybe String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Maybe String]
    forall a. Maybe a
    Nothing
             Just [SqlValue]
    x -> Maybe [Maybe String] -> IO (Maybe [Maybe String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Maybe String] -> IO (Maybe [Maybe String]))
    -> Maybe [Maybe String] -> IO (Maybe [Maybe String])
    forall a b. (a -> b) -> a -> b
    $ [Maybe String] -> Maybe [Maybe String]
    forall a. a -> Maybe a
    Just ([Maybe String] -> Maybe [Maybe String])
    -> [Maybe String] -> Maybe [Maybe String]
    forall a b. (a -> b) -> a -> b
    $ (SqlValue -> Maybe String) -> [SqlValue] -> [Maybe String]
    forall a b. (a -> b) -> [a] -> [b]
    map SqlValue -> Maybe String
    forall a. Convertible SqlValue a => SqlValue -> a
    fromSql [SqlValue]
    x

    {- | Execute some code.  If any uncaught exception occurs, run
    'rollback' and re-raise it.  Otherwise, run 'commit' and return.

    This function, therefore, encapsulates the logical property that a transaction
    is all about: all or nothing.

    The 'IConnection' object passed in is passed directly to the specified
    function as a convenience.

    This function traps /all/ uncaught exceptions, not just SqlErrors.  Therefore,
    you will get a rollback for any exception that you don't handle.  That's
    probably what you want anyway.

    Since all operations in HDBC are done in a transaction, this function doesn't
    issue an explicit \"begin\" to the server.  You should ideally have
    called 'Database.HDBC.commit' or 'Database.HDBC.rollback' before
    calling this function.  If you haven't, this function will commit or rollback
    more than just the changes made in the included action.

    If there was an error while running 'rollback', this error will not be
    reported since the original exception will be propogated back.  (You'd probably
    like to know about the root cause for all of this anyway.)  Feedback
    on this behavior is solicited.
    -}
    withTransaction :: IConnection conn => conn -> (conn -> IO a) -> IO a
    withTransaction :: forall conn a. IConnection conn => conn -> (conn -> IO a) -> IO a
    withTransaction conn
    conn conn -> IO a
    func =
    #if __GLASGOW_HASKELL__ >= 610
        do r <- IO a -> IO () -> IO a
    forall a b. IO a -> IO b -> IO a
    onException (conn -> IO a
    func conn
    conn) IO ()
    doRollback
           commit conn
           return r
        where doRollback :: IO ()
    doRollback =
                  -- Discard any exception from (rollback conn) so original
                  -- exception can be re-raised
                  IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch (conn -> IO ()
    forall conn. IConnection conn => conn -> IO ()
    rollback conn
    conn) SomeException -> IO ()
    doRollbackHandler
              doRollbackHandler :: SomeException -> IO ()
              doRollbackHandler :: SomeException -> IO ()
    doRollbackHandler SomeException
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #else
        do r <- try (func conn)
           case r of
             Right x -> do commit conn
                           return x
             Left e ->
                 do try (rollback conn) -- Discard any exception here
                    throw e
    #endif
    {- | Lazily fetch all rows from an executed 'Statement'.

    You can think of this as hGetContents applied to a database result set.

    The result of this is a lazy list, and each new row will be read, lazily, from
    the database as the list is processed.

    When you have exhausted the list, the 'Statement' will be 'finish'ed.

    Please note that the careless use of this function can lead to some unpleasant
    behavior.  In particular, if you have not consumed the entire list, then
    attempt to 'finish' or re-execute the statement, and then attempt to consume
    more elements from the list, the result will almost certainly not be what
    you want.

    But then, similar caveats apply with hGetContents.

    Bottom line: this is a very convenient abstraction; use it wisely.

    Use 'fetchAllRows'' if you need something that is strict, without
    all these caveats.
    -}
    fetchAllRows :: Statement -> IO [[SqlValue]]
    fetchAllRows :: Statement -> IO [[SqlValue]]
    fetchAllRows Statement
    sth = IO [[SqlValue]] -> IO [[SqlValue]]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [[SqlValue]] -> IO [[SqlValue]])
    -> IO [[SqlValue]] -> IO [[SqlValue]]
    forall a b. (a -> b) -> a -> b
    $
        do row <- Statement -> IO (Maybe [SqlValue])
    fetchRow Statement
    sth
           case row of
             Maybe [SqlValue]
    Nothing -> [[SqlValue]] -> IO [[SqlValue]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
             Just [SqlValue]
    x -> do remainder <- Statement -> IO [[SqlValue]]
    fetchAllRows Statement
    sth
                          return (x : remainder)

    evalAll :: [[a]] -> IO Integer
    evalAll :: forall a. [[a]] -> IO Integer
    evalAll [[a]]
    inp =
        do r1 <- ([a] -> IO Integer) -> [[a]] -> IO [Integer]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Integer -> IO Integer
    forall a. a -> IO a
    evaluate (Integer -> IO Integer) -> ([a] -> Integer) -> [a] -> IO Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Integer
    forall i a. Num i => [a] -> i
    genericLength) [[a]]
    inp
           evaluate (sum r1)

    {- | Strict version of 'fetchAllRows'.  Does not have the side-effects
    of 'fetchAllRows', but forces the entire result set to be buffered
    in memory. -}
    fetchAllRows' :: Statement -> IO [[SqlValue]]
    fetchAllRows' :: Statement -> IO [[SqlValue]]
    fetchAllRows' Statement
    sth =
        do res <- Statement -> IO [[SqlValue]]
    fetchAllRows Statement
    sth
           _ <- evalAll res
           return res

    {- | Like 'fetchAllRows', but return Maybe Strings instead of 'SqlValue's. -}
    sFetchAllRows :: Statement -> IO [[Maybe String]]
    sFetchAllRows :: Statement -> IO [[Maybe String]]
    sFetchAllRows Statement
    sth =
        do res <- Statement -> IO [[SqlValue]]
    fetchAllRows Statement
    sth
           return $ map (map fromSql) res

    {- | Strict version of 'sFetchAllRows'. -}
    sFetchAllRows' :: Statement -> IO [[Maybe String]]
    sFetchAllRows' :: Statement -> IO [[Maybe String]]
    sFetchAllRows' Statement
    sth =
        do res <- Statement -> IO [[Maybe String]]
    sFetchAllRows Statement
    sth
           _ <- evalAll res
           return res

    {- | Like 'fetchRow', but instead of returning a list, return an association
    list from column name to value.

    The keys of the column names are lowercase versions of the data returned
    by 'getColumnNames'.  Please heed the warnings there.  Additionally,
    results are undefined if multiple columns are returned with identical names.
    -}
    fetchRowAL :: Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL :: Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL Statement
    sth =
        do row <- Statement -> IO (Maybe [SqlValue])
    fetchRow Statement
    sth
           case row of
            Maybe [SqlValue]
    Nothing -> Maybe [(String, SqlValue)] -> IO (Maybe [(String, SqlValue)])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [(String, SqlValue)]
    forall a. Maybe a
    Nothing
            Just [SqlValue]
    r -> do names <- Statement -> IO [String]
    getColumnNames Statement
    sth
                         return $ Just $ zip names r

    {- | Strict version of 'fetchRowAL'. -}
    fetchRowAL' :: Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL' :: Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL' Statement
    sth =
        do res <- Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL Statement
    sth
           _ <- case res of
             Maybe [(String, SqlValue)]
    Nothing -> Integer -> IO Integer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    0
             Just [(String, SqlValue)]
    x -> Integer -> IO Integer
    forall a. a -> IO a
    evaluate (([(String, SqlValue)] -> Integer
    forall i a. Num i => [a] -> i
    genericLength [(String, SqlValue)]
    x)::Integer)
           return res

    {- | Similar to 'fetchRowAL', but return a Map instead of an association list.
    -}
    fetchRowMap :: Statement -> IO (Maybe (Map.Map String SqlValue))
    fetchRowMap :: Statement -> IO (Maybe (Map String SqlValue))
    fetchRowMap Statement
    sth =
        do r <- Statement -> IO (Maybe [(String, SqlValue)])
    fetchRowAL Statement
    sth
           case r of
                  Maybe [(String, SqlValue)]
    Nothing -> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Map String SqlValue)
    forall a. Maybe a
    Nothing
                  Just [(String, SqlValue)]
    x -> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue)))
    -> Maybe (Map String SqlValue) -> IO (Maybe (Map String SqlValue))
    forall a b. (a -> b) -> a -> b
    $ Map String SqlValue -> Maybe (Map String SqlValue)
    forall a. a -> Maybe a
    Just (Map String SqlValue -> Maybe (Map String SqlValue))
    -> Map String SqlValue -> Maybe (Map String SqlValue)
    forall a b. (a -> b) -> a -> b
    $ [(String, SqlValue)] -> Map String SqlValue
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(String, SqlValue)]
    x

    {- | Strict version of 'fetchRowMap'. -}
    fetchRowMap' :: Statement -> IO (Maybe (Map.Map String SqlValue))
    fetchRowMap' :: Statement -> IO (Maybe (Map String SqlValue))
    fetchRowMap' Statement
    sth =
        do res <- Statement -> IO (Maybe (Map String SqlValue))
    fetchRowMap Statement
    sth
           _ <- case res of
                Maybe (Map String SqlValue)
    Nothing -> Integer -> IO Integer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    0
                Just Map String SqlValue
    x -> Integer -> IO Integer
    forall a. a -> IO a
    evaluate (([(String, SqlValue)] -> Integer
    forall i a. Num i => [a] -> i
    genericLength (Map String SqlValue -> [(String, SqlValue)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map String SqlValue
    x))::Integer)
           return res

    {- | Like 'fetchAllRows', but instead of returning a list for each
    row, return an association list for each row, from column name to value.

    See 'fetchRowAL' for more details. -}
    fetchAllRowsAL :: Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL :: Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL Statement
    sth =
        do names <- Statement -> IO [String]
    getColumnNames Statement
    sth
           rows <- fetchAllRows sth
           return $ map (zip names) rows

    {- | Strict version of 'fetchAllRowsAL' -}
    fetchAllRowsAL' :: Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL' :: Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL' Statement
    sth =
        do res <- Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL Statement
    sth
           _ <- evalAll res
           return res

    {- | Like 'fetchAllRowsAL', but return a list of Maps instead of a list of
    association lists. -}
    fetchAllRowsMap :: Statement -> IO [Map.Map String SqlValue]
    fetchAllRowsMap :: Statement -> IO [Map String SqlValue]
    fetchAllRowsMap Statement
    sth = Statement -> IO [[(String, SqlValue)]]
    fetchAllRowsAL Statement
    sth IO [[(String, SqlValue)]]
    -> ([[(String, SqlValue)]] -> IO [Map String SqlValue])
    -> IO [Map String SqlValue]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ([Map String SqlValue] -> IO [Map String SqlValue]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Map String SqlValue] -> IO [Map String SqlValue])
    -> ([[(String, SqlValue)]] -> [Map String SqlValue])
    -> [[(String, SqlValue)]]
    -> IO [Map String SqlValue]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(String, SqlValue)] -> Map String SqlValue)
    -> [[(String, SqlValue)]] -> [Map String SqlValue]
    forall a b. (a -> b) -> [a] -> [b]
    map [(String, SqlValue)] -> Map String SqlValue
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList)

    {- | Strict version of 'fetchAllRowsMap' -}
    fetchAllRowsMap' :: Statement -> IO [Map.Map String SqlValue]
    fetchAllRowsMap' :: Statement -> IO [Map String SqlValue]
    fetchAllRowsMap' Statement
    sth =
        do res <- Statement -> IO [Map String SqlValue]
    fetchAllRowsMap Statement
    sth
           _ <- evaluate ((genericLength res)::Integer)
           return res

    {- | A quick way to do a query.  Similar to preparing, executing, and
    then calling 'fetchAllRows' on a statement. See also 'quickQuery''. -}
    quickQuery :: IConnection conn => conn -> String -> [SqlValue] -> IO [[SqlValue]]
    quickQuery :: forall conn.
    IConnection conn =>
    conn -> String -> [SqlValue] -> IO [[SqlValue]]
    quickQuery conn
    conn String
    qrystr [SqlValue]
    args =
        do sth <- conn -> String -> IO Statement
    forall conn. IConnection conn => conn -> String -> IO Statement
    prepare conn
    conn String
    qrystr
           _ <- execute sth args
           fetchAllRows sth

    {- | Strict version of 'quickQuery'. -}
    quickQuery' :: IConnection conn => conn -> String -> [SqlValue] -> IO [[SqlValue]]
    quickQuery' :: forall conn.
    IConnection conn =>
    conn -> String -> [SqlValue] -> IO [[SqlValue]]
    quickQuery' conn
    conn String
    qrystr [SqlValue]
    args =
        do res <- conn -> String -> [SqlValue] -> IO [[SqlValue]]
    forall conn.
    IConnection conn =>
    conn -> String -> [SqlValue] -> IO [[SqlValue]]
    quickQuery conn
    conn String
    qrystr [SqlValue]
    args
           _ <- evalAll res
           return res

    {- | A utility function to throw a 'SqlError'.  The mechanics of throwing
    such a thing differ between GHC 6.8.x, Hugs, and GHC 6.10.  This function
    takes care of the special cases to make it simpler.

    With GHC 6.10, it is a type-restricted alias for throw.  On all other systems,
    it is a type-restricted alias for throwDyn. -}
    throwSqlError :: SqlError -> IO a
    #if __GLASGOW_HASKELL__ >= 610
    throwSqlError :: forall a. SqlError -> IO a
    throwSqlError = SqlError -> IO a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw
    #else
    throwSqlError = throwDyn
    #endif