{-# LANGUAGE Trustworthy, Rank2Types, ExistentialQuantification, ScopedTypeVariables, DeriveFunctor #-}

module Data.Columbia.Types where

import Data.Typeable hiding (Proxy)
import Data.Word
import Control.Monad.Reader hiding (Functor)
import Data.Generics.SYB.WithClass.Basics
import Generics.Pointless.Functors hiding (Functor)

type Pointer = Word32

data SeekableStream m c = SeekableStream
	{ __consumeToken :: !(m(Maybe c)), __consumeIntegralToken :: !(m(Maybe Word32)), __seek :: !(Pointer -> m()), __getPosition :: !(m Pointer), __seekAtEnd :: !(m()), __isLockLive :: !(m Bool) } deriving Functor

data SeekableWriter m c = SeekableWriter
	{ _putToken :: !(c -> m()), _putIntegralToken :: !(Word32 -> m()), stream :: !(SeekableStream m c) }

--------------------------------------

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

-- | A 'PolyTraversal' is a reader method over a data type, parameterized over a method to read components.
--   It can be seen as a curried form of the 'gmapM' operator from Data.Data, in like manner as the
--   'Traversal' is a curried form of 'traverse'.
type PolyTraversal ctx m d = Proxy ctx
	-> (forall a. (Data ctx a) => ReaderT(SeekableStream m Word8) m a)
	-> ReaderT(SeekableStream m Word8) m d

-- | This is a variant of 'PolyTraversal' purposed for writing. By convention, strategies with this type
--   require the stream to be seeked at an *address*, which the strategy will then dereference to access the
--   corresponding data.
type PolyTraversalW ctx m d = Proxy ctx
	-> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m ())
	-> d -> ReaderT(SeekableWriter m Word8) m ()

-----------------------------------

-- | The standard 'Fix' constructor is too strict for some things this library has to do, hence the alias.
data LazyFix f = LazyFix(Rep f(LazyFix f))

-- | This type alias exposes an alternate view of the data constructors of a dictionary type.
--   Why break abstraction????because I need the structure sharing.
data LazyMap k v = BinPrime { lazy_map_size :: Int,
	lazy_map_key :: k,
	lazy_map_value :: v,
	lazy_map_bin1 :: WithAddress(LazyMap k v),
	lazy_map_bin2 :: WithAddress(LazyMap k v) } | TipPrime
	deriving (Eq, Ord, Show, Typeable)

------------------------------------

-- | 'isKeyed' may always return false, but if it returns true ever, 'keyCompare'
--   must be well-defined and a valid equivalence relation on values for which
--   'isKeyed' returns true (i.e. where all values concerned have /isKeyed x=true/).
--The default is to have 'isKeyed' return false on all values.
class KeyComparable t where
	isKeyed :: t->Bool
	isKeyed _ = False
	keyCompare :: t -> t->Ordering
	keyCompare _ _ = error"KeyComparable.keyCompare: is not a keyed data type"

data KeyCtx t = (KeyComparable t) => KeyCtx

------------------------------------

-- | Data type for a piece of data that may or may not have an explicit address associated with it.
--   This is nice because I can play with these in pure code to manipulate data, while still
--   remembering all of the explicit term structure.
data WithAddress t = WithAddress Pointer t
	deriving (Eq, Ord, Show, Typeable)

------------------------------------

data Header = Header !Word8 !ConIndex !Int

isUArray :: Header -> Bool
isUArray (Header n _ _) = n == 3

isArray :: Header -> Bool
isArray (Header n _ _) = n == 2

isPrimtype :: Header -> Bool
isPrimtype (Header n _ _) = n == 1

isAlgtype :: Header -> Bool
isAlgtype (Header n _ _) = n == 0

getConIndex :: Header -> ConIndex
getConIndex (Header _ i _) = i

getNFields :: Header -> Int
getNFields (Header _ _ n) = n