{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module Data.MockIO.FileSystem (
FileSystem(..)
, File(..)
, emptyFileSystem
, fileExists
, hasFile
, deleteFile
, getLines
, writeLines
, appendLines
, readLine
) where
import Data.Maybe
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Test.QuickCheck
( Arbitrary(..), Positive(..), Gen, vectorOf, listOf )
data File a = File
{ File a -> a
_fileHandle :: a
, File a -> [Text]
_fileContents :: [Text]
} deriving File a -> File a -> Bool
(File a -> File a -> Bool)
-> (File a -> File a -> Bool) -> Eq (File a)
forall a. Eq a => File a -> File a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File a -> File a -> Bool
$c/= :: forall a. Eq a => File a -> File a -> Bool
== :: File a -> File a -> Bool
$c== :: forall a. Eq a => File a -> File a -> Bool
Eq
instance (Show a) => Show (File a) where
show :: File a -> String
show (File a
h [Text]
lns) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[ Text
">>>>> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
lns [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"<<<<<"]
data FileSystem a = FileSystem [File a]
instance (Eq a) => Eq (FileSystem a) where
(FileSystem [File a]
as) == :: FileSystem a -> FileSystem a -> Bool
== (FileSystem [File a]
bs) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ (File a -> Bool) -> [File a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (File a -> [File a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [File a]
bs) [File a]
as
, (File a -> Bool) -> [File a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (File a -> [File a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [File a]
as) [File a]
bs
]
instance (Show a) => Show (FileSystem a) where
show :: FileSystem a -> String
show (FileSystem [File a]
fs) = (File a -> String) -> [File a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap File a -> String
forall a. Show a => a -> String
show [File a]
fs
instance (Eq a, Arbitrary a) => Arbitrary (FileSystem a) where
arbitrary :: Gen (FileSystem a)
arbitrary = do
Positive Int
n <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Positive Int)
[a]
handles <- ([a] -> [a]) -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. Eq a => [a] -> [a]
nub (Gen [a] -> Gen [a]) -> Gen [a] -> Gen [a]
forall a b. (a -> b) -> a -> b
$ Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
20) Gen a
forall a. Arbitrary a => Gen a
arbitrary
let contents :: Gen [Text]
contents = Gen Text -> Gen [Text]
forall a. Gen a -> Gen [a]
listOf ((String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Gen String
forall a. Arbitrary a => Gen a
arbitrary)
[File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem ([File a] -> FileSystem a) -> Gen [File a] -> Gen (FileSystem a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Gen (File a)) -> [a] -> Gen [File a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\a
k -> a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
k ([Text] -> File a) -> Gen [Text] -> Gen (File a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Text]
contents ) [a]
handles
emptyFileSystem :: FileSystem a
emptyFileSystem :: FileSystem a
emptyFileSystem = [File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem []
getFile :: (Eq a) => a -> FileSystem a -> Maybe (File a)
getFile :: a -> FileSystem a -> Maybe (File a)
getFile a
h (FileSystem [File a]
fs) = [File a] -> Maybe (File a)
lookup [File a]
fs
where
lookup :: [File a] -> Maybe (File a)
lookup [File a]
zs = case [File a]
zs of
[] -> Maybe (File a)
forall a. Maybe a
Nothing
File a
f:[File a]
rest -> if a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== File a -> a
forall a. File a -> a
_fileHandle File a
f
then File a -> Maybe (File a)
forall a. a -> Maybe a
Just File a
f
else [File a] -> Maybe (File a)
lookup [File a]
rest
putFile :: (Eq a) => File a -> FileSystem a -> FileSystem a
putFile :: File a -> FileSystem a -> FileSystem a
putFile File a
f (FileSystem [File a]
fs) = [File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem ([File a] -> FileSystem a) -> [File a] -> FileSystem a
forall a b. (a -> b) -> a -> b
$ [File a] -> [File a]
putFile' [File a]
fs
where
putFile' :: [File a] -> [File a]
putFile' [File a]
zs = case [File a]
zs of
[] -> [File a
f]
(File a
g:[File a]
rest) -> if File a -> a
forall a. File a -> a
_fileHandle File a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== File a -> a
forall a. File a -> a
_fileHandle File a
g
then File a
f File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
: [File a]
rest
else File a
g File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
: [File a] -> [File a]
putFile' [File a]
rest
fileExists
:: (Eq a)
=> a
-> FileSystem a
-> Bool
fileExists :: a -> FileSystem a -> Bool
fileExists a
h = Maybe (File a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (File a) -> Bool)
-> (FileSystem a -> Maybe (File a)) -> FileSystem a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FileSystem a -> Maybe (File a)
forall a. Eq a => a -> FileSystem a -> Maybe (File a)
getFile a
h
hasFile
:: (Eq a)
=> a
-> [Text]
-> FileSystem a
-> Bool
hasFile :: a -> [Text] -> FileSystem a -> Bool
hasFile a
h [Text]
lns FileSystem a
fs = case a -> FileSystem a -> Maybe [Text]
forall a. Eq a => a -> FileSystem a -> Maybe [Text]
getLines a
h FileSystem a
fs of
Maybe [Text]
Nothing -> Bool
False
Just [Text]
ms -> [Text]
ms [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
lns
getLines
:: (Eq a)
=> a
-> FileSystem a
-> Maybe [Text]
getLines :: a -> FileSystem a -> Maybe [Text]
getLines a
h = (File a -> [Text]) -> Maybe (File a) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap File a -> [Text]
forall a. File a -> [Text]
_fileContents (Maybe (File a) -> Maybe [Text])
-> (FileSystem a -> Maybe (File a)) -> FileSystem a -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FileSystem a -> Maybe (File a)
forall a. Eq a => a -> FileSystem a -> Maybe (File a)
getFile a
h
writeLines
:: (Eq a)
=> a
-> [Text]
-> FileSystem a
-> FileSystem a
writeLines :: a -> [Text] -> FileSystem a -> FileSystem a
writeLines a
a [Text]
lns = File a -> FileSystem a -> FileSystem a
forall a. Eq a => File a -> FileSystem a -> FileSystem a
putFile (a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
a [Text]
lns)
appendLines
:: (Eq a)
=> a
-> [Text]
-> FileSystem a
-> FileSystem a
appendLines :: a -> [Text] -> FileSystem a -> FileSystem a
appendLines a
h [Text]
ls (FileSystem [File a]
fs) = [File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem ([File a] -> FileSystem a) -> [File a] -> FileSystem a
forall a b. (a -> b) -> a -> b
$ [File a] -> [File a]
appendLines' [File a]
fs
where
appendLines' :: [File a] -> [File a]
appendLines' [File a]
zs = case [File a]
zs of
[] -> [a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
h [Text]
ls]
(File a
u [Text]
ms):[File a]
rest -> if a
u a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h
then (a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
u ([Text]
ms [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ls)) File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
: [File a]
rest
else (a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
u [Text]
ms) File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
: [File a] -> [File a]
appendLines' [File a]
rest
deleteFile
:: (Eq a)
=> a
-> FileSystem a
-> FileSystem a
deleteFile :: a -> FileSystem a -> FileSystem a
deleteFile a
h (FileSystem [File a]
fs) = [File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem ([File a] -> FileSystem a) -> [File a] -> FileSystem a
forall a b. (a -> b) -> a -> b
$ [File a] -> [File a]
deleteFile' [File a]
fs
where
deleteFile' :: [File a] -> [File a]
deleteFile' [File a]
zs = case [File a]
zs of
[] -> []
File a
m:[File a]
rest -> if a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== File a -> a
forall a. File a -> a
_fileHandle File a
m
then [File a]
rest
else File a
m File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
: [File a] -> [File a]
deleteFile' [File a]
rest
readLine
:: (Eq a)
=> e
-> e
-> a
-> FileSystem a
-> Either e (Text, FileSystem a)
readLine :: e -> e -> a -> FileSystem a -> Either e (Text, FileSystem a)
readLine e
notFound e
eof a
k (FileSystem [File a]
fs) = [File a] -> [File a] -> Either e (Text, FileSystem a)
getline [File a]
fs []
where
getline :: [File a] -> [File a] -> Either e (Text, FileSystem a)
getline [File a]
xs [File a]
ys = case [File a]
xs of
[] -> e -> Either e (Text, FileSystem a)
forall a b. a -> Either a b
Left e
notFound
(File a
u [Text]
x):[File a]
rest -> if a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u
then case [Text]
x of
[] -> e -> Either e (Text, FileSystem a)
forall a b. a -> Either a b
Left e
eof
Text
w:[Text]
ws -> (Text, FileSystem a) -> Either e (Text, FileSystem a)
forall a b. b -> Either a b
Right (Text
w, [File a] -> FileSystem a
forall a. [File a] -> FileSystem a
FileSystem ([File a] -> FileSystem a) -> [File a] -> FileSystem a
forall a b. (a -> b) -> a -> b
$ [a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
k [Text]
ws] [File a] -> [File a] -> [File a]
forall a. [a] -> [a] -> [a]
++ [File a]
rest [File a] -> [File a] -> [File a]
forall a. [a] -> [a] -> [a]
++ [File a]
ys)
else [File a] -> [File a] -> Either e (Text, FileSystem a)
getline [File a]
rest ((a -> [Text] -> File a
forall a. a -> [Text] -> File a
File a
u [Text]
x)File a -> [File a] -> [File a]
forall a. a -> [a] -> [a]
:[File a]
ys)