module Test.MockFS.Mock (
-- * Paths
Dir(..)
, File(..)
, dirFP
, fileFP
-- * Errors
, Err(..)
, fromIOError
-- * Mock file system
, MHandle
, Mock(..)
, emptyMock
, mMkDir
, mOpen
, mWrite
, mClose
, mRead
) where
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import qualified GHC.IO.Exception as GHC
import System.FilePath ((</>))
import System.IO.Error
{-------------------------------------------------------------------------------
Paths
-------------------------------------------------------------------------------}
newtype Dir = Dir [String]
deriving stock (Show, Eq, Ord, Generic)
parent :: Dir -> Dir
parent (Dir fp) = Dir (init fp)
data File = File {dir :: Dir, name :: String}
deriving stock (Show, Eq, Ord, Generic)
dirFP :: FilePath -> Dir -> FilePath
dirFP root (Dir d) = List.foldl' (</>) root d
fileFP :: FilePath -> File -> FilePath
fileFP root (File d f) = dirFP root d </> f
{-------------------------------------------------------------------------------
Errors
-------------------------------------------------------------------------------}
data Err =
AlreadyExists
| DoesNotExist
| HandleClosed
| Busy
deriving stock (Show, Eq)
fromIOError :: IOError -> Maybe Err
fromIOError e =
case ioeGetErrorType e of
GHC.AlreadyExists -> Just AlreadyExists
GHC.NoSuchThing -> Just DoesNotExist
GHC.ResourceBusy -> Just Busy
GHC.IllegalOperation -> Just HandleClosed
_otherwise -> Nothing
{-------------------------------------------------------------------------------
Mock implementation
-------------------------------------------------------------------------------}
type MHandle = Int
data Mock = M {
dirs :: Set Dir
, files :: Map File String
, open :: Map MHandle File
, next :: MHandle
}
deriving stock (Show, Generic)
emptyMock :: Mock
emptyMock = M (Set.singleton (Dir [])) Map.empty Map.empty 0
type MockOp a = Mock -> (Either Err a, Mock)
mMkDir :: Dir -> MockOp ()
mMkDir d m@(M ds fs hs n)
| d `Set.member` ds = (Left AlreadyExists, m)
| parent d `Set.notMember` ds = (Left DoesNotExist, m)
| otherwise = (Right (), M (Set.insert d ds) fs hs n)
mOpen :: File -> MockOp MHandle
mOpen f m@(M ds fs hs n)
| alreadyOpen = (Left Busy, m)
| not dirExists = (Left DoesNotExist, m)
| fileExists = (Right n, M ds fs hs' n')
| otherwise = (Right n, M ds (Map.insert f "" fs) hs' n')
where
hs' = Map.insert n f hs
n' = succ n
fileExists = f `Map.member` fs
dirExists = dir f `Set.member` ds
alreadyOpen = f `List.elem` Map.elems hs
mWrite :: MHandle -> String -> MockOp ()
mWrite h s m@(M ds fs hs n)
| Just f <- Map.lookup h hs = (Right (), M ds (Map.adjust (++ s) f fs) hs n)
| otherwise = (Left HandleClosed, m)
mClose :: MHandle -> MockOp ()
mClose h (M ds fs hs n) = (Right (), M ds fs (Map.delete h hs) n)
mRead :: File -> MockOp String
mRead f m@(M _ fs hs _)
| alreadyOpen = (Left Busy , m)
| Just s <- Map.lookup f fs = (Right s , m)
| otherwise = (Left DoesNotExist , m)
where
alreadyOpen = f `List.elem` Map.elems hs