{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.HDBC.Record.Sequence
-- Copyright   : 2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides operations for sequence tables of relational-query with HDBC.
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


-- | Unsafely get a raw sequence number pool of specified size
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]

-- | Unsafely get a raw lazy pool of sequence number
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


-- | Get a sized sequence number pool corresponding proper table 'r'
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

-- | Get a lazy pool corresponding proper table 'r'
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