{-# 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)

-- |Result type for query requests
type Record = Map Text Value

-- |Get exact type from Value
class RecordValue a where
  exactEither :: Value -> Either UnpackError a

exact :: (MonadError UnpackError m, RecordValue a) => Value -> m a
exact :: Value -> m a
exact = (UnpackError -> m a) -> (a -> m a) -> Either UnpackError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnpackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnpackError a -> m a)
-> (Value -> Either UnpackError a) -> Value -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either UnpackError a
forall a. RecordValue a => Value -> Either UnpackError a
exactEither

exactMaybe :: RecordValue a => Value -> Maybe a
exactMaybe :: Value -> Maybe a
exactMaybe = (UnpackError -> Maybe a)
-> (a -> Maybe a) -> Either UnpackError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> UnpackError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either UnpackError a -> Maybe a)
-> (Value -> Either UnpackError a) -> Value -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either UnpackError a
forall a. RecordValue a => Value -> Either UnpackError a
exactEither

instance RecordValue () where
  exactEither :: Value -> Either UnpackError ()
exactEither (N ()
_) = () -> Either UnpackError ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  exactEither Value
_     = UnpackError -> Either UnpackError ()
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) = Bool -> Either UnpackError Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
  exactEither Value
_     = UnpackError -> Either UnpackError Bool
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) = Int -> Either UnpackError Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  exactEither Value
_     = UnpackError -> Either UnpackError Int
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) = Double -> Either UnpackError Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
d
  exactEither Value
_     = UnpackError -> Either UnpackError Double
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) = Text -> Either UnpackError Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
  exactEither Value
_     = UnpackError -> Either UnpackError Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotString

instance RecordValue Value where
  exactEither :: Value -> Either UnpackError Value
exactEither = Value -> Either UnpackError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance RecordValue a => RecordValue [a] where
  exactEither :: Value -> Either UnpackError [a]
exactEither (L [Value]
l) = (Value -> Either UnpackError a)
-> [Value] -> Either UnpackError [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either UnpackError a
forall a. RecordValue a => Value -> Either UnpackError a
exactEither [Value]
l
  exactEither Value
_     = UnpackError -> Either UnpackError [a]
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 ()
_) = Maybe a -> Either UnpackError (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  exactEither Value
x     = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either UnpackError a -> Either UnpackError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either UnpackError a
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) = Map Text Value -> Either UnpackError (Map Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Value
m
  exactEither Value
_     = UnpackError -> Either UnpackError (Map Text 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) = Structure -> Either UnpackError Node
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
  exactEither Value
_     = UnpackError -> Either UnpackError Node
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> Either UnpackError Node)
-> UnpackError -> Either UnpackError Node
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) = Structure -> Either UnpackError Relationship
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
  exactEither Value
_     = UnpackError -> Either UnpackError Relationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> Either UnpackError Relationship)
-> UnpackError -> Either UnpackError Relationship
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) = Structure -> Either UnpackError URelationship
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
  exactEither Value
_     = UnpackError -> Either UnpackError URelationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> Either UnpackError URelationship)
-> UnpackError -> Either UnpackError URelationship
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) = Structure -> Either UnpackError Path
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
s
  exactEither Value
_     = UnpackError -> Either UnpackError Path
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> Either UnpackError Path)
-> UnpackError -> Either UnpackError Path
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Path"

-- |Gets result from obtained record
at :: (Monad m, RecordValue a) => Record -> Text -> BoltActionT m a
at :: Map Text Value -> Text -> BoltActionT m a
at Map Text Value
record Text
key = case Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text Value
record of
                  Just Value
x  -> ExceptT BoltError m a -> BoltActionT m a
forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE (ExceptT BoltError m a -> BoltActionT m a)
-> ExceptT BoltError m a -> BoltActionT m a
forall a b. (a -> b) -> a -> b
$ (UnpackError -> BoltError)
-> ExceptT UnpackError m a -> ExceptT BoltError m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT UnpackError -> BoltError
WrongMessageFormat (Value -> ExceptT UnpackError m a
forall (m :: * -> *) a.
(MonadError UnpackError m, RecordValue a) =>
Value -> m a
exact Value
x)
                  Maybe Value
Nothing -> BoltError -> BoltActionT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BoltError -> BoltActionT m a) -> BoltError -> BoltActionT m a
forall a b. (a -> b) -> a -> b
$ Text -> BoltError
RecordHasNoKey Text
key