RWInstances.hs

{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, FlexibleContexts, Trustworthy #-}

module Data.Columbia.Internal.RWInstances (module Data.Generics.SYB.WithClass.Instances, 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 qualified Data.Array.Unboxed as UA
import Data.Char
import Data.Tree
import Data.Typeable hiding (Proxy)
import Data.Map
import Data.Columbia.Types
import Data.Columbia.Internal.IntegralTypes
import Data.Columbia.Internal.Coercion
import Data.Columbia.Internal.SeekableStream
import Data.Columbia.Internal.SeekableWriter
import Control.Monad
import Control.Monad.Reader

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) => RW(Tree t)
instance (Typeable k, Typeable v) => RW(Map k v)
instance RW(UA.UArray Int32 Word8) where
	readData = do
		len :: Int32 <- readIntegral
		liftM(UA.listArray(0, len-1))$mapM(const consumeToken) [0..len-1]
	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, len-1))$mapM(const$liftM fromIntegral consumeToken) [0..len-1]
	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)