module Database.Bolt.Connection ( BoltActionT , run , queryP, query , queryP', query' , queryP_, query_ ) where import Database.Bolt.Connection.Pipe import Database.Bolt.Connection.Instances import Database.Bolt.Connection.Type import Database.Bolt.Value.Type import Database.Bolt.Record import Control.Monad.IO.Class (MonadIO (..), liftIO) import Control.Monad.Trans.Reader (ReaderT (..), ask, runReaderT) import Data.Text (Text) import Data.Map.Strict (Map, empty) import System.IO.Unsafe (unsafeInterleaveIO) -- |Monad Transformer to do all BOLT actions in type BoltActionT = ReaderT Pipe -- |Runs BOLT action on selected pipe run :: Pipe -> BoltActionT m a -> m a run = flip runReaderT -- |Runs Cypher query with parameters and returns list of obtained 'Record's. Lazy version queryP :: MonadIO m => Text -> Map Text Value -> BoltActionT m [Record] queryP = querySL False -- |Runs Cypher query and returns list of obtained 'Record's. Lazy version query :: MonadIO m => Text -> BoltActionT m [Record] query cypher = queryP cypher empty -- |Runs Cypher query with parameters and returns list of obtained 'Record's. Strict version queryP' :: MonadIO m => Text -> Map Text Value -> BoltActionT m [Record] queryP' = querySL True -- |Runs Cypher query and returns list of obtained 'Record's. Strict version query' :: MonadIO m => Text -> BoltActionT m [Record] query' cypher = queryP' cypher empty -- |Runs Cypher query with parameters and ignores response queryP_ :: MonadIO m => Text -> Map Text Value -> BoltActionT m () queryP_ cypher params = do pipe <- ask liftIO $ sendRequest pipe cypher params $ \_ -> discardAll pipe -- |Runs Cypher query and ignores response query_ :: MonadIO m => Text -> BoltActionT m () query_ cypher = queryP_ cypher empty -- Helper functions querySL :: MonadIO m => Bool -> Text -> Map Text Value -> BoltActionT m [Record] querySL strict cypher params = do pipe <- ask keys <- liftIO $ pullKeys pipe cypher params liftIO $ pullRecords pipe keys strict pullKeys :: Pipe -> Text -> Map Text Value -> IO [Text] pullKeys pipe cypher params = sendRequest pipe cypher params $ \status -> do flush pipe RequestPullAll mkKeys status pullRecords :: Pipe -> [Text] -> Bool -> IO [Record] pullRecords pipe keys strict = do resp <- fetch pipe if isSuccess resp then pure [] else do let record = mkRecord keys resp let pull = pullRecords pipe keys strict rest <- if strict then pull else unsafeInterleaveIO pull pure (record:rest) -- |Sends request to database and makes an action sendRequest :: Pipe -> Text -> Map Text Value -> (Response -> IO a) -> IO a sendRequest pipe cypher params f = do flush pipe $ RequestRun cypher params status <- fetch pipe if isSuccess status then f status else do ackFailure pipe mkFailure status