module Database.EJDB2.Query
    ( Query(..)
    , BindM
    , withQuery
    , noBind
    , setBool
    , setBoolAtIndex
    , setI64
    , setI64AtIndex
    , setF64
    , setF64AtIndex
    , setString
    , setStringAtIndex
    , setRegex
    , setRegexAtIndex
    , setNull
    , setNullAtIndex
    ) where

import           Control.Monad.IO.Class
import           Control.Monad.State.Lazy

import qualified Data.Bool                   as Bool
import           Data.Int

import           Database.EJDB2.Bindings.JQL
import           Database.EJDB2.Result

import           Foreign
import           Foreign.C.String
import           Foreign.C.Types

-- | Query data with binding. Collection must be specified in query.
data Query a = Query String -- ^ Query text with collection
                     (BindM a)

data BindState = BindState JQL [CString]

-- | Monad to apply binding to 'Query'
type BindM a = StateT BindState IO a

bind :: BindM a -> BindState -> IO BindState
bind :: BindM a -> BindState -> IO BindState
bind = BindM a -> BindState -> IO BindState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT

getJQL :: BindM JQL
getJQL :: BindM JQL
getJQL = StateT BindState IO BindState
forall s (m :: * -> *). MonadState s m => m s
get StateT BindState IO BindState
-> (BindState -> BindM JQL) -> BindM JQL
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BindState JQL
jql [CString]
_) -> JQL -> BindM JQL
forall (m :: * -> *) a. Monad m => a -> m a
return JQL
jql

-- | Create empty bind
noBind :: BindM ()
noBind :: BindM ()
noBind = () -> BindM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

freeBindState :: BindState -> IO BindState
freeBindState :: BindState -> IO BindState
freeBindState (BindState JQL
jql [CString]
cStrings) = (CString -> IO ()) -> [CString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CString -> IO ()
forall a. Ptr a -> IO ()
free [CString]
cStrings
    IO () -> IO BindState -> IO BindState
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BindState -> IO BindState
forall (m :: * -> *) a. Monad m => a -> m a
return (JQL -> [CString] -> BindState
BindState JQL
jql [])

withQuery :: Query a -> (JQL -> IO b) -> IO b
withQuery :: Query a -> (JQL -> IO b) -> IO b
withQuery (Query String
query BindM a
bindM) JQL -> IO b
f = do
    (Ptr JQL
jqlPtr, JQL
jql) <- String -> IO (Ptr JQL, JQL)
createQuery String
query
    BindState
bindState <- BindM a -> BindState -> IO BindState
forall a. BindM a -> BindState -> IO BindState
bind BindM a
bindM (JQL -> [CString] -> BindState
BindState JQL
jql [])
    b
result <- JQL -> IO b
f JQL
jql
    Ptr JQL -> IO ()
destroyQuery Ptr JQL
jqlPtr
    BindState -> IO BindState
freeBindState BindState
bindState
    b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
result

createQuery :: String -- ^ Query text
            -> IO (Ptr JQL, JQL)
createQuery :: String -> IO (Ptr JQL, JQL)
createQuery String
string = do
    Ptr JQL
jqlPtr <- IO (Ptr JQL)
forall a. Storable a => IO (Ptr a)
malloc
    String -> (CString -> IO (Ptr JQL, JQL)) -> IO (Ptr JQL, JQL)
forall a. String -> (CString -> IO a) -> IO a
withCString String
string ((CString -> IO (Ptr JQL, JQL)) -> IO (Ptr JQL, JQL))
-> (CString -> IO (Ptr JQL, JQL)) -> IO (Ptr JQL, JQL)
forall a b. (a -> b) -> a -> b
$ \CString
cString -> do
        Ptr JQL -> CString -> CString -> IO RC
c_jql_create Ptr JQL
jqlPtr CString
forall a. Ptr a
nullPtr CString
cString IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC
        JQL
jql <- Ptr JQL -> IO JQL
forall a. Storable a => Ptr a -> IO a
peek Ptr JQL
jqlPtr
        (Ptr JQL, JQL) -> IO (Ptr JQL, JQL)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr JQL
jqlPtr, JQL
jql)

destroyQuery :: Ptr JQL -> IO ()
destroyQuery :: Ptr JQL -> IO ()
destroyQuery Ptr JQL
jqlPtr = Ptr JQL -> IO ()
c_jql_destroy Ptr JQL
jqlPtr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr JQL -> IO ()
forall a. Ptr a -> IO ()
free Ptr JQL
jqlPtr

-- | Bind bool to query placeholder
setBool :: Bool
        -> String -- ^ Placeholder
        -> BindM ()
setBool :: Bool -> String -> BindM ()
setBool Bool
bool String
placeholder =
    BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cPlaceholder ->
    JQL -> CString -> CInt -> CBool -> IO RC
c_jql_set_bool JQL
jql CString
cPlaceholder CInt
0 (Word8 -> CBool
CBool (Word8 -> Word8 -> Bool -> Word8
forall a. a -> a -> Bool -> a
Bool.bool Word8
0 Word8
1 Bool
bool)) IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind bool to query at specified index
setBoolAtIndex :: Bool
               -> Int -- ^ Index
               -> BindM ()
setBoolAtIndex :: Bool -> Int -> BindM ()
setBoolAtIndex Bool
bool Int
index = BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> CBool -> IO RC
c_jql_set_bool JQL
jql
                   CString
forall a. Ptr a
nullPtr
                   (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)
                   (Word8 -> CBool
CBool (Word8 -> Word8 -> Bool -> Word8
forall a. a -> a -> Bool -> a
Bool.bool Word8
0 Word8
1 Bool
bool)) IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind number to query placeholder
setI64 :: Int64
       -> String -- ^ Placeholder
       -> BindM ()
setI64 :: Int64 -> String -> BindM ()
setI64 Int64
number String
placeholder =
    BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cPlaceholder ->
    JQL -> CString -> CInt -> CIntMax -> IO RC
c_jql_set_i64 JQL
jql CString
cPlaceholder CInt
0 (Int64 -> CIntMax
CIntMax Int64
number) IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind number to query at specified index
setI64AtIndex :: Int64
              -> Int -- ^ Index
              -> BindM ()
setI64AtIndex :: Int64 -> Int -> BindM ()
setI64AtIndex Int64
number Int
index = BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> CIntMax -> IO RC
c_jql_set_i64 JQL
jql CString
forall a. Ptr a
nullPtr (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) (Int64 -> CIntMax
CIntMax Int64
number)
    IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind 'Double' to query placeholder
setF64 :: Double
       -> String -- ^ Placeholder
       -> BindM ()
setF64 :: Double -> String -> BindM ()
setF64 Double
number String
placeholder =
    BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cPlaceholder ->
    JQL -> CString -> CInt -> CDouble -> IO RC
c_jql_set_f64 JQL
jql CString
cPlaceholder CInt
0 (Double -> CDouble
CDouble Double
number) IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind 'Double' to query at specified index
setF64AtIndex :: Double
              -> Int -- ^ Index
              -> BindM ()
setF64AtIndex :: Double -> Int -> BindM ()
setF64AtIndex Double
number Int
index = BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> CDouble -> IO RC
c_jql_set_f64 JQL
jql CString
forall a. Ptr a
nullPtr (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) (Double -> CDouble
CDouble Double
number)
    IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

newCStringInBindState :: String -> BindM CString
newCStringInBindState :: String -> BindM CString
newCStringInBindState String
string = StateT BindState IO BindState
forall s (m :: * -> *). MonadState s m => m s
get StateT BindState IO BindState
-> (BindState -> BindM CString) -> BindM CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BindState JQL
jql [CString]
strings) ->
    IO CString -> BindM CString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO CString
newCString String
string) BindM CString -> (CString -> BindM CString) -> BindM CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
cString ->
    BindState -> BindM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (JQL -> [CString] -> BindState
BindState JQL
jql (CString
cString CString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
: [CString]
strings)) BindM () -> BindM CString -> BindM CString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> BindM CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
cString

-- | Bind string to query placeholder
setString :: String
          -> String -- ^ Placeholder
          -> BindM ()
setString :: String -> String -> BindM ()
setString String
string String
placeholder = String -> BindM CString
newCStringInBindState String
string
    BindM CString -> (CString -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
cString -> BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \CString
cPlaceholder -> JQL -> CString -> CInt -> CString -> IO RC
c_jql_set_str JQL
jql CString
cPlaceholder CInt
0 CString
cString IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind string to query at specified index
setStringAtIndex :: String
                 -> Int -- ^ Index
                 -> BindM ()
setStringAtIndex :: String -> Int -> BindM ()
setStringAtIndex String
string Int
index =
    String -> BindM CString
newCStringInBindState String
string BindM CString -> (CString -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
cString -> BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> CString -> IO RC
c_jql_set_str JQL
jql CString
forall a. Ptr a
nullPtr (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) CString
cString IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind regex to query placeholder
setRegex :: String -- ^ Regex
         -> String -- ^ Placeholder
         -> BindM ()
setRegex :: String -> String -> BindM ()
setRegex String
string String
placeholder = String -> BindM CString
newCStringInBindState String
string
    BindM CString -> (CString -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
cString -> BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \CString
cPlaceholder -> JQL -> CString -> CInt -> CString -> IO RC
c_jql_set_regexp JQL
jql CString
cPlaceholder CInt
0 CString
cString IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind regex to query at specified index
setRegexAtIndex :: String -- ^ Regex
                -> Int -- ^ Index
                -> BindM ()
setRegexAtIndex :: String -> Int -> BindM ()
setRegexAtIndex String
string Int
index =
    String -> BindM CString
newCStringInBindState String
string BindM CString -> (CString -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
cString -> BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> CString -> IO RC
c_jql_set_regexp JQL
jql CString
forall a. Ptr a
nullPtr (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) CString
cString IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind /null/ value to query placeholder
setNull :: String -- ^ Placeholder
        -> BindM ()
setNull :: String -> BindM ()
setNull String
placeholder = BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
placeholder ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \CString
cPlaceholder -> JQL -> CString -> CInt -> IO RC
c_jql_set_null JQL
jql CString
cPlaceholder CInt
0 IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC

-- | Bind /null/ value to query at specified index
setNullAtIndex :: Int -- ^ Index
               -> BindM ()
setNullAtIndex :: Int -> BindM ()
setNullAtIndex Int
index = BindM JQL
getJQL BindM JQL -> (JQL -> BindM ()) -> BindM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \JQL
jql -> IO () -> BindM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BindM ()) -> IO () -> BindM ()
forall a b. (a -> b) -> a -> b
$
    JQL -> CString -> CInt -> IO RC
c_jql_set_null JQL
jql CString
forall a. Ptr a
nullPtr (Int32 -> CInt
CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index) IO RC -> (RC -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RC -> IO ()
checkRC