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

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

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


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

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

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

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

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

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

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

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

instance ToValue a => ToValue (NonEmpty a) where
  toValue :: HasCallStack => NonEmpty a -> Value
toValue = forall a. (ToValue a, HasCallStack) => a -> Value
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
toList

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

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

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

instance ToValue a => DB.IsValue (ToIsValue a) where
  toValue :: HasCallStack => ToIsValue a -> Value
toValue (ToIsValue a
a) = forall a. (ToValue a, HasCallStack) => a -> Value
toValue a
a

instance NodeLike a => DB.IsValue (NodeLikeProps a) where
  toValue :: HasCallStack => NodeLikeProps a -> Value
toValue (NodeLikeProps a
a) = forall a. (ToValue a, HasCallStack) => a -> Value
toValue forall a b. (a -> b) -> a -> b
$ Node -> Map Text Value
nodeProps forall a b. (a -> b) -> a -> b
$ forall a. (NodeLike a, HasCallStack) => a -> Node
toNode a
a

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

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

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

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

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

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

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

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

instance FromValue a => FromValue (NonEmpty a) where
  fromValue :: HasCallStack => Value -> NonEmpty a
fromValue Value
v =
    case forall a. (FromValue a, HasCallStack) => Value -> a
fromValue Value
v of
      []     -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ $[Char]
currentLoc forall a. [a] -> [a] -> [a]
++ [Char]
"could not unpack empty list into NonEmpty Value"
      (a
x:[a]
xs) -> a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs

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

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

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

instance ToJSON Value where
  toJSON :: HasCallStack => Value -> A.Value
  toJSON :: HasCallStack => Value -> Value
toJSON (N ()
_) = forall a. ToJSON a => a -> Value
toJSON ()
  toJSON (B Bool
b) = forall a. ToJSON a => a -> Value
toJSON Bool
b
  toJSON (I Int
i) = forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (F Double
f) = forall a. ToJSON a => a -> Value
toJSON Double
f
  toJSON (T Text
t) = forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON (L [Value]
l) = forall a. ToJSON a => a -> Value
toJSON [Value]
l
  toJSON (M Map Text Value
m) = forall a. ToJSON a => a -> Value
toJSON Map Text Value
m
  toJSON 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 :: HasCallStack => A.Value -> Parser Value
  parseJSON :: HasCallStack => Value -> Parser Value
parseJSON Value
v = Bool -> Value
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Bool)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Value
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Int)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Value
F forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Double)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Value
T forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser Text)
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Value] -> Value
L forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser [Value])
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Value -> Value
M forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser (Map Text Value))
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 :: HasCallStack => Node -> Node
toNode   = forall a. a -> a
id
  fromNode :: HasCallStack => Node -> Node
fromNode = forall a. a -> a
id