{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Test.FileSystem.Fake
  ( FileSystem
  , FileSystemT (..)
  , FileSystemM
  , runFileSystemT
  , evalFileSystemT
  , execFileSystemT
  , runFileSystemM
  , evalFileSystemM
  , execFileSystemM
  , readPath
  , writePath
  , modifyPath
  ) where

import           Control.Exception          (IOException)
import           Control.Monad.Except       (ExceptT, runExceptT, throwError)
import           Control.Monad.State.Strict (StateT, gets, modify', runStateT)
import           Control.Monad.Trans        (MonadTrans, lift)
import           Data.Functor.Identity      (Identity, runIdentity)
import qualified Data.Map.Strict            as M
import qualified Data.Tuple                 as Tuple
import           System.IO.Error            (doesNotExistErrorType, mkIOError)


type FileSystem contents = M.Map String contents


newtype FileSystemT contents m a =
  FileSystemT
    (ExceptT IOException
      (StateT (FileSystem contents) m) a)
  deriving (Functor, Applicative, Monad) -- TODO: Define MonadThrow, MonadError, etc?

instance MonadTrans (FileSystemT contents) where
  lift = FileSystemT . lift . lift

type FileSystemM contents = FileSystemT contents Identity


runFileSystemT
  :: Functor m
  => FileSystem contents
  -> FileSystemT contents m a
  -> m (FileSystem contents, Either IOException a)
runFileSystemT fs (FileSystemT action) =
  Tuple.swap <$> runStateT (runExceptT action) fs


evalFileSystemT :: Functor f => FileSystem contents -> FileSystemT contents f a -> f (Either IOException a)
evalFileSystemT fs = fmap snd . runFileSystemT fs


execFileSystemT :: Functor f => FileSystem contents -> FileSystemT contents f a -> f (FileSystem contents)
execFileSystemT fs = fmap fst . runFileSystemT fs


runFileSystemM
  :: FileSystem contents
  -> FileSystemM contents a
  -> (FileSystem contents, Either IOException a)
runFileSystemM fs =
  runIdentity . runFileSystemT fs


evalFileSystemM :: FileSystem contents -> FileSystemM contents a -> Either IOException a
evalFileSystemM fs = snd . runFileSystemM fs


execFileSystemM :: FileSystem contents -> FileSystemM contents a -> FileSystem contents
execFileSystemM fs = fst . runFileSystemM fs


readPath :: Monad m => FilePath -> FileSystemT contents m contents
readPath path = do
  mContent <- FileSystemT $ gets $ M.lookup path
  case mContent of
      Just content -> return content
      _ ->
        FileSystemT
          $ throwError
          $ mkIOError doesNotExistErrorType "openFile" Nothing
          $ Just path


writePath :: Monad m => FilePath -> contents -> FileSystemT contents m ()
writePath path =
  FileSystemT . modify' . M.insert path


modifyPath :: Monad m => FilePath -> (Maybe contents -> Maybe contents) -> FileSystemT contents m ()
modifyPath path f =
  FileSystemT . modify' $ M.alter f path