PackStream.hs

-- | 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 = runPutLazy . 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 bs = do
  obj <- runGet bs get
  case fromPs obj of
    Success a -> Right a
    Error e   -> Left e


-- | Variant of 'pack' serializing to a strict 'ByteString'
pack' :: PackStream a => a -> S.ByteString
pack' = runPut' . toBinary

-- | Variant of 'unpack' serializing to a strict 'ByteString'
unpack' :: PackStream a => S.ByteString -> Either T.Text a
unpack' bs = do
  obj <- runGet' bs get
  case fromPs obj of
    Success a -> Right a
    Error e   -> Left 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 key map err =
  case H.lookup key map of
    Nothing -> Error err
    Just val -> fromPs 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 fields constructor error =
  if V.length fields /= 1 then
    Error error
  else do
    arg <- fromPs $ V.unsafeHead fields
    Success $ constructor 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 key map =
  case H.lookup key map of
    Nothing -> Success Nothing
    Just val -> fmap Just $ fromPs 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 key map =
  case H.lookup key map of
    Nothing -> Left $ "\"" <> key <> "\" could not be found"
    Just val -> case fromPs val of
      Error err -> Left err
      Success v -> Right v