From f7ec6d06c16939315e162999766f9610d00ca967 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Wed, 30 Sep 2020 22:00:30 +0200 Subject: [PATCH] Erase the asymmetry between articles and pages; make both optional though check that at least one exists --- src/Arguments.hs | 15 +++++---------- src/Blog.hs | 11 ++++++++--- src/Blog/Path.hs | 23 +++++++++++++---------- src/Files.hs | 20 +++++++++++++------- 4 files changed, 39 insertions(+), 30 deletions(-) diff --git a/src/Arguments.hs b/src/Arguments.hs index 45b9bb6..a2a6fe2 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -16,7 +16,7 @@ import System.FilePath (dropTrailingPathSeparator, isValid) data Arguments = BlogConfig { sourceDir :: FilePath - , articlesPath :: FilePath + , articlesPath :: Maybe FilePath , bannerPath :: Maybe FilePath , cardImage :: Maybe FilePath , commentsURL :: Maybe String @@ -47,13 +47,8 @@ option readM aShort aLong aMetavar aHelpMessage = blogConfig :: Parser Arguments blogConfig = BlogConfig <$> argument filePath (value "." <> metavar "INPUT_DIR") - <*> Optparse.option filePath ( - metavar "DIRECTORY" - <> value "articles" - <> short 'a' - <> long "articles" - <> help "relative path to the directory containing the articles within INPUT_DIR" - ) + <*> option filePath 'a' "articles" "DIRECTORY" + "relative path to the directory containing the articles within INPUT_DIR" <*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner" <*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card" <*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored" @@ -61,8 +56,8 @@ blogConfig = BlogConfig <*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head" <*> option str 'n' "name" "BLOG_NAME" "name of the blog" <*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards") - <*> option filePath 'p' "pages" - "DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR" + <*> option filePath 'p' "pages" "DIRECTORY" + "relative path to the directory containing the pages within INPUT_DIR" <*> Optparse.option auto ( metavar "INTEGER" <> value 3 diff --git a/src/Blog.hs b/src/Blog.hs index 3a6701b..6de4108 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -96,11 +96,16 @@ tagged collection path = do discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String)) discover path = do - articles <- find Article.at $ articlesPath path + (articles, tags) <- discoverArticles $ articlesPath path pages <- maybe (return Map.empty) (find Page.at) $ pagesPath path - tags <- Map.fromList . filter (not . Set.null . snd) - <$> (Files.find (articlesPath path "tags") >>= mapM (articles `tagged`)) return (articles, pages, tags) + where + discoverArticles Nothing = return (Map.empty, Map.empty) + discoverArticles (Just somePath) = do + articles <- find Article.at somePath + tags <- Map.fromList . filter (not . Set.null . snd) + <$> (Files.find (somePath "tags") >>= mapM (articles `tagged`)) + return (articles, tags) build :: Arguments -> IO Blog build arguments = do diff --git a/src/Blog/Path.hs b/src/Blog/Path.hs index 15e4aaa..3f40db5 100644 --- a/src/Blog/Path.hs +++ b/src/Blog/Path.hs @@ -10,12 +10,12 @@ import Arguments (Arguments) import qualified Arguments as Arguments (Arguments(..)) import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Monoid ((<>)) -import Files (File(..), filePath) +import Files (File(..), filePath, filePathMaybe) import GHC.Generics (Generic) -import System.Directory (doesDirectoryExist) +import System.Exit (die) data Path = Path { - articlesPath :: FilePath + articlesPath :: Maybe FilePath , pagesPath :: Maybe FilePath , remarkableConfig :: Maybe FilePath , root :: FilePath @@ -27,15 +27,18 @@ instance ToJSON Path where <> "pagesPath" .= pagesPath ) -getPagesPath :: Maybe FilePath -> IO (Maybe FilePath) -getPagesPath Nothing = do - checkPagesPath <- doesDirectoryExist "pages" - return $ if checkPagesPath then Just "pages" else Nothing -getPagesPath (Just p) = Just <$> (filePath $ Dir p) +getMarkdownPath :: FilePath -> Maybe FilePath -> IO (Maybe FilePath) +getMarkdownPath defaultPath Nothing = filePathMaybe (Dir defaultPath) +getMarkdownPath _ (Just path) = Just <$> filePath (Dir path) build :: FilePath -> Arguments -> IO Path build root arguments = do - articlesPath <- filePath . Dir $ Arguments.articlesPath arguments - pagesPath <- getPagesPath $ Arguments.pagesPath arguments + articlesPath <- getMarkdownPath "articles" $ Arguments.articlesPath arguments + pagesPath <- getMarkdownPath "pages" $ Arguments.pagesPath arguments + checkForContent articlesPath pagesPath remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments return $ Path {articlesPath, pagesPath, remarkableConfig, root} + where + checkForContent Nothing Nothing = + die "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep" + checkForContent _ _ = return () diff --git a/src/Files.hs b/src/Files.hs index 9a2326d..31bba4e 100644 --- a/src/Files.hs +++ b/src/Files.hs @@ -3,6 +3,7 @@ module Files ( , absolute , absoluteLink , filePath + , filePathMaybe , find ) where @@ -19,14 +20,19 @@ absoluteLink :: FilePath -> FilePath absoluteLink ('.':path) = path absoluteLink path = "/" path +filePathMaybe :: File -> IO (Maybe FilePath) +filePathMaybe = filePathAux + where + filePathAux (File path) = ifToMaybe path <$> doesFileExist path + filePathAux (Dir path) = ifToMaybe path <$> doesDirectoryExist path + ifToMaybe path bool = if bool then return path else Nothing + filePath :: File -> IO FilePath -filePath (File path) = do - bool <- doesFileExist path - if bool then return path else die $ path ++ ": no such file" -filePath (Dir path) = do - bool <- doesDirectoryExist path - if bool then return path else die $ path ++ ": no such directory" +filePath file = filePathMaybe file >>= maybe (die $ notExist file) return + where + notExist (File path) = path ++ ": no such file" + notExist (Dir path) = path ++ ": no such directory" find :: FilePath -> IO [FilePath] find path = - fmap (path ) <$> listDirectory path + filePathMaybe (Dir path) >>= maybe (return []) (fmap ((path ) <$>) . listDirectory)