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 Data.List qualified as List import Data.Map (Map) import Data.Map qualified as Map import Data.Set (Set) import Data.Set qualified as Set import GHC.Generics (Generic) import GHC.IO.Exception qualified as GHC import System.FilePath (()) import System.IO.Error {------------------------------------------------------------------------------- Paths -------------------------------------------------------------------------------} data Dir = Dir [String] deriving (Show, Eq, Ord, Generic) parent :: Dir -> Dir parent (Dir fp) = Dir (init fp) data File = File {dir :: Dir, name :: String} deriving (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 (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 (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