-----------------------------------------------------------------------------
-- |
-- Module      :  Make.TestMonad
-- Copyright   :  (c) 2008, Andrea Vezzosi
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module defines the monad Test, which mimics a filesystem and logs events.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Make.TestMonad (
    Test,
    Trace,
    Event(..),
    State(currentTime, filesystem), FileSystem,
    inSandBox,
    finalState,
    events,
    trace,
    runTest,   -- :: Test () -> Trace
    log,       -- :: Event -> Test ()

    File(..), Timestamp,

    exists,    -- :: FilePath -> Test Bool
    readFile,  -- :: FilePath -> Test File
    writeFile, -- :: FilePath -> [ModuleName] -> Test ()
    touch,      -- :: FilePath -> Test ()
    stat,
    jobcontrol
  ) where

import Prelude hiding (readFile, writeFile, log)
import Make.JobControl
import qualified Data.Map as Map
import Control.Monad.State (MonadState, runState, get, put,runStateT,evalState,StateT,lift,modify)
import qualified Control.Monad.State as Monad (State)
import Control.Monad.Writer (MonadWriter, WriterT(runWriterT), tell)
import Control.Applicative
import System.FilePath
import Maybe (isJust)

--import Test

{-

prop_rebuildIfShadowed file fileTree1 fileTree2 =
    not (fileTree1 `containsFile` file) && fileTree2 `containsFile` file ==>
    simulateBuild $ do
      buildWith [ SearchPaths := [fileTree1, fileTree2 ]]
      -- shadow file in fileTree2 by adding a file with the same name into
      -- fileTree1 which takes priority
      let fileTree1' = fileTree1 `addFile` file
      rslt <- buildWith [ SearchPaths := [fileTree1', fileTree2 ]]
      return (basePath fileTree1' </> file `elem` touched rslt
              && not (basePath fileTree2 </> file `elem` touched rslt ))


foo = "Mod/Foo.hs" <-- map (</> "Mod/Foo.hs") searchPaths

mkTarget path = undefined

-}

data State = State {
               currentTime :: Timestamp,
               filesystem  :: FileSystem
             }

emptyState = State 1 Map.empty


type FileSystem = Map.Map FilePath File
type Timestamp = Int

instance Show State where
    show (State _ tr) =
        '\n' : (unlines $ map show $ Map.keys tr)


type Trace t r = [(Event t r, State)]



newtype Test t r a = Test { unTest :: WriterT (Trace t r) (StateT State (Monad.State [[(t,r)]])) a }
    deriving (Functor, Monad, MonadState State, MonadWriter (Trace t r))

runTest :: Test t r a -> (a, Trace t r)
runTest =
  fst . flip evalState [] . flip runStateT emptyState . runWriterT . unTest

trace :: Test t r a -> Trace t r
trace = snd . runTest

events :: Test t r a -> [Event t r]
events = map fst. snd . runTest

finalState :: Test t r a -> State
finalState = snd . last . snd . runTest

inSandBox :: Test t1 r1 a -> Test t r (a, Trace t1 r1)
inSandBox m = Test $ do
                s <- get
                let r = runTest (Test (put s) >> m)
                return r

data File = File {
              timestamp :: Timestamp,
              content   :: [String]
            }
  deriving Show

-- Primitive actions

data Event t r = Stat FilePath
           | ReadFile  FilePath
           | WriteFile FilePath [String]
           | BeginRuleAction {eTargets :: [t],eDeps ::  [t]}
           | EndRuleAction {eProducts :: [(t,r)]}
           | StartMake [t]
           | FinishMake
  deriving (Show,Eq)

log :: Event t r -> Test t r ()
log event = do
  state <- get
  tell [(event, state)]

stat :: FilePath -> Test t r (Maybe Timestamp)
stat path = do
  log (Stat path)
  State _ filesystem <- get
  case Map.lookup (normalise path) filesystem of
    Just file -> return (Just (timestamp file))
    Nothing   -> return Nothing

readFile :: FilePath -> Test t r File
readFile path = do
  log (ReadFile path)
  State _ filesystem <- get
  case Map.lookup (normalise path) filesystem of
    Just file -> return file
    Nothing   -> fail $ "file does not exist: " ++ path

writeFile :: FilePath -> [String] -> Test t r ()
writeFile path content = do
  State curtime filesystem <- get
  let file = File curtime content
  put $ State (curtime + 1) (Map.insert (normalise path) file filesystem)
  log (WriteFile path content)

-- A couple simple derived actions

exists :: FilePath -> Test t r Bool
exists path = isJust <$> stat path

touch :: FilePath -> Test t r ()
touch path = writeFile path []

jobcontrol :: JobControl (Test t r) [(t, r)]
jobcontrol = 
   JobControl {
      launch = \task -> 
        do result <- task
           Test . lift . lift $ modify (result:),
      collect = Test . lift . lift $ do
                  rs <- get
                  case rs of
                    [] -> return Nothing
                    (x:xs) -> put xs >> return (Just x)
}