Add Vervis.Path module with repo path utils

This commit is contained in:
fr33domlover 2016-03-01 22:43:31 +00:00
parent e5ad0279b1
commit 100d2948cb
2 changed files with 62 additions and 0 deletions

61
src/Vervis/Path.hs Normal file
View file

@ -0,0 +1,61 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
module Vervis.Path
( askRepoRootDir
, personDir
, askPersonDir
, projectDir
, askProjectDir
, repoDir
, askRepoDir
)
where
import Prelude
import Data.Text (Text, unpack)
import System.FilePath ((</>))
import Yesod.Core.Handler (getYesod)
import Vervis.Foundation
import Vervis.Settings
askRepoRootDir :: Handler FilePath
askRepoRootDir = appRepoDir . appSettings <$> getYesod
personDir :: FilePath -> Text -> FilePath
personDir root user = root </> unpack user
askPersonDir :: Text -> Handler FilePath
askPersonDir user = do
root <- askRepoRootDir
return $ personDir root user
projectDir :: FilePath -> Text -> Text -> FilePath
projectDir root user proj = root </> unpack user </> unpack proj
askProjectDir :: Text -> Text -> Handler FilePath
askProjectDir user proj = do
root <- askRepoRootDir
return $ projectDir root user proj
repoDir :: FilePath -> Text -> Text -> Text -> FilePath
repoDir root user proj repo = projectDir root user proj </> unpack repo
askRepoDir :: Text -> Text -> Text -> Handler FilePath
askRepoDir user proj repo = do
root <- askRepoRootDir
return $ repoDir root user proj repo

View file

@ -58,6 +58,7 @@ library
Vervis.Handler.Project Vervis.Handler.Project
Vervis.Handler.Repo Vervis.Handler.Repo
Vervis.Handler.Util Vervis.Handler.Util
Vervis.Path
Vervis.Style Vervis.Style
-- other-modules: -- other-modules:
default-extensions: TemplateHaskell default-extensions: TemplateHaskell