-- | 'Layout' traverses module System.Directory.Layout.Traverse ( make, check ) where import Prelude hiding (readFile) import Control.Monad.Reader (ReaderT, runReaderT, ask, local) import Control.Monad.Writer (WriterT, execWriterT) import Data.Text (Text) import System.FilePath (()) import System.Directory.Layout.Internal import System.Directory.Layout.Errored type RunT = ReaderT FilePath (WriterT [LayoutException] IO) runRunT :: FilePath -> RunT a -> IO [LayoutException] runRunT e = execWriterT . flip runReaderT e applyTraverse :: (Layout -> RunT ()) -> Layout -> FilePath -> IO [LayoutException] applyTraverse f z fp = map (relative fp) `fmap` runRunT fp (f z) changeDir :: FilePath -> RunT () -> RunT () changeDir fp = local ( fp) -- | Make layout as specified -- -- For example, suppose you are in an empty directory -- -- @ -- % tree -- . -- @ -- -- and you've written simple layout: -- -- @ -- layout = do -- directory \"baz\" $ -- file_ \"twey\" -- directory \"foo\" $ do -- directory \"bar\" $ do -- file_ \"quuz\" -- file_ \"tatata\" -- file_ \"quux\" -- @ -- -- then running it should result in this directory tree: -- -- @ -- % tree -- . -- ├── baz -- │   └── twey -- └── foo -- ├── bar -- │   ├── quuz -- │   └── tatata -- └── quux -- @ -- make :: Layout -> FilePath -- ^ Root directory -> IO [LayoutException] -- ^ List of warnings make = applyTraverse go where go (E _) = return () go (F p (E _) x) = makeFile p Nothing >> go x go (F p (T t _) x) = makeFile p (Just t) >> go x go (D p x y) = makeDirectory p >> changeDir p (go x) >> go y go _ = error "Broken DL () invariant" makeFile :: FilePath -> Maybe Text -> RunT () makeFile p t = ask >>= \d -> anyfail $ createFile (d p) t makeDirectory :: FilePath -> RunT () makeDirectory p = ask >>= \d -> anyfail $ createDirectory (d p) -- | Check directory layout agrees with specified one -- -- For example, suppose there is a tree: -- -- @ -- % tree -- . -- ├── baz -- │   └── twey -- └── foo -- ├── bar -- │   ├── quuz -- │   └── tatata -- └── quux -- @ -- -- then you can write: -- -- @ -- layout = do -- directory \"baz\" $ -- file_ \"twey\" -- directory \"foo\" $ do -- directory \"bar\" $ do -- file_ \"quuz\" -- file_ \"tatata\" -- file_ \"quux\" -- @ -- -- and running @check layout \".\"@ should result in @[]@ check :: Layout -> FilePath -- ^ Root directory -> IO [LayoutException] -- ^ List of failures check = applyTraverse go where go :: Layout -> RunT () go (E _) = return () go (F p (E _) x) = checkFile p Nothing >> go x go (F p (T t _) x) = checkFile p (Just t) >> go x go (D p x y) = checkDirectory p >> changeDir p (go x) >> go y go _ = error "Broken DL () invariant" checkFile :: FilePath -> Maybe Text -> RunT () checkFile p t = ask >>= \d -> anyfail $ case t of Nothing -> fileExists (d p) Just t' -> readFile (d p) t' checkDirectory :: FilePath -> RunT () checkDirectory p = ask >>= \d -> anyfail $ directoryExists (d p)