{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.Bolt.Record where
import Database.Bolt.Connection.Type
import Database.Bolt.Connection.Instances
import Database.Bolt.Value.Structure ()
import Database.Bolt.Value.Type
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
type Record = Map Text Value
class RecordValue a where
exact :: Monad m => Value -> m a
instance RecordValue () where
exact (N _) = pure ()
exact x = fail $ show x ++ " is not a Null value"
instance RecordValue Bool where
exact (B b) = pure b
exact x = fail $ show x ++ " is not a Bool value"
instance RecordValue Int where
exact (I i) = pure i
exact x = fail $ show x ++ " is not an Int value"
instance RecordValue Double where
exact (F d) = pure d
exact x = fail $ show x ++ " is not a Double value"
instance RecordValue Text where
exact (T t) = pure t
exact x = fail $ show x ++ " is not a Text value"
instance RecordValue a => RecordValue [a] where
exact (L l) = traverse exact l
exact x = fail $ show x ++ " is not a List value"
instance RecordValue a => RecordValue (Maybe a) where
exact (N _) = pure Nothing
exact x = Just <$> exact x
instance RecordValue (Map Text Value) where
exact (M m) = pure m
exact x = fail $ show x ++ " is not a Map value"
instance RecordValue Node where
exact (S s) = fromStructure s
exact x = fail $ show x ++ " is not a Node value"
instance RecordValue Relationship where
exact (S s) = fromStructure s
exact x = fail $ show x ++ " is not a Relationship value"
instance RecordValue URelationship where
exact (S s) = fromStructure s
exact x = fail $ show x ++ " is not a URelationship value"
instance RecordValue Path where
exact (S s) = fromStructure s
exact x = fail $ show x ++ " is not a Path value"
at :: Monad m => Record -> Text -> m Value
at record key = case key `M.lookup` record of
Just result -> pure result
Nothing -> fail $ "No such key (" ++ show key ++ ") in record"
mkKeys :: Monad m => Response -> m [Text]
mkKeys (ResponseSuccess response) = let mbKeys = exact =<< ("fields" `M.lookup` response)
in pure $ fromMaybe [] mbKeys
mkKeys x = mkFailure x
mkRecord :: [Text] -> Response -> Record
mkRecord keys = M.fromList . zip keys . recsList