module ZM.BLOB (
BLOB(..),
blob,
unblob,
TypedBLOB(..),
typedBLOB,
typedBLOB_,
untypedBLOB,
TypedValue(..),
typedValue,
untypedValue,
typeErr,
) where
import Control.DeepSeq
import Data.Bifunctor
import qualified Data.ByteString as B
import Data.ByteString.Convert
import Data.Flat
import Data.Model
import ZM.Abs
import ZM.Model ()
import qualified ZM.Type.BLOB as Z
import ZM.Types
import ZM.Util
data BLOB encoding = BLOB {encoding::encoding,content::B.ByteString}
deriving (Eq, Ord, NFData, Generic, Flat)
instance Model encoding => Model (BLOB encoding)
instance Show encoding => Show (BLOB encoding) where show (BLOB enc bs) = unwords ["BLOB",show enc,show $ B.unpack bs]
unblob :: BLOB t -> B.ByteString
unblob = content
blob :: AsByteString a => encoding -> a -> BLOB encoding
blob enc = BLOB enc . toByteString
data TypedBLOB = TypedBLOB AbsType (BLOB Z.FlatEncoding)
deriving (Eq, Ord, Show, NFData, Generic, Flat, Model)
typedBLOB :: forall a . (Model a,Flat a) => a -> TypedBLOB
typedBLOB = typedBLOB_ (absType (Proxy :: Proxy a))
typedBLOB_ :: Flat a => AbsType -> a -> TypedBLOB
typedBLOB_ t v = TypedBLOB t (blob Z.FlatEncoding . flat $ v)
data TypedValue a = TypedValue AbsType a deriving (Eq, Ord, Show, Functor,NFData, Generic, Flat)
typedValue :: forall a . Model a => a -> TypedValue a
typedValue = TypedValue (absType (Proxy :: Proxy a))
untypedBLOB :: forall a. (Flat a, Model a) => Decoded TypedBLOB -> TypedDecoded a
untypedBLOB ea = case ea of
Left e -> Left . DecodeError $ e
Right (TypedBLOB typ' bs) ->
let typ = absType (Proxy :: Proxy a)
in if typ' /= typ
then typeErr typ typ'
else first DecodeError . unflat $ (unblob bs :: B.ByteString)
untypedValue :: Model a => Decoded (TypedValue a) -> TypedDecoded a
untypedValue ea = case ea of
Left e -> Left . DecodeError $ e
Right (TypedValue typ' a) ->
let typ = absType (proxyOf a)
in if typ' /= typ
then typeErr typ typ'
else Right a
typeErr :: AbsType -> AbsType -> TypedDecoded a
typeErr typ typ' = Left $ WrongType typ typ'