module System.Directory.Layout.Make
( DLMakeWarning(..), make
) where
import Control.Arrow (second)
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
make ∷ Layout
→ FilePath
→ IO [DLMakeWarning]
make z fp = do
d ← getCurrentDirectory
fp' ← canonicalizePath fp
setCurrentDirectory fp'
xs ← runRunT (fp', fp') (f z)
setCurrentDirectory d
return xs
where
f (E _) = return ()
f (F p Nothing x) = touchFile p >> f x
f (F p (Just c) x) = touchFile p >> infectFile p c >> f x
f (D p x y) = createDir p >> changeDir p (f x) >> f y
data DLMakeWarning =
FileDoesExist FilePath
| DirectoryDoesExist FilePath
deriving (Show, Read, Eq, Ord)
type RunT = ReaderT (FilePath, FilePath) (WriterT [DLMakeWarning] IO)
runRunT ∷ (FilePath, FilePath) → RunT a → IO [DLMakeWarning]
runRunT e = execWriterT . flip runReaderT e
touchFile ∷ FilePath → RunT ()
touchFile p = do
(r, d) ← ask
z ← io $ doesFileExist (d </> p)
if z
then tell' [FileDoesExist (makeRelative r d </> p)]
else io $ T.writeFile (d </> p) ""
infectFile ∷ FilePath → Text → RunT ()
infectFile p c = do
(_, d) ← ask
io $ T.writeFile (d </> p) c
createDir ∷ FilePath → RunT ()
createDir p = do
(r, d) ← ask
z ← io $ doesDirectoryExist (d </> p)
if z
then tell' [DirectoryDoesExist (makeRelative r d </> p)]
else io $ createDirectory (d </> p)
changeDir ∷ FilePath → RunT () → RunT ()
changeDir fp = local (second (</> fp))
io ∷ IO a → RunT a
io = liftIO
tell' ∷ [DLMakeWarning] → RunT ()
tell' = lift . tell