{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, DeriveDataTypeable, ScopedTypeVariables, Trustworthy #-}

module Data.Columbia.WithAddress (WithAddress, addressOf, dataOf, withAddresses, writeBackAddresses) where

import Data.Word
import Data.Function
import Data.Generics.SYB.WithClass.Basics
import Data.Copointed
import Data.Pointed
import Generics.Pointless.Functors hiding (Functor)
import Control.Monad
import Control.Monad.Reader
import Data.Columbia.CompoundData
import Data.Columbia.CycleDetection
import Data.Columbia.FRecord
import Data.Columbia.Integral

-- | 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 Word32 t
	deriving (Eq, Ord, Show, Typeable)

instance Copointed WithAddress where
	{-# INLINE copoint #-}
	copoint(WithAddress _ x) = x

instance Pointed WithAddress where
	{-# INLINE point #-}
	point = WithAddress 0 -- Null address indicates that no address is known.

{-# INLINE addressOf #-}
addressOf :: WithAddress t -> Word32
addressOf(WithAddress n _) = n

{-# INLINE dataOf #-}
dataOf :: WithAddress t -> t
dataOf = copoint

instance (Sat(ctx Word32), Sat(ctx(WithAddress t)), Data ctx t) => Data ctx(WithAddress t) where
	gfoldl _ o k (WithAddress n x) = k WithAddress `o` n `o` x
	gunfold _ f k _ = f(f(k WithAddress))
	dataTypeOf proxy _ =
		let ty = DataType "Data.Columbia.WithAddresses.WithAddress" (AlgRep[
			Constr(AlgConstr 1) "WithAddress" [] Prefix ty]) in
			ty
	toConstr proxy x = case dataTypeOf proxy x of
		DataType _(AlgRep ls) -> head ls
	dataCast1 _ f = gcast1 f

instance (Typeable t) => RW(WithAddress t)

-- Addresses (file offsets) can serve as keys for purposes of cycle detection.
instance KeyComparable(WithAddress t) where
	isKeyed (WithAddress 0 _) = False
	isKeyed _ = True
	keyCompare = compare `on` addressOf

-- | The strategy reads term structure from a file and associates file addresses with it.
--   Bear in mind that the addresses become no good at the moment your reader lock is
--   relinquished, due to GC'ing (unless you do something heroic with your own locking pattern).
withAddresses :: forall ctx m d. (Data ctx d, Monad m) => PolyTraversal ctx m d
withAddresses proxy m = case dataCast1 proxy(do
	addr <- readIntegral
	relSeek(-4)
	liftM(WithAddress addr) m) of
	Just m2 -> m2
	Nothing -> m

newtype Fl m t = Fl { unFl :: t -> ReaderT(SeekableWriter m Word8) m () }

-- | A strategy to intelligently reconstruct shared structure on disk. It intercepts any subterm with
--   type 'WithAddress' and that associates an address to the data, and writes that address
--   in lieu of writing all of the data, thereby achieving structural sharing. The term structure of
--   'WithAddress' constructor itself is never written to the file.
writeBackAddresses ::  forall ctx m d. (Data ctx d, Monad m) => PolyTraversalW ctx m d
writeBackAddresses proxy f d = case dataCast1 proxy(Fl$ \d2 -> if addressOf d2==0 then f$dataOf d2 else writeIntegral$addressOf d2) of
	Just fl -> unFl fl d
	Nothing -> f d