{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Bolt.Connection
( BoltActionT
, BoltError (..)
, UnpackError (..)
, at
, run, runE
, 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.Helpers
import Database.Bolt.Value.Type
import Database.Bolt.Record
import Control.Exception (throwIO)
import Control.Monad (void)
import Control.Monad.Except (MonadError (..), runExceptT)
import Control.Monad.Reader (MonadReader (..), runReaderT)
import Control.Monad.Trans (MonadIO (..))
import Data.Map.Strict (Map, empty, fromList)
import Data.Text (Text)
import GHC.Stack (HasCallStack)
import System.IO.Unsafe (unsafeInterleaveIO)
runE :: MonadIO m => HasCallStack => Pipe -> BoltActionT m a -> m (Either BoltError a)
runE :: forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Pipe -> BoltActionT m a -> m (Either BoltError a)
runE Pipe
pipe BoltActionT m a
action = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a.
BoltActionT m a -> ReaderT Pipe (ExceptT BoltError m) a
runBoltActionT BoltActionT m a
action) Pipe
pipe)
run :: MonadIO m => HasCallStack => Pipe -> BoltActionT m a -> m a
run :: forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Pipe -> BoltActionT m a -> m a
run Pipe
pipe BoltActionT m a
action = do Either BoltError a
result <- forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Pipe -> BoltActionT m a -> m (Either BoltError a)
runE Pipe
pipe BoltActionT m a
action
case Either BoltError a
result of
Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Left BoltError
r -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO BoltError
r
queryP :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m [Record]
queryP :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m [Map Text Value]
queryP = forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> Text -> Map Text Value -> BoltActionT m [Map Text Value]
querySL Bool
False
query :: MonadIO m => HasCallStack => Text -> BoltActionT m [Record]
query :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query Text
cypher = forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m [Map Text Value]
queryP Text
cypher forall k a. Map k a
empty
queryP' :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m [Record]
queryP' :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m [Map Text Value]
queryP' = forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> Text -> Map Text Value -> BoltActionT m [Map Text Value]
querySL Bool
True
query' :: MonadIO m => HasCallStack => Text -> BoltActionT m [Record]
query' :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query' Text
cypher = forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m [Map Text Value]
queryP' Text
cypher forall k a. Map k a
empty
queryP_ :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m ()
queryP_ :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m ()
queryP_ Text
cypher Map Text Value
params = do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> Map Text Value -> BoltActionT m Response
sendRequest Text
cypher Map Text Value
params forall k a. Map k a
empty
forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). (MonadPipe m, HasCallStack) => Pipe -> m ()
discardAll
query_ :: MonadIO m => HasCallStack => Text -> BoltActionT m ()
query_ :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m ()
query_ Text
cypher = forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> BoltActionT m ()
queryP_ Text
cypher forall k a. Map k a
empty
querySL :: MonadIO m => HasCallStack => Bool -> Text -> Map Text Value -> BoltActionT m [Record]
querySL :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> Text -> Map Text Value -> BoltActionT m [Map Text Value]
querySL Bool
strict Text
cypher Map Text Value
params = do [Text]
keys <- forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> Map Text Value -> BoltActionT m [Text]
pullKeys Text
cypher Map Text Value
params forall k a. Map k a
empty
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> [Text] -> BoltActionT m [Map Text Value]
pullRecords Bool
strict [Text]
keys
pullKeys :: MonadIO m => HasCallStack => Text -> Map Text Value -> Map Text Value -> BoltActionT m [Text]
pullKeys :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> Map Text Value -> BoltActionT m [Text]
pullKeys Text
cypher Map Text Value
params Map Text Value
ext = do Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
Response
status <- forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> Map Text Value -> BoltActionT m Response
sendRequest Text
cypher Map Text Value
params Map Text Value
ext
forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadPipe m, HasCallStack) =>
Pipe -> Request -> m ()
flush Pipe
pipe Request
RequestPullAll
forall (m :: * -> *). MonadIO m => Response -> BoltActionT m [Text]
mkKeys Response
status
where
mkKeys :: MonadIO m => Response -> BoltActionT m [Text]
mkKeys :: forall (m :: * -> *). MonadIO m => Response -> BoltActionT m [Text]
mkKeys (ResponseSuccess Map Text Value
response) = Map Text Value
response forall (m :: * -> *) a.
(Monad m, RecordValue a) =>
Map Text Value -> Text -> BoltActionT m a
`at` Text
"fields" forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \(RecordHasNoKey Text
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mkKeys Response
x = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ResponseError -> BoltError
ResponseError (Response -> ResponseError
mkFailure Response
x)
pullRecords :: MonadIO m => HasCallStack => Bool -> [Text] -> BoltActionT m [Record]
pullRecords :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> [Text] -> BoltActionT m [Map Text Value]
pullRecords Bool
strict [Text]
keys = do Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
Response
resp <- forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadPipe m, HasCallStack) =>
Pipe -> m Response
fetch Pipe
pipe
forall (m :: * -> *).
MonadIO m =>
Response -> BoltActionT m [Map Text Value]
cases Response
resp
where
cases :: MonadIO m => Response -> BoltActionT m [Record]
cases :: forall (m :: * -> *).
MonadIO m =>
Response -> BoltActionT m [Map Text Value]
cases Response
resp | Response -> Bool
isSuccess Response
resp = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Response -> Bool
isFailure Response
resp = do forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). (MonadIO m, HasCallStack) => Pipe -> m ()
processError
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ResponseError -> BoltError
ResponseError (Response -> ResponseError
mkFailure Response
resp)
| Bool
otherwise = forall (m :: * -> *).
MonadIO m =>
Response -> BoltActionT m [Map Text Value]
parseRecord Response
resp
parseRecord :: MonadIO m => Response -> BoltActionT m [Record]
parseRecord :: forall (m :: * -> *).
MonadIO m =>
Response -> BoltActionT m [Map Text Value]
parseRecord Response
resp = do
Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
let record :: Map Text Value
record = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
keys forall a b. (a -> b) -> a -> b
$ Response -> [Value]
recsList Response
resp
let pull :: IO [Map Text Value]
pull = forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Pipe -> BoltActionT m a -> m a
run Pipe
pipe (forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Bool -> [Text] -> BoltActionT m [Map Text Value]
pullRecords Bool
strict [Text]
keys)
[Map Text Value]
rest <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
strict then IO [Map Text Value]
pull
else forall a. IO a -> IO a
unsafeInterleaveIO IO [Map Text Value]
pull
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Value
recordforall a. a -> [a] -> [a]
:[Map Text Value]
rest)
sendRequest :: MonadIO m => HasCallStack => Text -> Map Text Value -> Map Text Value -> BoltActionT m Response
sendRequest :: forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> Map Text Value -> Map Text Value -> BoltActionT m Response
sendRequest Text
cypher Map Text Value
params Map Text Value
ext =
do Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall a b. (a -> b) -> a -> b
$ do
if Word32 -> Bool
isNewVersion (Pipe -> Word32
pipe_version Pipe
pipe)
then forall (m :: * -> *).
(MonadPipe m, HasCallStack) =>
Pipe -> Request -> m ()
flush Pipe
pipe forall a b. (a -> b) -> a -> b
$ Text -> Map Text Value -> Map Text Value -> Request
RequestRunV3 Text
cypher Map Text Value
params Map Text Value
ext
else forall (m :: * -> *).
(MonadPipe m, HasCallStack) =>
Pipe -> Request -> m ()
flush Pipe
pipe forall a b. (a -> b) -> a -> b
$ Text -> Map Text Value -> Request
RequestRun Text
cypher Map Text Value
params
Response
status <- forall (m :: * -> *).
(MonadPipe m, HasCallStack) =>
Pipe -> m Response
fetch Pipe
pipe
if Response -> Bool
isSuccess Response
status
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
status
else do forall (m :: * -> *). (MonadIO m, HasCallStack) => Pipe -> m ()
processError Pipe
pipe
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ResponseError -> BoltError
ResponseError (Response -> ResponseError
mkFailure Response
status)