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