Tissevert
/
hablo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

This commit is contained in:
Tissevert 2019-03-02 23:40:34 +01:00
parent 91bef62fbb
commit e9dad0fc3d
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Blog.hs
View File

@ -10,7 +10,7 @@ module Blog (
) where ) where
import Arguments (Arguments) import Arguments (Arguments)
import qualified Arguments (name) import qualified Arguments (name, sourceDir)
import Article (Article) import Article (Article)
import qualified Article (at, getKey) import qualified Article (at, getKey)
import Blog.Path (Path(..)) import Blog.Path (Path(..))
@ -26,6 +26,7 @@ import Data.Map (Map, lookup)
import qualified Data.Map as Map (fromList) import qualified Data.Map as Map (fromList)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set (empty, null, singleton, union) import qualified Data.Set as Set (empty, null, singleton, union)
import Files (File(..), absolute)
import qualified Files (find) import qualified Files (find)
import Prelude hiding (lookup) import Prelude hiding (lookup)
import System.Directory (doesFileExist, withCurrentDirectory) import System.Directory (doesFileExist, withCurrentDirectory)
@ -68,7 +69,7 @@ tagged collection path = do
return (takeFileName path, foldl Set.union Set.empty keys) return (takeFileName path, foldl Set.union Set.empty keys)
discover :: Path -> IO (Collection, Map String (Set String)) discover :: Path -> IO (Collection, Map String (Set String))
discover path = withCurrentDirectory (root path) $ do discover path = do
articles <- findArticles $ articlesPath path articles <- findArticles $ articlesPath path
tags <- Map.fromList . filter (not . Set.null . snd) tags <- Map.fromList . filter (not . Set.null . snd)
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`)) <$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
@ -76,10 +77,12 @@ discover path = withCurrentDirectory (root path) $ do
build :: Arguments -> IO Blog build :: Arguments -> IO Blog
build arguments = do 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 wording <- Wording.build arguments
(articles, tags) <- discover path root <- Files.absolute . Dir $ Arguments.sourceDir arguments
return $ Blog {articles, name, path, skin, tags, wording} 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}

7
src/Blog/Path.hs
View File

@ -10,7 +10,7 @@ import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..)) import qualified Arguments as Arguments (Arguments(..))
import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Files (File(..), absolute, filePath) import Files (File(..), filePath)
import GHC.Generics (Generic) import GHC.Generics (Generic)
data Path = Path { data Path = Path {
@ -28,12 +28,11 @@ instance ToJSON Path where
<> "pagesPath" .= pagesPath <> "pagesPath" .= pagesPath
) )
build :: Arguments -> IO Path build :: FilePath -> Arguments -> IO Path
build arguments = do build root arguments = do
articlesPath <- filePath . Dir $ Arguments.articlesPath arguments articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
root <- absolute . Dir $ Arguments.sourceDir arguments
return $ Path { return $ Path {
articlesPath, commentsAt, pagesPath, remarkableConfig, root articlesPath, commentsAt, pagesPath, remarkableConfig, root
} }