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

-- |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 :: 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"

-- |Gets result from obtained record
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

-- |Possibly gets result from obtained record
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