module System.Directory.Layout.Check
( DLCheckFailure(..), check
) where
import Control.Arrow (second)
import Control.Monad (unless, when)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask, local)
import Control.Monad.Trans.Writer (WriterT, execWriterT, tell)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Data.Text (Text)
import qualified Data.Text.IO as T
import System.FilePath ((</>), makeRelative)
import System.Directory
import System.Directory.Layout.Internal
check ∷ Layout
→ FilePath
→ IO [DLCheckFailure]
check z fp = do
d ← getCurrentDirectory
fp' ← canonicalizePath fp
setCurrentDirectory fp'
xs ← runCheckT (fp', fp') (f z)
setCurrentDirectory d
return xs
where
f (E _) = return ()
f (F p Nothing x) = fileExists p >> f x
f (F p (Just c) x) = fileExists p >>= \t → when t (fileContains p c) >> f x
f (D p x y) = dirExists p >>= \t → when t (changeDir p (f x)) >> f y
data DLCheckFailure =
FileDoesNotExist FilePath
| FileWrongContents FilePath Text
| DirectoryDoesNotExist FilePath
deriving (Show, Read, Eq, Ord)
type CheckT = ReaderT (FilePath, FilePath) (WriterT [DLCheckFailure] IO)
runCheckT ∷ (FilePath, FilePath) → CheckT a → IO [DLCheckFailure]
runCheckT e = execWriterT . flip runReaderT e
fileExists ∷ FilePath → CheckT Bool
fileExists p = do
(r, d) ← ask
z ← io $ doesFileExist (d </> p)
unless z $
tell' [FileDoesNotExist (makeRelative r d </> p)]
return z
dirExists ∷ FilePath → CheckT Bool
dirExists p = do
(r, d) ← ask
z ← io $ doesDirectoryExist (d </> p)
unless z $
tell' [DirectoryDoesNotExist (makeRelative r d </> p)]
return z
fileContains ∷ FilePath → Text → CheckT ()
fileContains p c = do
(r, d) ← ask
z ← io $ T.readFile (d </> p)
unless (z == c) $
tell' [FileWrongContents (makeRelative r d </> p) z]
changeDir ∷ FilePath → CheckT () → CheckT ()
changeDir fp = local (second (</> fp))
io ∷ IO a → CheckT a
io = liftIO
tell' ∷ [DLCheckFailure] → CheckT ()
tell' = lift . tell