{- |
Module      : Data.MockIO
Description : A mock IO monad for testing.
Copyright   : 2018, Automattic, Inc.
License     : BSD3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

A fake filesystem for testing.
-}

{-# 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 )



-- | Abstraction of a text file consisting of a "handle" and a list of lines.
data File a = File
  { File a -> a
_fileHandle :: a -- ^ File "handle"
  , File a -> [Text]
_fileContents :: [Text] -- ^ List of lines
  } 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
"<<<<<"]





-- | A mapping from "handles" of type @a@ to lists of lines.
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

-- | No files; populate with `writeLines` or `appendLines`.
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

-- | Detect whether a file with the given handle exists.
fileExists
  :: (Eq a)
  => a -- ^ File handle
  -> 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

-- | Detect whether a file with the given handle exists and has given contents.
hasFile
  :: (Eq a)
  => a -- ^ Handle
  -> [Text] -- ^ Contents
  -> 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

-- | Retrieve the contents of a file, or nothing if the file does not exist.
getLines
  :: (Eq a)
  => a -- ^ Handle
  -> 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

-- | Overwrite the contents of a file.
writeLines
  :: (Eq a)
  => a -- ^ Handle
  -> [Text] -- ^ Contents
  -> 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)

-- | Append to a file.
appendLines
  :: (Eq a)
  => a -- ^ Handle
  -> [Text] -- ^ Contents
  -> 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

-- | Delete a file; if no such file exists, has no effect.
deleteFile
  :: (Eq a)
  => a -- ^ Handle
  -> 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

-- | Read the first line of a file.
readLine
  :: (Eq a)
  => e -- ^ Handle not found error
  -> e -- ^ EOF error
  -> a -- ^ Handle
  -> 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)