-- | PackStream serialization: encode and decode Haskell values to\/from
-- the Neo4j PackStream binary format.
module Data.PackStream (
  -- * Simple interface to pack and unpack msgpack binary
  -- ** Lazy 'L.ByteString'
  pack, unpack,

  -- ** Strict 'L.ByteString'
  pack', unpack',

  lookupWithError, fromOneField,

  lookupMaybe, lookupMaybeError,

  -- * Re-export modules
  module Data.PackStream.Assoc,
  module Data.PackStream.Get,
  module Data.PackStream.Ps,
  module Data.PackStream.Put,
  module Data.PackStream.Result,
  ) where

import           Compat.Binary           (get, runGet, runGet', runPutLazy, runPut')
import qualified Data.ByteString         as S
import qualified Data.ByteString.Lazy    as L
import qualified Data.Text               as T

import           Data.PackStream.Assoc
import           Data.PackStream.Get
import           Data.PackStream.Ps
import           Data.PackStream.Put
import           Data.PackStream.Result
import Data.Vector as V
import Data.HashMap.Lazy as H

-- | Pack a Haskell value to PackStream binary.
pack :: PackStream a => a -> L.ByteString
pack :: forall a. PackStream a => a -> ByteString
pack = Put -> ByteString
runPutLazy (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a. PackStream a => a -> Put
toBinary

-- | Unpack PackStream binary to a Haskell value. If it fails, it returns 'Left' with an error message.
unpack :: PackStream a => L.ByteString -> Either T.Text a
unpack :: forall a. PackStream a => ByteString -> Either Text a
unpack ByteString
bs = do
  Ps
obj <- ByteString -> Get Ps -> Either Text Ps
forall a. ByteString -> Get a -> Either Text a
runGet ByteString
bs Get Ps
forall t. Persist t => Get t
get
  case Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj of
    Success a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
    Error Text
e   -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
e


-- | Variant of 'pack' serializing to a strict 'ByteString'
pack' :: PackStream a => a -> S.ByteString
pack' :: forall a. PackStream a => a -> ByteString
pack' = Put -> ByteString
runPut' (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a. PackStream a => a -> Put
toBinary

-- | Variant of 'unpack' serializing to a strict 'ByteString'
unpack' :: PackStream a => S.ByteString -> Either T.Text a
unpack' :: forall a. PackStream a => ByteString -> Either Text a
unpack' ByteString
bs = do
  Ps
obj <- ByteString -> Get Ps -> Either Text Ps
forall a. ByteString -> Get a -> Either Text a
runGet' ByteString
bs Get Ps
forall t. Persist t => Get t
get
  case Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj of
    Success a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
    Error Text
e   -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
e

-- | Look up a key in a dictionary, returning a custom error if absent.
lookupWithError :: PackStream v => T.Text -> H.HashMap T.Text Ps -> T.Text -> Result v
lookupWithError :: forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
key HashMap Text Ps
map Text
err =
  case Text -> HashMap Text Ps -> Maybe Ps
forall k v. Hashable k => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
map of
    Maybe Ps
Nothing -> Text -> Result v
forall a. Text -> Result a
Error Text
err
    Just Ps
val -> Ps -> Result v
forall a. PackStream a => Ps -> Result a
fromPs Ps
val

-- | Decode a single-field structure vector, applying the constructor on success.
fromOneField :: PackStream a => V.Vector Ps -> (a -> b) -> T.Text -> Result b
fromOneField :: forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields a -> b
constructor Text
error =
  if Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
fields Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 then
    Text -> Result b
forall a. Text -> Result a
Error Text
error
  else do
    a
arg <- Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs (Ps -> Result a) -> Ps -> Result a
forall a b. (a -> b) -> a -> b
$ Vector Ps -> Ps
forall a. Vector a -> a
V.unsafeHead Vector Ps
fields
    b -> Result b
forall a. a -> Result a
Success (b -> Result b) -> b -> Result b
forall a b. (a -> b) -> a -> b
$ a -> b
constructor a
arg

-- | Look up an optional key in a dictionary, returning 'Nothing' if absent.
lookupMaybe :: PackStream v => T.Text -> HashMap T.Text Ps -> Result (Maybe v)
lookupMaybe :: forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
key HashMap Text Ps
map =
  case Text -> HashMap Text Ps -> Maybe Ps
forall k v. Hashable k => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
map of
    Maybe Ps
Nothing -> Maybe v -> Result (Maybe v)
forall a. a -> Result a
Success Maybe v
forall a. Maybe a
Nothing
    Just Ps
val -> (v -> Maybe v) -> Result v -> Result (Maybe v)
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Maybe v
forall a. a -> Maybe a
Just (Result v -> Result (Maybe v)) -> Result v -> Result (Maybe v)
forall a b. (a -> b) -> a -> b
$ Ps -> Result v
forall a. PackStream a => Ps -> Result a
fromPs Ps
val

-- | Look up a required key in a dictionary, returning 'Left' with an error if absent.
lookupMaybeError :: PackStream v => T.Text -> HashMap T.Text Ps -> Either T.Text v
lookupMaybeError :: forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
lookupMaybeError Text
key HashMap Text Ps
map =
  case Text -> HashMap Text Ps -> Maybe Ps
forall k v. Hashable k => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
map of
    Maybe Ps
Nothing -> Text -> Either Text v
forall a b. a -> Either a b
Left (Text -> Either Text v) -> Text -> Either Text v
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" could not be found"
    Just Ps
val -> case Ps -> Result v
forall a. PackStream a => Ps -> Result a
fromPs Ps
val of
      Error Text
err -> Text -> Either Text v
forall a b. a -> Either a b
Left Text
err
      Success v
v -> v -> Either Text v
forall a b. b -> Either a b
Right v
v