RWH Chapter 15 ex1

module WriterIOTests where

import System.IO (IOMode(..))
import WriterIO
import qualified Data.Map as Map
import MonadHandle
import Test.QuickCheck


type ActiveFileMap = Map.Map FilePath IOMode
type Snapshot = (Event,ActiveFileMap)

-- | Zip each event with a map of active files(to their mode) after that event's execution
buildSnapshots :: [Event] -> [Snapshot]
buildSnapshots events =
  let
    foldF :: [Snapshot] -> Event -> [Snapshot]
    foldF snapshots@((prevEvent,prevActiveFiles):_) curEvent =
      let newActiveFiles = processEvent curEvent prevActiveFiles
      in  (curEvent,newActiveFiles) : snapshots
    foldF [] curEvent = [(curEvent,processEvent curEvent Map.empty)]
    -- For a given event and the active files map, update the active files map if
    -- the event opens a new file or closes a previous one.
    processEvent :: Event -> ActiveFileMap -> ActiveFileMap
    processEvent (Open fp mode) curMap =  Map.insert fp mode curMap
    processEvent (Close fp) curMap = Map.delete fp curMap
    processEvent _ curMap = curMap
  in
    reverse $ foldl foldF [] events -- we must reverse the snapshots, because they were built in a reverse order.

-- | given a list of snapshots, validate them according to the rules:
--     when putting to a file, that file must be open and writable
--     when reading a file, that file must be open and readable
validateSnapshots :: [Snapshot] -> Bool
validateSnapshots = all isValid where
  isWriteable mode = mode == WriteMode || mode == ReadWriteMode || mode == AppendMode
  isReadable mode = mode == ReadMode || mode == ReadWriteMode
  isValid :: Snapshot -> Bool
  isValid (Put fp _,activeFiles) = maybe False isWriteable (Map.lookup fp activeFiles)
  isValid (GetContents fp, activeFiles) = maybe False isReadable (Map.lookup fp activeFiles)
  isValid _ = True

-- | given a WriterIO, validate it.
validateIO :: WriterIO a -> Bool
validateIO = validateSnapshots . buildSnapshots . snd . runWriterIO


validIOSession1 :: MonadHandle h m => FilePath -> m ()
validIOSession1 path =
  do
    file <- openFile path WriteMode
    hPutStr file "should be ok"
    hPutStr file "still be ok"
    hClose file

validIOSession2 :: MonadHandle h m => FilePath -> m ()
validIOSession2 path =
  do
    file <- openFile path WriteMode
    hPutStr file "inserting as expected"
    hClose file
    sameFile <- openFile path WriteMode
    hPutStr sameFile "should still work"
    hClose file
    sameFileInReadMode <- openFile path ReadMode
    _ <- hGetContents sameFileInReadMode
    hClose sameFileInReadMode

invalidIOSession1 :: MonadHandle h m => FilePath -> m ()
invalidIOSession1 path =
  do
    file <- openFile path ReadMode
    hPutStr file "inserting to a file without write permissions! better call the police"
    hClose file

invalidIOSession2 :: MonadHandle h m => FilePath -> m ()
invalidIOSession2 path =
  do
    file <- openFile path WriteMode
    hPutStr file "should be ok"
    hClose file
    hPutStr file "writing to a closed file! thats a paddlin'"


doTests :: IO ()
doTests = do
  quickCheck (validateIO . validIOSession1)
  quickCheck (validateIO . validIOSession2)
  quickCheck (not . validateIO . invalidIOSession1)
  quickCheck (not . validateIO . invalidIOSession2)