{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.Record.Sequence (
pool, autoPool,
unsafePool, unsafeAutoPool,
) where
import Control.Applicative ((<$>))
import Control.Monad (when, void)
import System.IO.Unsafe (unsafeInterleaveIO)
import Database.HDBC (IConnection, SqlValue, commit)
import Database.HDBC.Session (withConnectionIO)
import Language.SQL.Keyword (Keyword (FOR, UPDATE))
import Database.Record (FromSql, ToSql, PersistableWidth)
import Database.Relational
(relationalQuery', LiteralSQL, Relation, )
import qualified Database.Relational as Relation
import qualified Database.Relational.Table as Table
import Database.HDBC.Record.Persistable ()
import Database.HDBC.Record.Statement (bind, executeBound)
import Database.HDBC.Record.Query (prepareQuery, fetch)
import Database.HDBC.Record.Update (runUpdate)
import Database.Relational (Sequence (..), Binding, Number, )
import qualified Database.Relational as Relational
unsafePool :: (FromSql SqlValue s, PersistableWidth s,
ToSql SqlValue i, LiteralSQL i,
Bounded i, Integral i, Show i, IConnection conn)
=> IO conn
-> i
-> Sequence s i
-> IO [i]
unsafePool :: forall s i conn.
(FromSql SqlValue s, PersistableWidth s, ToSql SqlValue i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn) =>
IO conn -> i -> Sequence s i -> IO [i]
unsafePool IO conn
connAct i
sz Sequence s i
seqt = forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO IO conn
connAct forall a b. (a -> b) -> a -> b
$ \conn
conn -> do
let t :: Table s
t = forall s i. Sequence s i -> Table s
seqTable Sequence s i
seqt
name :: String
name = forall r. Table r -> String
Table.name Table s
t
PreparedQuery () s
pq <- forall conn p a.
IConnection conn =>
conn -> Query p a -> IO (PreparedQuery p a)
prepareQuery conn
conn forall a b. (a -> b) -> a -> b
$ forall p r. Relation p r -> QuerySuffix -> Query p r
relationalQuery' (forall r. Table r -> Relation () r
Relation.table Table s
t) [Keyword
FOR, Keyword
UPDATE]
ExecutedStatement s
es <- forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound forall a b. (a -> b) -> a -> b
$ PreparedQuery () s
pq forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
`bind` ()
i
seq0 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"No record found in sequence table: " forall a. [a] -> [a] -> [a]
++ String
name)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i. Sequence s i -> s -> i
seqExtract Sequence s i
seqt)
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 s
es
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- i
seq0 forall a. Ord a => a -> a -> Bool
< i
sz) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail
forall a b. (a -> b) -> a -> b
$ String
"Not enough size in sequence table: "
forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- i
seq0) forall a. [a] -> [a] -> [a]
++ String
" < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show i
sz
let seq1 :: i
seq1 = i
seq0 forall a. Num a => a -> a -> a
+ i
sz
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall conn p.
(IConnection conn, ToSql SqlValue p) =>
conn -> Update p -> p -> IO Integer
runUpdate conn
conn (forall s i.
(PersistableWidth s, Integral i, LiteralSQL i) =>
i -> Sequence s i -> Update ()
Relational.updateNumber i
seq1 Sequence s i
seqt) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"More than two record found in seq table: " forall a. [a] -> [a] -> [a]
++ String
name) 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 s
es
forall conn. IConnection conn => conn -> IO ()
commit conn
conn
forall (m :: * -> *) a. Monad m => a -> m a
return [i
seq0 forall a. Num a => a -> a -> a
+ i
1 .. i
seq1]
unsafeAutoPool :: (FromSql SqlValue s, PersistableWidth s,
ToSql SqlValue i, LiteralSQL i,
Bounded i, Integral i, Show i, IConnection conn)
=> IO conn
-> i
-> Sequence s i
-> IO [i]
unsafeAutoPool :: forall s i conn.
(FromSql SqlValue s, PersistableWidth s, ToSql SqlValue i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn) =>
IO conn -> i -> Sequence s i -> IO [i]
unsafeAutoPool IO conn
connAct i
sz Sequence s i
seqt = IO [i]
loop where
loop :: IO [i]
loop = forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ do
[i]
hd <- forall s i conn.
(FromSql SqlValue s, PersistableWidth s, ToSql SqlValue i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn) =>
IO conn -> i -> Sequence s i -> IO [i]
unsafePool IO conn
connAct i
sz Sequence s i
seqt
([i]
hd forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [i]
loop
pool :: (FromSql SqlValue s, ToSql SqlValue i,
PersistableWidth i, LiteralSQL i,
Bounded i, Integral i, Show i, IConnection conn,
Binding r s i)
=> IO conn
-> i
-> Relation () r
-> IO [Number r i]
pool :: forall s i conn r.
(FromSql SqlValue s, ToSql SqlValue i, PersistableWidth i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn,
Binding r s i) =>
IO conn -> i -> Relation () r -> IO [Number r i]
pool IO conn
connAct i
sz =
(forall a b. (a -> b) -> [a] -> [b]
map forall r s i. Binding r s i => i -> Number r i
Relational.unsafeSpecifyNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i conn.
(FromSql SqlValue s, PersistableWidth s, ToSql SqlValue i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn) =>
IO conn -> i -> Sequence s i -> IO [i]
unsafePool IO conn
connAct i
sz
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r s i. Binding r s i => Relation () r -> Sequence s i
Relational.fromRelation
autoPool :: (FromSql SqlValue s,
ToSql SqlValue i, LiteralSQL i,
Bounded i, Integral i, Show i, IConnection conn,
Binding r s i)
=> IO conn
-> i
-> Relation () r
-> IO [Number r i]
autoPool :: forall s i conn r.
(FromSql SqlValue s, ToSql SqlValue i, LiteralSQL i, Bounded i,
Integral i, Show i, IConnection conn, Binding r s i) =>
IO conn -> i -> Relation () r -> IO [Number r i]
autoPool IO conn
connAct i
sz =
(forall a b. (a -> b) -> [a] -> [b]
map forall r s i. Binding r s i => i -> Number r i
Relational.unsafeSpecifyNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i conn.
(FromSql SqlValue s, PersistableWidth s, ToSql SqlValue i,
LiteralSQL i, Bounded i, Integral i, Show i, IConnection conn) =>
IO conn -> i -> Sequence s i -> IO [i]
unsafeAutoPool IO conn
connAct i
sz
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r s i. Binding r s i => Relation () r -> Sequence s i
Relational.fromRelation