module Ivory.Serialize.Struct (
labelPackRep,
PackLabel, packLabel, packLabel',
packStruct
) where
import Ivory.Language
import Ivory.Serialize.Atoms
import Ivory.Serialize.PackRep
labelPackRep :: Packable t => Label sym t -> PackRep t
labelPackRep _ = packRep
newtype PackLabel sym = PackLabel (PackRep ('Struct sym))
packLabel :: (IvoryStruct sym, IvoryArea t, Packable t) => Label sym t -> PackLabel sym
packLabel label = packLabel' label $ labelPackRep label
packLabel' :: (IvoryStruct sym, IvoryArea t) => Label sym t -> PackRep t -> PackLabel sym
packLabel' label rep = PackLabel $ PackRep
{ packGetLE = \ buf offs str -> packGetLE rep buf offs (str ~> label)
, packGetBE = \ buf offs str -> packGetBE rep buf offs (str ~> label)
, packSetLE = \ buf offs str -> packSetLE rep buf offs (str ~> label)
, packSetBE = \ buf offs str -> packSetBE rep buf offs (str ~> label)
, packSize = packSize rep
}
packStruct :: [PackLabel sym] -> PackRep ('Struct sym)
packStruct labels = PackRep
{ packGetLE = foldPackLabels packGetLE labels
, packGetBE = foldPackLabels packGetBE labels
, packSetLE = foldPackLabels packSetLE labels
, packSetBE = foldPackLabels packSetBE labels
, packSize = sum $ map (\ (PackLabel rep) -> packSize rep) labels
}
foldPackLabels :: Monad m
=> (PackRep ('Struct str) -> buf -> Uint32 -> strref -> m ())
-> [PackLabel str] -> buf -> Uint32 -> strref
-> m ()
foldPackLabels f labels buf base str = foldl once (return 0) labels >> return ()
where
once m (PackLabel rep) = do
offs <- m
f rep buf (base + fromInteger offs) str
return $! offs + packSize rep