{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Database.Bolt.Extras.Internal.Instances () where

import           Control.Applicative                 ((<|>))
import           Data.Aeson                          (FromJSON (..),
                                                      ToJSON (..))
import           Data.Aeson.Types                    (Parser)
import           Data.Map.Strict                     (Map)
import           Data.Text                           (Text)
import           Database.Bolt                       (Node, Value (..))
import qualified Database.Bolt                       as DB (Structure)
import           Database.Bolt.Extras.Internal.Types (FromValue (..),
                                                      NodeLike (..),
                                                      ToValue (..))
import           Database.Bolt.Extras.Utils          (currentLoc)
import           GHC.Float                           (double2Float,
                                                      float2Double)


instance ToValue () where
  toValue :: () -> Value
toValue = () -> Value
N

instance ToValue Bool where
  toValue :: Bool -> Value
toValue = Bool -> Value
B

instance ToValue Int where
  toValue :: Int -> Value
toValue = Int -> Value
I

instance ToValue Double where
  toValue :: Double -> Value
toValue = Double -> Value
F

instance ToValue Float where
  toValue :: Float -> Value
toValue = Double -> Value
F (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
float2Double

instance ToValue Text where
  toValue :: Text -> Value
toValue = Text -> Value
T

instance ToValue Value where
  toValue :: Value -> Value
toValue = Value -> Value
forall a. a -> a
id

instance ToValue a => ToValue [a] where
  toValue :: [a] -> Value
toValue = [Value] -> Value
L ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. ToValue a => a -> Value
toValue

instance ToValue a => ToValue (Maybe a) where
  toValue :: Maybe a -> Value
toValue (Just a
a) = a -> Value
forall a. ToValue a => a -> Value
toValue a
a
  toValue Maybe a
_        = () -> Value
forall a. ToValue a => a -> Value
toValue ()

instance ToValue (Map Text Value) where
  toValue :: Map Text Value -> Value
toValue = Map Text Value -> Value
M

instance ToValue DB.Structure where
  toValue :: Structure -> Value
toValue = Structure -> Value
S

instance FromValue () where
  fromValue :: Value -> ()
fromValue (N ()) = ()
  fromValue Value
v      = [Char] -> ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ()) -> [Char] -> ()
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into ()"

instance FromValue Bool where
  fromValue :: Value -> Bool
fromValue (B Bool
boolV) = Bool
boolV
  fromValue Value
v      = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Bool"

instance FromValue Int where
  fromValue :: Value -> Int
fromValue (I Int
intV) = Int
intV
  fromValue Value
v      = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Int"

instance FromValue Double where
  fromValue :: Value -> Double
fromValue (F Double
doubleV) = Double
doubleV
  fromValue Value
v      = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Double"

instance FromValue Float where
  fromValue :: Value -> Float
fromValue (F Double
doubleV) = Double -> Float
double2Float Double
doubleV
  fromValue Value
v      = [Char] -> Float
forall a. HasCallStack => [Char] -> a
error ([Char] -> Float) -> [Char] -> Float
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Float"

instance FromValue Text where
  fromValue :: Value -> Text
fromValue (T Text
textV) = Text
textV
  fromValue Value
v      = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Text"

instance FromValue Value where
  fromValue :: Value -> Value
fromValue = Value -> Value
forall a. a -> a
id

instance FromValue a => FromValue [a] where
  fromValue :: Value -> [a]
fromValue (L [Value]
listV) = (Value -> a) -> [Value] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> a
forall a. FromValue a => Value -> a
fromValue [Value]
listV
  fromValue Value
v      = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a]) -> [Char] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into [Value]"

instance FromValue a => FromValue (Maybe a) where
  fromValue :: Value -> Maybe a
fromValue (N ()) = Maybe a
forall a. Maybe a
Nothing
  fromValue Value
a      = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Value -> a
forall a. FromValue a => Value -> a
fromValue Value
a

instance FromValue (Map Text Value) where
  fromValue :: Value -> Map Text Value
fromValue (M Map Text Value
mapV) = Map Text Value
mapV
  fromValue Value
v      = [Char] -> Map Text Value
forall a. HasCallStack => [Char] -> a
error ([Char] -> Map Text Value) -> [Char] -> Map Text Value
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into (Map Text Value)"

instance FromValue DB.Structure where
  fromValue :: Value -> Structure
fromValue (S Structure
structureV) = Structure
structureV
  fromValue Value
v      = [Char] -> Structure
forall a. HasCallStack => [Char] -> a
error ([Char] -> Structure) -> [Char] -> Structure
forall a b. (a -> b) -> a -> b
$ [Char]
$currentLoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" into Structure"

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON (N ()
_) = () -> Value
forall a. ToJSON a => a -> Value
toJSON ()
  toJSON (B Bool
b) = Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
b
  toJSON (I Int
i) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (F Double
f) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
f
  toJSON (T Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON (L [Value]
l) = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON [Value]
l
  toJSON (M Map Text Value
m) = Map Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON Map Text Value
m
  toJSON Value
_     = [Char] -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Database.Bolt.Extras.Internal.Instances: could not convert to json Database.Bolt.Value"

instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON Value
v = Bool -> Value
B (Bool -> Value) -> Parser Bool -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Bool)
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Value
I (Int -> Value) -> Parser Int -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Int)
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Value
F (Double -> Value) -> Parser Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Double)
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Value
T (Text -> Value) -> Parser Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Text)
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Value] -> Value
L ([Value] -> Value) -> Parser [Value] -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser [Value])
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Value -> Value
M (Map Text Value -> Value)
-> Parser (Map Text Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (Map Text Value)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser (Map Text Value))
            Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Database.Bolt.Extras.Internal.Instances: could not convert from json Database.Bolt.Value"

instance NodeLike Node where
  toNode :: Node -> Node
toNode   = Node -> Node
forall a. a -> a
id
  fromNode :: Node -> Node
fromNode = Node -> Node
forall a. a -> a
id