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

Browse source
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
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}

7
src/Blog/Path.hs
View file

@ -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
}