{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Bolt.Record where
import Database.Bolt.Value.Type
import Database.Bolt.Value.Instances ()
import Database.Bolt.Connection.Type
import Control.Monad.Except (MonadError (..), withExceptT)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M (lookup)
import Data.Text (Text)
import GHC.Float (int2Double)
type Record = Map Text Value
class RecordValue a where
exactEither :: Value -> Either UnpackError a
exact :: (MonadError UnpackError m, RecordValue a) => Value -> m a
exact :: forall (m :: * -> *) a.
(MonadError UnpackError m, RecordValue a) =>
Value -> m a
exact = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RecordValue a => Value -> Either UnpackError a
exactEither
exactMaybe :: RecordValue a => Value -> Maybe a
exactMaybe :: forall a. RecordValue a => Value -> Maybe a
exactMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RecordValue a => Value -> Either UnpackError a
exactEither
instance RecordValue () where
exactEither :: Value -> Either UnpackError ()
exactEither (N ()
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotNull
instance RecordValue Bool where
exactEither :: Value -> Either UnpackError Bool
exactEither (B Bool
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotBool
instance RecordValue Int where
exactEither :: Value -> Either UnpackError Int
exactEither (I Int
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotInt
instance RecordValue Double where
exactEither :: Value -> Either UnpackError Double
exactEither (F Double
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
d
exactEither (I Int
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Double
int2Double Int
i
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotFloat
instance RecordValue Text where
exactEither :: Value -> Either UnpackError Text
exactEither (T Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotString
instance RecordValue Value where
exactEither :: Value -> Either UnpackError Value
exactEither = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance RecordValue a => RecordValue [a] where
exactEither :: Value -> Either UnpackError [a]
exactEither (L [Value]
l) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. RecordValue a => Value -> Either UnpackError a
exactEither [Value]
l
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotList
instance RecordValue a => RecordValue (Maybe a) where
exactEither :: Value -> Either UnpackError (Maybe a)
exactEither (N ()
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
exactEither Value
x = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RecordValue a => Value -> Either UnpackError a
exactEither Value
x
instance RecordValue (Map Text Value) where
exactEither :: Value -> Either UnpackError (Map Text Value)
exactEither (M Map Text Value
m) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Value
m
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotDict
instance RecordValue Node where
exactEither :: Value -> Either UnpackError Node
exactEither (S Structure
s) = forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Node"
instance RecordValue Relationship where
exactEither :: Value -> Either UnpackError Relationship
exactEither (S Structure
s) = forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Relationship"
instance RecordValue URelationship where
exactEither :: Value -> Either UnpackError URelationship
exactEither (S Structure
s) = forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"URelationship"
instance RecordValue Path where
exactEither :: Value -> Either UnpackError Path
exactEither (S Structure
s) = forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
exactEither Value
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Path"
at :: (Monad m, RecordValue a) => Record -> Text -> BoltActionT m a
at :: forall (m :: * -> *) a.
(Monad m, RecordValue a) =>
Map Text Value -> Text -> BoltActionT m a
at Map Text Value
record Text
key = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text Value
record of
Just Value
x -> forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT UnpackError -> BoltError
WrongMessageFormat (forall (m :: * -> *) a.
(MonadError UnpackError m, RecordValue a) =>
Value -> m a
exact Value
x)
Maybe Value
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> BoltError
RecordHasNoKey Text
key
maybeAt :: (Monad m, RecordValue a) => Record -> Text -> BoltActionT m (Maybe a)
maybeAt :: forall (m :: * -> *) a.
(Monad m, RecordValue a) =>
Map Text Value -> Text -> BoltActionT m (Maybe a)
maybeAt Map Text Value
record Text
key = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text Value
record of
Just Value
x -> forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT UnpackError -> BoltError
WrongMessageFormat (forall (m :: * -> *) a.
(MonadError UnpackError m, RecordValue a) =>
Value -> m a
exact Value
x)
Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing