Erase the asymmetry between articles and pages; make both optional though check that at least one exists

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

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

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 ()

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)