{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances  #-}

module ODIO where

import Data.Monoid
import Control.Monad.State

import System.Directory
import System.Time
import System.IO.Unsafe

{-
First, the two functions sourceAction and targetAction are defined that capture the 
basic idea of on-demand generation indepenent of the Monad or notion of “timestamp” in
use.

We need some special value, called Infinity, to stand for „update, no matter what“,
e.g. after some abitary action has run. We could use Maybe, but this is more readable:
-}


data WithInfinity a = Finite a | Infinity 

{-
The timestamps should be combinable (e.g. by keeping a list, or just the maximum), and
a single element should be compareable to the whole list. This is captured in a class that
supports adding new elements to the container and checking whether a single element is
larger than all contained elements. 

Example instances are provided for keeping a list of compareable values, or for just
remembering the last value.
-}

class CollMax c a  where
	add :: a -> c -> c
	greaterThanMax :: a -> c -> Bool

instance Ord a => CollMax [a] a  where
	v `add` l =  (v:l)
	v1 `greaterThanMax` l = all (v1 >=) l

instance Ord a => CollMax a a  where
	add = max
	greaterThanMax = (>=)

v `add'` Infinity   = Infinity
v `add'` (Finite c) = Finite (v `add` c)
v `greaterThanMax'` Infinity   = False
v `greaterThanMax'` (Finite c) = v `greaterThanMax` c

{-
We wrap the StateT monad transformer to be able to specialize the (>>) function, which
should use the same state in both arguments. This results in the ODT (on demand transformer)
which can be used to work over any monad.
-}

newtype ODT t m a = ODT { unODT :: StateT (WithInfinity t) m a }

instance Monad m => Monad (ODT t m) where
	return v = ODT $ return v
	a1 >>= a2 = ODT $ unODT a1 >>= unODT . a2	
	a1 >> a2 = ODT $ do
		s <- get
		lift $ evalStateT (unODT a1) s
		lift $ evalStateT (unODT a2) s

{-
With this in place, we can define sourceAction and targetAction.

sourceAction remembers the timestamp for a given action, and then runs the action,
while targetAction compares the timestamp for the target with those in the state,
possibly skipping the action alltogether.
-}

sourceAction :: (Monad m, CollMax c t) => m t -> m a -> ODT c m a
sourceAction getTime getValue = ODT $ do
	t <- lift getTime
	modify (add' t)
	lift getValue

targetAction :: (Monad m, CollMax c t) => m t -> m () -> ODT c m ()
targetAction getTime write = ODT $ do
	sourceTimes <- get
	targetTime <- lift getTime
	unless (targetTime `greaterThanMax'` sourceTimes) $ lift write

{-
Arbitary actions can be lifted to the ODT monad, but of course then the rest of 
the execution is non-deterministic any more, so we set the special “larger than
anything” value.

Note that 
> do lift $ putStrLn "Some output"
>    writeFileOD "somefile"

will still only write somefile as necessary, as this gets desugared to
> (lift $ putStrLn "Some output") >> (writeFileOD "somefile")
and the instance method (>>) throws away the state of the first action.
-}

instance MonadTrans (ODT c) where
	lift m = ODT $ do
		put Infinity
		lift m

{-
For the special case of doing File IO, we want to remember the file to the timestamp, so
we use the following TimeInfo tuple. Note that ClockTime is the left type to preserve 
the ordering.
-}

type TimeInfo = (ClockTime, FilePath)

{-
The ODIO monad will use lists of TimeInfos to remember the updateness of the sources,
and works with the IO monad.
-}

type ODIO = ODT [TimeInfo] IO

instance MonadIO ODIO where liftIO a = lift a

{-
A small helper that adds the filename to the modification time of a file. A non-existing
file is thought to be very old.
-}
getTimeInformation :: FilePath -> IO TimeInfo
getTimeInformation file = do 
	ex <- doesFileExist file
	if ex then do	t <- getModificationTime file
			return $ (t, file)
	      else	return $ (TOD 0 0, file)

{-
readFileOD remembers the timestamp for the source, and will only open the file if
the contents will be needed.
-}
readFileOD :: FilePath -> ODIO String
readFileOD file = sourceAction
			(getTimeInformation file)
			(unsafeInterleaveIO $ readFile file)

{-
writeFileOD will check the timestamp of the file to be generated against those of the
souces and, if neccessary, write the file.
-}
writeFileOD :: FilePath -> String -> ODIO ()
writeFileOD file s = targetAction
			(getTimeInformation file)
			(writeFile file s)

{-
More verbose versions
-}

readFileOD' :: FilePath -> ODIO String
readFileOD' file = sourceAction
			(do putStrLn $ "stat(" ++ file ++ ") "
			    getTimeInformation file)
			(unsafeInterleaveIO $ do
				putStrLn $ "read(" ++ file ++ ")"
				readFile file)
writeFileOD' :: FilePath -> String -> ODIO ()
writeFileOD' file s = targetAction
			(do putStrLn $ "stat(" ++ file ++ ")"
			    getTimeInformation file)
			(do putStrLn $ "write(" ++ file ++ ")"
			    writeFile file s)

{-
To actually do anything in the ODIO monad, use runODIO.
-}
runODIO :: ODIO a -> IO a
runODIO a = evalStateT (unODT a) (Finite [])