Fix bug causing articles/ path to not be found when hablo is not run from the target directory

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}

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
     }