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

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.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

-- | The 'RW' class describes operations that can locate entities in a stream by seeking,
--   and also read and write primitive types.
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 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)