diff --git a/src/Blog.hs b/src/Blog.hs index 02fefc6..6c9f6d7 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -10,7 +10,7 @@ module Blog ( ) where import Arguments (Arguments) -import qualified Arguments (name) +import qualified Arguments (name, sourceDir) import Article (Article) import qualified Article (at, getKey) import Blog.Path (Path(..)) @@ -26,6 +26,7 @@ import Data.Map (Map, lookup) import qualified Data.Map as Map (fromList) import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) +import Files (File(..), absolute) import qualified Files (find) import Prelude hiding (lookup) import System.Directory (doesFileExist, withCurrentDirectory) @@ -68,7 +69,7 @@ tagged collection path = do return (takeFileName path, foldl Set.union Set.empty keys) discover :: Path -> IO (Collection, Map String (Set String)) -discover path = withCurrentDirectory (root path) $ do +discover path = do articles <- findArticles $ articlesPath path tags <- Map.fromList . filter (not . Set.null . snd) <$> (Files.find (articlesPath path "tags") >>= mapM (articles `tagged`)) @@ -76,10 +77,12 @@ discover path = withCurrentDirectory (root path) $ do build :: Arguments -> IO Blog build arguments = do - path <- Path.build arguments - let name = maybe (takeFileName . dropTrailingPathSeparator $ root path) id - $ Arguments.name arguments - skin <- Skin.build name arguments wording <- Wording.build arguments - (articles, tags) <- discover path - return $ Blog {articles, name, path, skin, tags, wording} + root <- Files.absolute . Dir $ Arguments.sourceDir arguments + withCurrentDirectory root $ do + path <- Path.build root arguments + let name = maybe (takeFileName $ dropTrailingPathSeparator root) id + $ Arguments.name arguments + skin <- Skin.build name arguments + (articles, tags) <- discover path + return $ Blog {articles, name, path, skin, tags, wording} diff --git a/src/Blog/Path.hs b/src/Blog/Path.hs index a216f52..f8ed96f 100644 --- a/src/Blog/Path.hs +++ b/src/Blog/Path.hs @@ -10,7 +10,7 @@ import Arguments (Arguments) import qualified Arguments as Arguments (Arguments(..)) import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Monoid ((<>)) -import Files (File(..), absolute, filePath) +import Files (File(..), filePath) import GHC.Generics (Generic) data Path = Path { @@ -28,12 +28,11 @@ instance ToJSON Path where <> "pagesPath" .= pagesPath ) -build :: Arguments -> IO Path -build arguments = do +build :: FilePath -> Arguments -> IO Path +build root arguments = do articlesPath <- filePath . Dir $ Arguments.articlesPath arguments pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments - root <- absolute . Dir $ Arguments.sourceDir arguments return $ Path { articlesPath, commentsAt, pagesPath, remarkableConfig, root }