module Data.Columbia.RWInstances (module Data.Generics.SYB.WithClass.Instances, module Data.Columbia.SeekableStream, module Data.Columbia.SeekableWriter, RW(..), RWCtx(..)) where
import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Instances
import Data.Word
import Data.Int
import Data.Array
import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Array.Unboxed as UA
import Data.Char
import Data.Tree
import Data.Typeable hiding (Proxy)
import Data.Columbia.Integral
import Data.Columbia.Coercion
import Data.Columbia.SeekableStream
import Data.Columbia.SeekableWriter
import Control.Monad
import Control.Monad.Reader
class (Typeable t) => RW t where
readData :: (Monad m) => ReaderT(SeekableStream m Word8) m t
readData = fail$"RW.readData: unimplemented for " ++ show(typeOf(undefined :: t))
writeData :: (Monad m) => t -> ReaderT(SeekableWriter m Word8) m ()
writeData = fail$"RW.writeData: unimplemented for " ++ show(typeOf(undefined :: t))
data RWCtx a = (RW a) => RWCtx
instance (RW t) => Sat(RWCtx t) where dict = RWCtx
instance RW Int where
readData = readIntegral
writeData = writeIntegral
instance RW Word where
readData = readIntegral
writeData = writeIntegral
instance RW Int32 where
readData = readIntegral
writeData = writeIntegral
instance RW Word32 where
readData = readIntegral
writeData = writeIntegral
instance RW Int16 where
readData = readIntegral
writeData = writeIntegral
instance RW Word16 where
readData = readIntegral
writeData = writeIntegral
instance RW Int8 where
readData = readIntegral
writeData = writeIntegral
instance RW Word8 where
readData = readIntegral
writeData = writeIntegral
instance RW Float where
readData = liftM int32ToFloat readIntegral
writeData = writeIntegral.floatToInt32
instance RW Char where
readData = liftM chr readIntegral
writeData = writeIntegral.ord
instance RW Bool
instance RW Ordering
instance RW()
instance (Typeable t, Typeable u) => RW(t, u)
instance (Typeable t, Typeable u, Typeable v) => RW(t, u, v)
instance (Typeable t, Typeable u, Typeable v, Typeable w) => RW(t, u, v, w)
instance (Typeable t, Typeable u, Typeable v, Typeable w, Typeable x) => RW(t, u, v, w, x)
instance (Typeable t, Typeable u) => RW(Either t u)
instance (Typeable t) => RW(Maybe t)
instance (Typeable i, Typeable t) => RW(Array i t)
instance (Typeable t) => RW[t]
instance (Typeable t, Typeable u) => RW(Map t u)
instance (Typeable t) => RW(Set t)
instance (Typeable t) => RW(Tree t)
instance RW(UA.UArray Int32 Word8) where
readData = do
len :: Int32 <- readIntegral
liftM(UA.listArray(0, len1))$mapM(const consumeToken) [0..len1]
writeData ua = do
let len = succ$uncurry subtract$UA.bounds ua
writeIntegral len
mapM_ putToken(UA.elems ua)
instance RW(UA.UArray Int32 Int8) where
readData = do
len :: Int32 <- readIntegral
liftM(UA.listArray(0, len1))$mapM(const$liftM fromIntegral consumeToken) [0..len1]
writeData ua = do
let len = succ$uncurry subtract$UA.bounds ua
writeIntegral len
mapM_(putToken.fromIntegral) (UA.elems ua)
instance RW(UA.UArray Int32 Word16) where
readData = do
len :: Int32 <- readIntegral
let endIdx = len`quot`2 1
liftM(UA.listArray(0, endIdx))$mapM(const readIntegral16) [0..endIdx]
writeData ua = do
let nElems = succ(uncurry subtract$UA.bounds ua)
when(nElems>=maxBound`quot`2)$fail"RW.writeData: UArray is too large to index"
let len = 2*nElems
writeIntegral len
mapM_ writeIntegral16(UA.elems ua)
instance RW(UA.UArray Int32 Int16) where
readData = do
len :: Int32 <- readIntegral
let endIdx = len`quot`2 1
liftM(UA.listArray(0, endIdx))$mapM(const readIntegral16) [0..endIdx]
writeData ua = do
let nElems = succ(uncurry subtract$UA.bounds ua)
when(nElems>=maxBound`quot`2)$fail"RW.writeData: UArray is too large to index"
let len = 2*nElems
writeIntegral len
mapM_ writeIntegral16(UA.elems ua)
instance RW(UA.UArray Int32 Word32) where
readData = do
len :: Int32 <- readIntegral
let endIdx = len`quot`4 1
liftM(UA.listArray(0, endIdx))$mapM(const readIntegral) [0..endIdx]
writeData ua = do
let nElems = succ(uncurry subtract$UA.bounds ua)
when(nElems>=maxBound`quot`4)$fail"RW.writeData: UArray is too large to index"
let len = 4*nElems
writeIntegral len
mapM_ writeIntegral(UA.elems ua)
instance RW(UA.UArray Int32 Int32) where
readData = do
len :: Int32 <- readIntegral
let endIdx = len`quot`4 1
liftM(UA.listArray(0, endIdx))$mapM(const readIntegral) [0..endIdx]
writeData ua = do
let nElems = succ(uncurry subtract$UA.bounds ua)
when(nElems>=maxBound`quot`4)$fail"RW.writeData: UArray is too large to index"
let len = 4*nElems
writeIntegral len
mapM_ writeIntegral(UA.elems ua)