quickcheck-lockstep-0.1.0: test/Test/MockFS/Mock.hs

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