module Data.Columbia.CompoundData (module Data.Columbia.SeekableStream, module Data.Columbia.SeekableWriter, module Data.Columbia.RWInstances,
(#.), (##.), fixT, fixTW, typeCoerce,
RW(..), RWCtx(..), PolyTraversal, readOneLayer, PolyTraversalW, writeOneLayer, seekToField) where
import Data.Generics.SYB.WithClass.Basics
import Data.Word
import Data.Int
import Data.Maybe
import Data.Array
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad
import Data.Columbia.SeekableStream
import Data.Columbia.SeekableWriter
import Data.Columbia.Integral
import Data.Columbia.Headers
import Data.Columbia.RWInstances
import Data.Columbia.FRecord
infixl 9 #.
infixl 9 ##.
(#.) :: (Data ctx t)
=> PolyTraversal ctx m t
-> (forall t2. (Data ctx t2) => PolyTraversal ctx m t2)
-> PolyTraversal ctx m t
(traversal #. traversal2) proxy f = traversal proxy(traversal2 proxy f)
(##.) :: (Data ctx t)
=> PolyTraversalW ctx m t
-> (forall t2. (Data ctx t2) => PolyTraversalW ctx m t2)
-> PolyTraversalW ctx m t
(traversal ##. traversal2) proxy f = traversal proxy(traversal2 proxy f)
fixT :: (Data ctx t)
=> Proxy ctx
-> (forall t2. (Data ctx t2) => PolyTraversal ctx m t2)
-> ReaderT(SeekableStream m Word8) m t
fixT proxy traversal = traversal proxy(fixT proxy traversal)
fixTW :: (Data ctx t)
=> Proxy ctx
-> (forall t2. (Data ctx t2) => PolyTraversalW ctx m t2)
-> t
-> ReaderT(SeekableWriter m Word8) m Word32
fixTW proxy traversal = traversal proxy(fixTW proxy traversal)
typeCoerce :: (Typeable t, Data ctx t2)
=> PolyTraversal ctx m t
-> (forall t3. (Data ctx t3) => PolyTraversal ctx m t3)
-> PolyTraversal ctx m t2
typeCoerce traversal traversal2 proxy m =
maybe
(traversal2 proxy m)
id
(gcast(traversal proxy m))
readAddresses :: forall ctx m a. (Monad m, HasField ctx RWCtx, Sat(ctx a))
=> Proxy ctx
-> WriterT[Word32] (ReaderT(SeekableStream m Word8) m) a
readAddresses _ = case hasField(dict :: ctx a) of
RWCtx -> do
x <- lift readIntegral
tell[x]
return$error"readAddresses: unused"
recursor :: forall ctx m a. (Monad m, HasField ctx RWCtx, Data ctx a)
=> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
-> Proxy ctx -> StateT[Word32] (ReaderT(SeekableStream m Word8) m) a
recursor rec proxy = do
~(x:xs) <- get
put xs
lift$do
seek x
rec
type PolyTraversal ctx m d = Proxy ctx
-> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
-> ReaderT(SeekableStream m Word8) m d
readOneLayer :: forall ctx m d. (Monad m, HasField ctx RWCtx, Data ctx d)
=> PolyTraversal ctx m d
readOneLayer proxy0 m = do
let specimen :: d = error"readOneLayer: specimen"
let ty = dataTypeOf proxy0 specimen
hdr@(_, ix, _) <- readHeader
let hdr2 = headerFromConstr proxy0 specimen(indexConstr ty ix)
when(hdr/=hdr2)$fail$"readCompoundData: header check failed "++
"(header from file is "++showsPrec 11 hdr
("; header from program is "++showsPrec 11 hdr2 ")")
if isHeaderAlgtype hdr || isHeaderArraytype hdr then do
specimen2 <- if isHeaderArraytype hdr then do
l <- readIntegral
return$!enhancedFromConstr proxy0 ty hdr l
else
return$!enhancedFromConstr proxy0 ty hdr 0
(_ :: d, ls) <- runWriterT(gmapM
proxy0
(\_ -> readAddresses proxy0)
specimen2)
evalStateT
(gmapM
proxy0
(\_ -> recursor m proxy0)
specimen2)
ls
else
case hasField(dict :: ctx d) of
RWCtx -> readData
recursorW :: forall ctx m a. (Monad m, HasField ctx RWCtx, Data(ctx) a)
=> (a -> ReaderT(SeekableWriter m Word8) m Word32)
-> Proxy ctx -> a -> StateT Word32(ReaderT(SeekableWriter m Word8) m) a
recursorW rec proxy d = do
lift seekWriterAtEnd
x <- lift$rec d
n <- get
put$!n+4
lift$do
seekWriter n
writeIntegral x
return$error"recursorW: unused"
type PolyTraversalW ctx m d = Proxy ctx
-> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m Word32)
-> d -> ReaderT(SeekableWriter m Word8) m Word32
writeOneLayer :: forall ctx m d. (Monad m, HasField ctx RWCtx, Data ctx d) => PolyTraversalW ctx m d
writeOneLayer proxy0 f d = do
let ty = dataTypeOf proxy0 d
m <- getWriterPosition
if isAlgType ty || dataTypeName ty == "Data.Array.Array" then do
writeHeader proxy0 d
n <- getWriterPosition
sequence_(replicate(nConstructorParameters proxy0 d) (writeIntegral(0::Word32)))
evalStateT(gmapM proxy0
(recursorW f proxy0)
d)
n
return m
else case hasField(dict :: ctx d) of
RWCtx -> do
writeHeader proxy0 d
writeData d
return m
seekToField :: forall m. (Monad m) => Int -> ReaderT(SeekableStream m Word8) m ()
seekToField ix = do
hdr <- readHeader
(nf, _) <- nFieldsBytes hdr
when(ix<1||ix>nf)$fail$"seekToField: index out of range (1,"++showsPrec 11 nf")"
relSeek$fromIntegral$4*ix4
seekByPointer