{-# LANGUAGE UndecidableInstances #-}

-- | Type-safe decoding of query result records.
--
-- Instead of manually pattern-matching on 'Bolt' values, build composable
-- 'Decode' and 'RowDecoder' values that validate types at extraction time.
--
-- @
-- import Database.Bolty.Decode
--
-- data Person = Person { pName :: Text, pAge :: Int64 }
--
-- personDecoder :: 'RowDecoder' Person
-- personDecoder = Person
--   \<$\> 'field' \"name\" 'text'
--   \<*\> 'field' \"age\"  'int64'
-- @
module Database.Bolty.Decode
  ( DecodeError(..)
  , Decode(..)
  , RowDecoder(..)
  , FromBolt(..)
  , ToBolt(..)
    -- * Primitive decoders
  , bool, int, int64, float, text, bytes, nullable, list, dict
    -- * UUID decoder
  , uuid
    -- * Time decoders
  , utcTime, day, timeOfDay
    -- * Aeson decoder
  , aesonValue
    -- * Node property decoders
  , nodeProperty, nodePropertyOptional, nodeLabels, nodeProperties
    -- * PackStream interop
  , psDecode
    -- * Graph type decoders
  , node, relationship, path
    -- * Record-level decoders
  , column, field
    -- * Running decoders
  , decodeRow, decodeRows
    -- * Internal converters (exported for testing)
  , psToBolt, boltToPs
  ) where

import           Data.Kind               (Constraint, Type)
import           Control.Exception       (Exception)
import           TextShow                (TextShow(..), fromText)
import           Data.Int                (Int64)
import qualified Data.Aeson              as Aeson
import qualified Data.Aeson.Key          as Key
import qualified Data.Aeson.KeyMap       as Aeson
import qualified Data.ByteString         as BS
import qualified Data.HashMap.Lazy       as H
import qualified Data.Text               as T
import qualified Data.UUID.Types         as UUID
import qualified Data.Vector             as V
import           Data.Scientific         (fromFloatDigits)
import           Data.Time.Calendar.OrdinalDate (Day)
import           Data.Time.Clock         (UTCTime)
import           Data.Time.Clock.POSIX   (posixSecondsToUTCTime)
import           Data.Time.Format.ISO8601 (iso8601ParseM)
import           Data.Time.LocalTime     (TimeOfDay)
import           GHC.Float               (int2Double)

import           Data.PackStream.Integer (PSInteger, fromPSInteger)
import           Data.PackStream.Ps      (Ps(..), PackStream(..))
import           Data.PackStream.Result  (Result(..))
import           Database.Bolty.Value.Type
import           Database.Bolty.Value.Helpers (sigNode, sigRel, sigURel, sigPath
                                              , sigDate, sigTime, sigLocalTime, sigDateTime
                                              , sigDateTimeZoneId, sigLocalDateTime, sigDuration
                                              , sigPoint2D, sigPoint3D)
import           Database.Bolty.Record   (Record)


-- | Errors that can occur when decoding a 'Bolt' value or record row.
type DecodeError :: Type
data DecodeError
  = TypeMismatch T.Text T.Text
  -- ^ The value had a different type than expected (expected, got).
  | MissingField T.Text
  -- ^ A named field was not present in the column list.
  | IndexOutOfBounds Int Int
  -- ^ Column index was out of range (requested index, actual length).
  | EmptyResultSet
  -- ^ The result set contained no records.
  deriving stock (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show, DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
/= :: DecodeError -> DecodeError -> Bool
Eq)

instance Exception DecodeError

instance TextShow DecodeError where
  showb :: DecodeError -> Builder
showb (TypeMismatch Text
e Text
g) = Builder
"TypeMismatch {expected = \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\", got = \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\"}"
  showb (MissingField Text
f)   = Builder
"MissingField \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
  showb (IndexOutOfBounds Int
i Int
l) = Builder
"IndexOutOfBounds " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. TextShow a => a -> Builder
showb Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. TextShow a => a -> Builder
showb Int
l
  showb DecodeError
EmptyResultSet     = Builder
"EmptyResultSet"


-- | A decoder for a single 'Bolt' value.
type Decode :: Type -> Type
type role Decode representational
newtype Decode a = Decode { forall a. Decode a -> Bolt -> Either DecodeError a
runDecode :: Bolt -> Either DecodeError a }

instance Functor Decode where
  fmap :: forall a b. (a -> b) -> Decode a -> Decode b
fmap a -> b
f (Decode Bolt -> Either DecodeError a
g) = (Bolt -> Either DecodeError b) -> Decode b
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((a -> b) -> Either DecodeError a -> Either DecodeError b
forall a b.
(a -> b) -> Either DecodeError a -> Either DecodeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either DecodeError a -> Either DecodeError b)
-> (Bolt -> Either DecodeError a) -> Bolt -> Either DecodeError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bolt -> Either DecodeError a
g)

instance Applicative Decode where
  pure :: forall a. a -> Decode a
pure a
a = (Bolt -> Either DecodeError a) -> Decode a
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode (\Bolt
_ -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
a)
  Decode Bolt -> Either DecodeError (a -> b)
f <*> :: forall a b. Decode (a -> b) -> Decode a -> Decode b
<*> Decode Bolt -> Either DecodeError a
a = (Bolt -> Either DecodeError b) -> Decode b
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError b) -> Decode b)
-> (Bolt -> Either DecodeError b) -> Decode b
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> Bolt -> Either DecodeError (a -> b)
f Bolt
b Either DecodeError (a -> b)
-> Either DecodeError a -> Either DecodeError b
forall a b.
Either DecodeError (a -> b)
-> Either DecodeError a -> Either DecodeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bolt -> Either DecodeError a
a Bolt
b

instance Monad Decode where
  Decode Bolt -> Either DecodeError a
m >>= :: forall a b. Decode a -> (a -> Decode b) -> Decode b
>>= a -> Decode b
k = (Bolt -> Either DecodeError b) -> Decode b
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError b) -> Decode b)
-> (Bolt -> Either DecodeError b) -> Decode b
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> do
    a <- Bolt -> Either DecodeError a
m Bolt
b
    runDecode (k a) b


-- | Helper to build a decoder from an extractor function.
fromExtractor :: T.Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor :: forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
name Bolt -> Maybe a
extract = (Bolt -> Either DecodeError a) -> Decode a
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError a) -> Decode a)
-> (Bolt -> Either DecodeError a) -> Decode a
forall a b. (a -> b) -> a -> b
$ \Bolt
b ->
  case Bolt -> Maybe a
extract Bolt
b of
    Just a
a  -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
a
    Maybe a
Nothing -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
name (Bolt -> Text
boltTypeName Bolt
b)

boltTypeName :: Bolt -> T.Text
boltTypeName :: Bolt -> Text
boltTypeName Bolt
BoltNull               = Text
"Null"
boltTypeName (BoltBoolean Bool
_)        = Text
"Boolean"
boltTypeName (BoltInteger PSInteger
_)        = Text
"Integer"
boltTypeName (BoltFloat Double
_)          = Text
"Float"
boltTypeName (BoltBytes ByteString
_)          = Text
"Bytes"
boltTypeName (BoltString Text
_)         = Text
"String"
boltTypeName (BoltList Vector Bolt
_)           = Text
"List"
boltTypeName (BoltDictionary HashMap Text Bolt
_)     = Text
"Dictionary"
boltTypeName (BoltNode Node
_)           = Text
"Node"
boltTypeName (BoltRelationship Relationship
_)   = Text
"Relationship"
boltTypeName (BoltUnboundRelationship UnboundRelationship
_) = Text
"UnboundRelationship"
boltTypeName (BoltPath Path
_)           = Text
"Path"
boltTypeName (BoltDate Date
_)           = Text
"Date"
boltTypeName (BoltTime Time
_)           = Text
"Time"
boltTypeName (BoltLocalTime LocalTime
_)      = Text
"LocalTime"
boltTypeName (BoltDateTime DateTime
_)       = Text
"DateTime"
boltTypeName (BoltDateTimeZoneId DateTimeZoneId
_) = Text
"DateTimeZoneId"
boltTypeName (BoltLocalDateTime LocalDateTime
_)  = Text
"LocalDateTime"
boltTypeName (BoltDuration Duration
_)       = Text
"Duration"
boltTypeName (BoltPoint2D Point2D
_)        = Text
"Point2D"
boltTypeName (BoltPoint3D Point3D
_)        = Text
"Point3D"


-- * Primitive decoders

-- | Decode a 'BoltBoolean'.
bool :: Decode Bool
bool :: Decode Bool
bool = Text -> (Bolt -> Maybe Bool) -> Decode Bool
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Boolean" Bolt -> Maybe Bool
asBool

-- | Decode a 'BoltInteger' as a 'PSInteger'.
int :: Decode PSInteger
int :: Decode PSInteger
int = Text -> (Bolt -> Maybe PSInteger) -> Decode PSInteger
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Integer" Bolt -> Maybe PSInteger
asInt

-- | Decode a 'BoltInteger' narrowed to 'Int64'. Fails if the value is out of range.
int64 :: Decode Int64
int64 :: Decode Int64
int64 = (Bolt -> Either DecodeError Int64) -> Decode Int64
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError Int64) -> Decode Int64)
-> (Bolt -> Either DecodeError Int64) -> Decode Int64
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt -> Maybe PSInteger
asInt Bolt
b of
  Just PSInteger
n  -> case PSInteger -> Maybe Int64
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
n of
    Just Int64
i  -> Int64 -> Either DecodeError Int64
forall a b. b -> Either a b
Right Int64
i
    Maybe Int64
Nothing -> DecodeError -> Either DecodeError Int64
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Int64)
-> DecodeError -> Either DecodeError Int64
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Int64" Text
"Integer (out of range)"
  Maybe PSInteger
Nothing -> DecodeError -> Either DecodeError Int64
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Int64)
-> DecodeError -> Either DecodeError Int64
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Integer" (Bolt -> Text
boltTypeName Bolt
b)

-- | Decode a 'BoltFloat'.
float :: Decode Double
float :: Decode Double
float = Text -> (Bolt -> Maybe Double) -> Decode Double
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Float" Bolt -> Maybe Double
asFloat

-- | Decode a 'BoltString'.
text :: Decode T.Text
text :: Decode Text
text = Text -> (Bolt -> Maybe Text) -> Decode Text
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"String" Bolt -> Maybe Text
asText

-- | Decode a 'BoltBytes'.
bytes :: Decode BS.ByteString
bytes :: Decode ByteString
bytes = Text -> (Bolt -> Maybe ByteString) -> Decode ByteString
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Bytes" Bolt -> Maybe ByteString
asBytes

-- | Make a decoder nullable: returns 'Nothing' for 'BoltNull', otherwise applies the inner decoder.
nullable :: Decode a -> Decode (Maybe a)
nullable :: forall a. Decode a -> Decode (Maybe a)
nullable (Decode Bolt -> Either DecodeError a
f) = (Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a)
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a))
-> (Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  Bolt
BoltNull -> Maybe a -> Either DecodeError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
  Bolt
_        -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either DecodeError a -> Either DecodeError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bolt -> Either DecodeError a
f Bolt
b

-- | Decode a 'BoltList', applying the element decoder to each item.
list :: Decode a -> Decode (V.Vector a)
list :: forall a. Decode a -> Decode (Vector a)
list (Decode Bolt -> Either DecodeError a
f) = (Bolt -> Either DecodeError (Vector a)) -> Decode (Vector a)
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError (Vector a)) -> Decode (Vector a))
-> (Bolt -> Either DecodeError (Vector a)) -> Decode (Vector a)
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltList Vector Bolt
v -> (Bolt -> Either DecodeError a)
-> Vector Bolt -> Either DecodeError (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Bolt -> Either DecodeError a
f Vector Bolt
v
  Bolt
_          -> DecodeError -> Either DecodeError (Vector a)
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError (Vector a))
-> DecodeError -> Either DecodeError (Vector a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"List" (Bolt -> Text
boltTypeName Bolt
b)

-- | Decode a 'BoltDictionary'.
dict :: Decode (H.HashMap T.Text Bolt)
dict :: Decode (HashMap Text Bolt)
dict = Text
-> (Bolt -> Maybe (HashMap Text Bolt))
-> Decode (HashMap Text Bolt)
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Dictionary" Bolt -> Maybe (HashMap Text Bolt)
asDict


-- * UUID decoder

-- | Decode a UUID from a 'BoltString'.
uuid :: Decode UUID.UUID
uuid :: Decode UUID
uuid = (Bolt -> Either DecodeError UUID) -> Decode UUID
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError UUID) -> Decode UUID)
-> (Bolt -> Either DecodeError UUID) -> Decode UUID
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltString Text
t -> case Text -> Maybe UUID
UUID.fromText Text
t of
    Just UUID
u  -> UUID -> Either DecodeError UUID
forall a b. b -> Either a b
Right UUID
u
    Maybe UUID
Nothing -> DecodeError -> Either DecodeError UUID
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError UUID)
-> DecodeError -> Either DecodeError UUID
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"UUID" (Text
"String (invalid UUID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  Bolt
_ -> DecodeError -> Either DecodeError UUID
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError UUID)
-> DecodeError -> Either DecodeError UUID
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"UUID (String)" (Bolt -> Text
boltTypeName Bolt
b)


-- * Time decoders

-- | Decode a 'UTCTime' from a 'BoltString' (ISO 8601) or 'BoltDateTime'.
utcTime :: Decode UTCTime
utcTime :: Decode UTCTime
utcTime = (Bolt -> Either DecodeError UTCTime) -> Decode UTCTime
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError UTCTime) -> Decode UTCTime)
-> (Bolt -> Either DecodeError UTCTime) -> Decode UTCTime
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltString Text
t -> case String -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (Text -> String
T.unpack Text
t) of
    Just UTCTime
u  -> UTCTime -> Either DecodeError UTCTime
forall a b. b -> Either a b
Right UTCTime
u
    Maybe UTCTime
Nothing -> DecodeError -> Either DecodeError UTCTime
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError UTCTime)
-> DecodeError -> Either DecodeError UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"UTCTime" (Text
"String (invalid ISO8601: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  BoltDateTime DateTime
dt ->
    UTCTime -> Either DecodeError UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either DecodeError UTCTime)
-> UTCTime -> Either DecodeError UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral DateTime
dt.seconds
  BoltDateTimeZoneId DateTimeZoneId
dt ->
    UTCTime -> Either DecodeError UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either DecodeError UTCTime)
-> UTCTime -> Either DecodeError UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral DateTimeZoneId
dt.seconds
  BoltLocalDateTime LocalDateTime
dt ->
    UTCTime -> Either DecodeError UTCTime
forall a b. b -> Either a b
Right (UTCTime -> Either DecodeError UTCTime)
-> UTCTime -> Either DecodeError UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral LocalDateTime
dt.seconds
  Bolt
_ -> DecodeError -> Either DecodeError UTCTime
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError UTCTime)
-> DecodeError -> Either DecodeError UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"UTCTime (String/DateTime)" (Bolt -> Text
boltTypeName Bolt
b)

-- | Decode a 'Day' from a 'BoltString' (ISO 8601).
day :: Decode Day
day :: Decode Day
day = (Bolt -> Either DecodeError Day) -> Decode Day
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError Day) -> Decode Day)
-> (Bolt -> Either DecodeError Day) -> Decode Day
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltString Text
t -> case String -> Maybe Day
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (Text -> String
T.unpack Text
t) of
    Just Day
d  -> Day -> Either DecodeError Day
forall a b. b -> Either a b
Right Day
d
    Maybe Day
Nothing -> DecodeError -> Either DecodeError Day
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Day)
-> DecodeError -> Either DecodeError Day
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Day" (Text
"String (invalid ISO8601: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  Bolt
_ -> DecodeError -> Either DecodeError Day
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Day)
-> DecodeError -> Either DecodeError Day
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Day (String)" (Bolt -> Text
boltTypeName Bolt
b)

-- | Decode a 'TimeOfDay' from a 'BoltString' (ISO 8601).
timeOfDay :: Decode TimeOfDay
timeOfDay :: Decode TimeOfDay
timeOfDay = (Bolt -> Either DecodeError TimeOfDay) -> Decode TimeOfDay
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError TimeOfDay) -> Decode TimeOfDay)
-> (Bolt -> Either DecodeError TimeOfDay) -> Decode TimeOfDay
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltString Text
t -> case String -> Maybe TimeOfDay
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (Text -> String
T.unpack Text
t) of
    Just TimeOfDay
v  -> TimeOfDay -> Either DecodeError TimeOfDay
forall a b. b -> Either a b
Right TimeOfDay
v
    Maybe TimeOfDay
Nothing -> DecodeError -> Either DecodeError TimeOfDay
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError TimeOfDay)
-> DecodeError -> Either DecodeError TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"TimeOfDay" (Text
"String (invalid ISO8601: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  Bolt
_ -> DecodeError -> Either DecodeError TimeOfDay
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError TimeOfDay)
-> DecodeError -> Either DecodeError TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"TimeOfDay (String)" (Bolt -> Text
boltTypeName Bolt
b)


-- * Aeson decoder

-- | Decode any Bolt value to an 'Aeson.Value'.
aesonValue :: Decode Aeson.Value
aesonValue :: Decode Value
aesonValue = (Bolt -> Either DecodeError Value) -> Decode Value
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode Bolt -> Either DecodeError Value
boltToAeson
  where
    boltToAeson :: Bolt -> Either DecodeError Aeson.Value
    boltToAeson :: Bolt -> Either DecodeError Value
boltToAeson Bolt
BoltNull = Value -> Either DecodeError Value
forall a b. b -> Either a b
Right Value
Aeson.Null
    boltToAeson (BoltBoolean Bool
b) = Value -> Either DecodeError Value
forall a b. b -> Either a b
Right (Value -> Either DecodeError Value)
-> Value -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Aeson.Bool Bool
b
    boltToAeson (BoltInteger PSInteger
n) = case PSInteger -> Maybe Int
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
n :: Maybe Int of
      Just Int
i  -> Value -> Either DecodeError Value
forall a b. b -> Either a b
Right (Value -> Either DecodeError Value)
-> Value -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Aeson.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits (Double -> Scientific) -> Double -> Scientific
forall a b. (a -> b) -> a -> b
$ Int -> Double
int2Double Int
i
      Maybe Int
Nothing -> DecodeError -> Either DecodeError Value
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Value)
-> DecodeError -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Aeson.Value" Text
"Integer (out of range)"
    boltToAeson (BoltFloat Double
d) = Value -> Either DecodeError Value
forall a b. b -> Either a b
Right (Value -> Either DecodeError Value)
-> Value -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
Aeson.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits Double
d
    boltToAeson (BoltString Text
t) = Value -> Either DecodeError Value
forall a b. b -> Either a b
Right (Value -> Either DecodeError Value)
-> Value -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String Text
t
    boltToAeson (BoltList Vector Bolt
v) = Array -> Value
Aeson.Array (Array -> Value)
-> Either DecodeError Array -> Either DecodeError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bolt -> Either DecodeError Value)
-> Vector Bolt -> Either DecodeError Array
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Bolt -> Either DecodeError Value
boltToAeson Vector Bolt
v
    boltToAeson (BoltDictionary HashMap Text Bolt
m) = do
      pairs <- (Bolt -> Either DecodeError Value)
-> HashMap Text Bolt -> Either DecodeError (HashMap Text Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap Text a -> f (HashMap Text b)
traverse Bolt -> Either DecodeError Value
boltToAeson HashMap Text Bolt
m
      Right $ Aeson.Object $ Aeson.fromList $ map (\(Text
k, Value
v) -> (Text -> Key
Key.fromText Text
k, Value
v)) $ H.toList pairs
    boltToAeson Bolt
other = DecodeError -> Either DecodeError Value
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Value)
-> DecodeError -> Either DecodeError Value
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Aeson.Value" (Bolt -> Text
boltTypeName Bolt
other)


-- * Node property decoders

-- | Extract a property from a 'BoltNode' by key and decode it.
nodeProperty :: T.Text -> Decode a -> Decode a
nodeProperty :: forall a. Text -> Decode a -> Decode a
nodeProperty Text
key (Decode Bolt -> Either DecodeError a
f) = (Bolt -> Either DecodeError a) -> Decode a
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError a) -> Decode a)
-> (Bolt -> Either DecodeError a) -> Decode a
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltNode Node
n -> case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Node
n.properties of
    Just Ps
ps -> Bolt -> Either DecodeError a
f (Ps -> Bolt
psToBolt Ps
ps)
    Maybe Ps
Nothing -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Text -> DecodeError
MissingField Text
key
  Bolt
_ -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Node" (Bolt -> Text
boltTypeName Bolt
b)

-- | Extract a property from a 'BoltNode' by key, returning 'Nothing' if the key is missing.
nodePropertyOptional :: T.Text -> Decode a -> Decode (Maybe a)
nodePropertyOptional :: forall a. Text -> Decode a -> Decode (Maybe a)
nodePropertyOptional Text
key (Decode Bolt -> Either DecodeError a
f) = (Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a)
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a))
-> (Bolt -> Either DecodeError (Maybe a)) -> Decode (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltNode Node
n -> case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
key Node
n.properties of
    Just Ps
ps -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either DecodeError a -> Either DecodeError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bolt -> Either DecodeError a
f (Ps -> Bolt
psToBolt Ps
ps)
    Maybe Ps
Nothing -> Maybe a -> Either DecodeError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
  Bolt
_ -> DecodeError -> Either DecodeError (Maybe a)
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError (Maybe a))
-> DecodeError -> Either DecodeError (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Node" (Bolt -> Text
boltTypeName Bolt
b)

-- | Extract labels from a 'BoltNode'.
nodeLabels :: Decode (V.Vector T.Text)
nodeLabels :: Decode (Vector Text)
nodeLabels = (Bolt -> Either DecodeError (Vector Text)) -> Decode (Vector Text)
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError (Vector Text))
 -> Decode (Vector Text))
-> (Bolt -> Either DecodeError (Vector Text))
-> Decode (Vector Text)
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltNode Node
n -> Vector Text -> Either DecodeError (Vector Text)
forall a b. b -> Either a b
Right Node
n.labels
  Bolt
_ -> DecodeError -> Either DecodeError (Vector Text)
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError (Vector Text))
-> DecodeError -> Either DecodeError (Vector Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Node" (Bolt -> Text
boltTypeName Bolt
b)

-- | Extract the raw properties HashMap from a 'BoltNode'.
nodeProperties :: Decode (H.HashMap T.Text Ps)
nodeProperties :: Decode (HashMap Text Ps)
nodeProperties = (Bolt -> Either DecodeError (HashMap Text Ps))
-> Decode (HashMap Text Ps)
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError (HashMap Text Ps))
 -> Decode (HashMap Text Ps))
-> (Bolt -> Either DecodeError (HashMap Text Ps))
-> Decode (HashMap Text Ps)
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Bolt
b of
  BoltNode Node
n -> HashMap Text Ps -> Either DecodeError (HashMap Text Ps)
forall a b. b -> Either a b
Right Node
n.properties
  Bolt
_ -> DecodeError -> Either DecodeError (HashMap Text Ps)
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError (HashMap Text Ps))
-> DecodeError -> Either DecodeError (HashMap Text Ps)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"Node" (Bolt -> Text
boltTypeName Bolt
b)


-- * PackStream interop

-- | Decode via the PackStream 'fromPs' roundtrip through a node property's Ps value.
-- Useful for types that already have PackStream instances.
psDecode :: PackStream a => Decode a
psDecode :: forall a. PackStream a => Decode a
psDecode = (Bolt -> Either DecodeError a) -> Decode a
forall a. (Bolt -> Either DecodeError a) -> Decode a
Decode ((Bolt -> Either DecodeError a) -> Decode a)
-> (Bolt -> Either DecodeError a) -> Decode a
forall a b. (a -> b) -> a -> b
$ \Bolt
b -> case Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs (Bolt -> Ps
boltToPs Bolt
b) of
  Success a
v -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
v
  Error Text
e   -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecodeError
TypeMismatch Text
"PackStream" Text
e


-- * Graph type decoders

-- | Decode a 'BoltNode'.
node :: Decode Node
node :: Decode Node
node = Text -> (Bolt -> Maybe Node) -> Decode Node
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Node" Bolt -> Maybe Node
asNode

-- | Decode a 'BoltRelationship'.
relationship :: Decode Relationship
relationship :: Decode Relationship
relationship = Text -> (Bolt -> Maybe Relationship) -> Decode Relationship
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Relationship" Bolt -> Maybe Relationship
asRelationship

-- | Decode a 'BoltPath'.
path :: Decode Path
path :: Decode Path
path = Text -> (Bolt -> Maybe Path) -> Decode Path
forall a. Text -> (Bolt -> Maybe a) -> Decode a
fromExtractor Text
"Path" Bolt -> Maybe Path
asPath


-- * Record-level decoders

-- | A decoder for a full result row. Compose with 'Applicative' to decode multiple columns.
type RowDecoder :: Type -> Type
type role RowDecoder representational
newtype RowDecoder a = RowDecoder
  { forall a.
RowDecoder a -> Vector Text -> Vector Bolt -> Either DecodeError a
runRowDecoder :: V.Vector T.Text -> Record -> Either DecodeError a }

instance Functor RowDecoder where
  fmap :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
fmap a -> b
f (RowDecoder Vector Text -> Vector Bolt -> Either DecodeError a
g) = (Vector Text -> Vector Bolt -> Either DecodeError b)
-> RowDecoder b
forall a.
(Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
RowDecoder ((Vector Text -> Vector Bolt -> Either DecodeError b)
 -> RowDecoder b)
-> (Vector Text -> Vector Bolt -> Either DecodeError b)
-> RowDecoder b
forall a b. (a -> b) -> a -> b
$ \Vector Text
cols Vector Bolt
rec -> a -> b
f (a -> b) -> Either DecodeError a -> Either DecodeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Text -> Vector Bolt -> Either DecodeError a
g Vector Text
cols Vector Bolt
rec

instance Applicative RowDecoder where
  pure :: forall a. a -> RowDecoder a
pure a
a = (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a.
(Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
RowDecoder ((Vector Text -> Vector Bolt -> Either DecodeError a)
 -> RowDecoder a)
-> (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a b. (a -> b) -> a -> b
$ \Vector Text
_ Vector Bolt
_ -> a -> Either DecodeError a
forall a b. b -> Either a b
Right a
a
  RowDecoder Vector Text -> Vector Bolt -> Either DecodeError (a -> b)
f <*> :: forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
<*> RowDecoder Vector Text -> Vector Bolt -> Either DecodeError a
a = (Vector Text -> Vector Bolt -> Either DecodeError b)
-> RowDecoder b
forall a.
(Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
RowDecoder ((Vector Text -> Vector Bolt -> Either DecodeError b)
 -> RowDecoder b)
-> (Vector Text -> Vector Bolt -> Either DecodeError b)
-> RowDecoder b
forall a b. (a -> b) -> a -> b
$ \Vector Text
cols Vector Bolt
rec ->
    Vector Text -> Vector Bolt -> Either DecodeError (a -> b)
f Vector Text
cols Vector Bolt
rec Either DecodeError (a -> b)
-> Either DecodeError a -> Either DecodeError b
forall a b.
Either DecodeError (a -> b)
-> Either DecodeError a -> Either DecodeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector Text -> Vector Bolt -> Either DecodeError a
a Vector Text
cols Vector Bolt
rec


-- | Types that can be decoded from a result row without an explicit decoder.
--
-- Implement this for your application types to use 'Database.Bolty.query'
-- without passing a 'RowDecoder' explicitly:
--
-- @
-- data Person = Person { name :: Text, age :: Int64 }
--
-- instance FromBolt Person where
--   rowDecoder = Person \<$\> field \"name\" text \<*\> field \"age\" int64
-- @
type FromBolt :: Type -> Constraint
class FromBolt a where
  rowDecoder :: RowDecoder a


-- | Types that can be encoded to a 'Ps' value for use as query parameters.
-- All 'PackStream' instances are automatically 'ToBolt' instances.
type ToBolt :: Type -> Constraint
class ToBolt a where
  toBolt :: a -> Ps

instance PackStream a => ToBolt a where
  toBolt :: a -> Ps
toBolt = a -> Ps
forall a. PackStream a => a -> Ps
toPs


-- | Decode a value at a positional column index.
column :: Int -> Decode a -> RowDecoder a
column :: forall a. Int -> Decode a -> RowDecoder a
column Int
idx (Decode Bolt -> Either DecodeError a
f) = (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a.
(Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
RowDecoder ((Vector Text -> Vector Bolt -> Either DecodeError a)
 -> RowDecoder a)
-> (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a b. (a -> b) -> a -> b
$ \Vector Text
_ Vector Bolt
rec ->
  let len :: Int
len = Vector Bolt -> Int
forall a. Vector a -> Int
V.length Vector Bolt
rec
  in if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
     then DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DecodeError
IndexOutOfBounds Int
idx Int
len
     else Bolt -> Either DecodeError a
f (Vector Bolt
rec Vector Bolt -> Int -> Bolt
forall a. Vector a -> Int -> a
V.! Int
idx)

-- | Decode a value by column name.
field :: T.Text -> Decode a -> RowDecoder a
field :: forall a. Text -> Decode a -> RowDecoder a
field Text
name (Decode Bolt -> Either DecodeError a
f) = (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a.
(Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
RowDecoder ((Vector Text -> Vector Bolt -> Either DecodeError a)
 -> RowDecoder a)
-> (Vector Text -> Vector Bolt -> Either DecodeError a)
-> RowDecoder a
forall a b. (a -> b) -> a -> b
$ \Vector Text
cols Vector Bolt
rec ->
  case Text -> Vector Text -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex Text
name Vector Text
cols of
    Maybe Int
Nothing  -> DecodeError -> Either DecodeError a
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError a)
-> DecodeError -> Either DecodeError a
forall a b. (a -> b) -> a -> b
$ Text -> DecodeError
MissingField Text
name
    Just Int
idx -> Bolt -> Either DecodeError a
f (Vector Bolt
rec Vector Bolt -> Int -> Bolt
forall a. Vector a -> Int -> a
V.! Int
idx)


-- * Running decoders

-- | Decode a single record row.
decodeRow :: RowDecoder a -> V.Vector T.Text -> Record -> Either DecodeError a
decodeRow :: forall a.
RowDecoder a -> Vector Text -> Vector Bolt -> Either DecodeError a
decodeRow (RowDecoder Vector Text -> Vector Bolt -> Either DecodeError a
f) = Vector Text -> Vector Bolt -> Either DecodeError a
f

-- | Decode all records in a result set. Fails on the first 'DecodeError'.
decodeRows :: RowDecoder a -> V.Vector T.Text -> V.Vector Record -> Either DecodeError (V.Vector a)
decodeRows :: forall a.
RowDecoder a
-> Vector Text
-> Vector (Vector Bolt)
-> Either DecodeError (Vector a)
decodeRows RowDecoder a
decoder Vector Text
cols = (Vector Bolt -> Either DecodeError a)
-> Vector (Vector Bolt) -> Either DecodeError (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse (RowDecoder a -> Vector Text -> Vector Bolt -> Either DecodeError a
forall a.
RowDecoder a -> Vector Text -> Vector Bolt -> Either DecodeError a
decodeRow RowDecoder a
decoder Vector Text
cols)


-- * Internal helpers

-- | Convert a Ps value to a Bolt value.
psToBolt :: Ps -> Bolt
psToBolt :: Ps -> Bolt
psToBolt Ps
PsNull           = Bolt
BoltNull
psToBolt (PsBoolean Bool
b)    = Bool -> Bolt
BoltBoolean Bool
b
psToBolt (PsInteger PSInteger
n)    = PSInteger -> Bolt
BoltInteger PSInteger
n
psToBolt (PsFloat Double
d)      = Double -> Bolt
BoltFloat Double
d
psToBolt (PsString Text
t)     = Text -> Bolt
BoltString Text
t
psToBolt (PsBytes ByteString
b)      = ByteString -> Bolt
BoltBytes ByteString
b
psToBolt (PsList Vector Ps
v)       = Vector Bolt -> Bolt
BoltList (Vector Bolt -> Bolt) -> Vector Bolt -> Bolt
forall a b. (a -> b) -> a -> b
$ (Ps -> Bolt) -> Vector Ps -> Vector Bolt
forall a b. (a -> b) -> Vector a -> Vector b
V.map Ps -> Bolt
psToBolt Vector Ps
v
psToBolt (PsDictionary HashMap Text Ps
m) = HashMap Text Bolt -> Bolt
BoltDictionary (HashMap Text Bolt -> Bolt) -> HashMap Text Bolt -> Bolt
forall a b. (a -> b) -> a -> b
$ (Ps -> Bolt) -> HashMap Text Ps -> HashMap Text Bolt
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map Ps -> Bolt
psToBolt HashMap Text Ps
m
psToBolt ps :: Ps
ps@(PsStructure Tag
t Vector Ps
_)
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigNode           = (Node -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Node -> Bolt
BoltNode Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigRel            = (Relationship -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Relationship -> Bolt
BoltRelationship Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigURel           = (UnboundRelationship -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs UnboundRelationship -> Bolt
BoltUnboundRelationship Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigPath           = (Path -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Path -> Bolt
BoltPath Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigDate           = (Date -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Date -> Bolt
BoltDate Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigTime           = (Time -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Time -> Bolt
BoltTime Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigLocalTime      = (LocalTime -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs LocalTime -> Bolt
BoltLocalTime Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigDateTime       = (DateTime -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs DateTime -> Bolt
BoltDateTime Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigDateTimeZoneId = (DateTimeZoneId -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs DateTimeZoneId -> Bolt
BoltDateTimeZoneId Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigLocalDateTime  = (LocalDateTime -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs LocalDateTime -> Bolt
BoltLocalDateTime Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigDuration       = (Duration -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Duration -> Bolt
BoltDuration Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigPoint2D        = (Point2D -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Point2D -> Bolt
BoltPoint2D Ps
ps
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
sigPoint3D        = (Point3D -> Bolt) -> Ps -> Bolt
forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs Point3D -> Bolt
BoltPoint3D Ps
ps
  | Bool
otherwise              = Bolt
BoltNull
  where
    tryFromPs :: PackStream a => (a -> Bolt) -> Ps -> Bolt
    tryFromPs :: forall a. PackStream a => (a -> Bolt) -> Ps -> Bolt
tryFromPs a -> Bolt
wrap Ps
p = case Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs Ps
p of
      Success a
v -> a -> Bolt
wrap a
v
      Result a
_         -> Bolt
BoltNull

-- | Convert a Bolt value to a Ps value.
boltToPs :: Bolt -> Ps
boltToPs :: Bolt -> Ps
boltToPs Bolt
BoltNull           = Ps
PsNull
boltToPs (BoltBoolean Bool
b)    = Bool -> Ps
PsBoolean Bool
b
boltToPs (BoltInteger PSInteger
n)    = PSInteger -> Ps
PsInteger PSInteger
n
boltToPs (BoltFloat Double
d)      = Double -> Ps
PsFloat Double
d
boltToPs (BoltString Text
t)     = Text -> Ps
PsString Text
t
boltToPs (BoltBytes ByteString
b)      = ByteString -> Ps
PsBytes ByteString
b
boltToPs (BoltList Vector Bolt
v)       = Vector Ps -> Ps
PsList (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ (Bolt -> Ps) -> Vector Bolt -> Vector Ps
forall a b. (a -> b) -> Vector a -> Vector b
V.map Bolt -> Ps
boltToPs Vector Bolt
v
boltToPs (BoltDictionary HashMap Text Bolt
m) = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ (Bolt -> Ps) -> HashMap Text Bolt -> HashMap Text Ps
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map Bolt -> Ps
boltToPs HashMap Text Bolt
m
boltToPs (BoltNode Node
n)                = Node -> Ps
forall a. PackStream a => a -> Ps
toPs Node
n
boltToPs (BoltRelationship Relationship
r)        = Relationship -> Ps
forall a. PackStream a => a -> Ps
toPs Relationship
r
boltToPs (BoltUnboundRelationship UnboundRelationship
r) = UnboundRelationship -> Ps
forall a. PackStream a => a -> Ps
toPs UnboundRelationship
r
boltToPs (BoltPath Path
p)                = Path -> Ps
forall a. PackStream a => a -> Ps
toPs Path
p
boltToPs (BoltDate Date
d)                = Date -> Ps
forall a. PackStream a => a -> Ps
toPs Date
d
boltToPs (BoltTime Time
t)                = Time -> Ps
forall a. PackStream a => a -> Ps
toPs Time
t
boltToPs (BoltLocalTime LocalTime
t)           = LocalTime -> Ps
forall a. PackStream a => a -> Ps
toPs LocalTime
t
boltToPs (BoltDateTime DateTime
dt)           = DateTime -> Ps
forall a. PackStream a => a -> Ps
toPs DateTime
dt
boltToPs (BoltDateTimeZoneId DateTimeZoneId
dt)     = DateTimeZoneId -> Ps
forall a. PackStream a => a -> Ps
toPs DateTimeZoneId
dt
boltToPs (BoltLocalDateTime LocalDateTime
dt)      = LocalDateTime -> Ps
forall a. PackStream a => a -> Ps
toPs LocalDateTime
dt
boltToPs (BoltDuration Duration
d)            = Duration -> Ps
forall a. PackStream a => a -> Ps
toPs Duration
d
boltToPs (BoltPoint2D Point2D
p)             = Point2D -> Ps
forall a. PackStream a => a -> Ps
toPs Point2D
p
boltToPs (BoltPoint3D Point3D
p)             = Point3D -> Ps
forall a. PackStream a => a -> Ps
toPs Point3D
p