Use INPUT_DIR has the root of the blog now and add an option for a path where to look for articles and static pages

hablo.cabal

@@ -24,6 +24,7 @@ executable hablo
                      , Article
                      , ArticlesList
                      , Blog
+                     , Blog.Path
                      , Blog.Skin
                      , Dom
                      , Files

src/Arguments.hs

@@ -11,15 +11,17 @@ import qualified Options.Applicative as Optparse (option)
 import qualified Paths_hablo as Hablo (version)
 import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
 import System.Exit (die, exitSuccess)
-import System.FilePath.Posix (dropTrailingPathSeparator, isValid)
+import System.FilePath ((</>), dropTrailingPathSeparator, isValid)
 
 data Arguments = BlogConfig {
       sourceDir :: FilePath
+    , articlesPath :: FilePath
     , bannerPath :: Maybe FilePath
     , cardImage :: Maybe FilePath
     , favicon :: Maybe FilePath
     , headPath :: Maybe FilePath
     , name :: Maybe String
+    , pagesPath :: Maybe FilePath
     , previewArticlesCount :: Int
     , previewLinesCount :: Int
   }
@@ -37,23 +39,32 @@ option readM aShort aLong aMetavar aHelpMessage =
 
 blogConfig :: Parser Arguments
 blogConfig = BlogConfig
-  <$> argument filePath (metavar "INPUT_DIR")
+  <$> argument filePath (value "." <> metavar "INPUT_DIR")
+  <*> Optparse.option filePath (
+          metavar "ARTICLES_PATH"
+        <> value "articles"
+        <> short 'a'
+        <> long "articles"
+        <> help "name of the directory containing the articles within INPUT_DIR"
+      )
   <*> option filePath 'b' "banner" "BANNER_PATH" "path to the file to use for the blog's banner"
   <*> option filePath 'c' "card-image" "CARD_IMAGE" "path to the image to use for the blog's card"
   <*> option filePath 'f' "favicon" "FAVICON" "path to the image to use for the blog's favicon"
   <*> option filePath 'H' "head" "HEAD_PATH" "path to the file to add in the blog's head"
   <*> option str 'n' "name" "BLOG_NAME" "name of the blog"
+  <*> option filePath 'p' "pages"
+        "PAGES_PATH" "name of the directory containing the pages within INPUT_DIR"
   <*> Optparse.option auto (
           metavar "PREVIEW_ARTICLES_COUNT"
         <> value 3
-        <> short 'a'
+        <> short 'A'
         <> long "preview-articles"
         <> help "number of articles listed on the page of each category"
       )
   <*> Optparse.option auto (
           metavar "PREVIEW_LINES_COUNT"
         <> value 10
-        <> short 'l'
+        <> short 'L'
         <> long "preview-lines"
         <> help "number of lines to display in articles preview"
       )
@@ -85,6 +96,8 @@ checkAndMakeAbsolute :: Arguments -> IO Arguments
 checkAndMakeAbsolute Version = return Version
 checkAndMakeAbsolute aBlogConfig = do
   doesDirectoryExist `ifNotDie` noSuchDirectory $ sourceDir aBlogConfig
+  doesDirectoryExist `ifNotDie` noSuchDirectory $
+    sourceDir aBlogConfig </> articlesPath aBlogConfig
   absoluteSourceDir <- makeAbsolute $ sourceDir aBlogConfig
   mapM_ (doesFileExist `ifNotDie` noSuchFile) $ bannerPath aBlogConfig
   absoluteBannerPath <- mapM makeAbsolute $ bannerPath aBlogConfig

src/Blog.hs

@@ -2,15 +2,18 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Blog (
       Blog(..)
+    , Path(..)
     , Skin(..)
     , build
     , get
   ) where
 
-import Arguments (Arguments(sourceDir))
+import Arguments (Arguments)
 import qualified Arguments (name)
 import Article (Article)
 import qualified Article (at, key)
+import Blog.Path (Path(..))
+import qualified Blog.Path as Path (build)
 import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
 import Control.Monad ((>=>), filterM, forM)
@@ -22,14 +25,14 @@ import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
 import qualified Files (find)
 import System.Directory (doesFileExist, withCurrentDirectory)
-import System.FilePath ((</>), dropTrailingPathSeparator, splitFileName, takeExtension, takeFileName)
+import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
 
 type Collection = Map String Article
 
 data Blog = Blog {
       articles :: Collection
     , name :: String
-    , root :: FilePath
+    , path :: Path
     , skin :: Skin
     , tags :: Map String (Set String)
   }
@@ -60,18 +63,13 @@ tagged collection path = do
   return (takeFileName path, foldl Set.union Set.empty keys)
 
 build :: Arguments -> IO Blog
-build arguments = withCurrentDirectory root $ do
+build arguments = withCurrentDirectory (root path) $ do
-  let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ Arguments.name arguments
   skin <- Skin.build name arguments
-  articles <- findArticles articlesPath
+  articles <- findArticles $ articlesPath path
   tags <- Map.fromList . filter (not . Set.null . snd)
-    <$> (Files.find (articlesPath </> "tags") >>= mapM (articles `tagged`))
+    <$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
-  return $ Blog {
+  return $ Blog {articles, name, path, skin, tags}
-        articles
-      , name
-      , root
-      , skin
-      , tags
-    }
   where
-    (root, articlesPath) = splitFileName $ sourceDir arguments
+    path = Path.build arguments
+    name = maybe (takeFileName . dropTrailingPathSeparator $ root path) id
+            $ Arguments.name arguments

src/Blog/Path.hs

@@ -0,0 +1,20 @@
+module Blog.Path (
+      Path(..)
+    , build
+  ) where
+
+import Arguments (Arguments)
+import qualified Arguments as Arguments (Arguments(..))
+
+data Path = Path {
+      articlesPath :: FilePath
+    , pagesPath :: Maybe FilePath
+    , root :: FilePath
+  }
+
+build :: Arguments -> Path
+build arguments = Path {
+      articlesPath = Arguments.articlesPath arguments
+    , pagesPath = Arguments.pagesPath arguments
+    , root = Arguments.sourceDir arguments
+  }

src/HTML.hs

@@ -6,7 +6,7 @@ module HTML (
 
 import Article(Article(..))
 import ArticlesList (ArticlesList(..))
-import Blog (Blog(..), Skin(..))
+import Blog (Blog(..), Path(..), Skin(..))
 import qualified Blog (get)
 import Control.Monad (forM)
 import Control.Monad.IO.Class (MonadIO(..))
@@ -31,7 +31,7 @@ data Collection = Collection {
 
 collection :: Monad m => [Article] -> Maybe String -> ReaderT Blog m Collection
 collection articlesFeatured tag = do
-  root <- Blog.get root
+  root <- Blog.get $path.$root
   return $ Collection {
         articlesFeatured = sortByDate articlesFeatured
       , basePath = maybe root (root </>) tag
@@ -58,7 +58,7 @@ articlesLists (Collection {articlesFeatured, basePath, tag}) = do
 
 generateArticles :: [Article] -> ReaderT Blog IO ()
 generateArticles = mapM_ $ \article -> do
-  filePath <- (</> urlPath article <.> "html") <$> (Blog.get root)
+  filePath <- (</> urlPath article <.> "html") <$> (Blog.get $path.$root)
   (renderTextT $ page article)
     >>= liftIO . TextIO.writeFile filePath
 

src/JS.hs

@@ -3,7 +3,7 @@ module JS (
     generate
   ) where
 
-import Blog (Blog(..))
+import Blog (Blog(..), Path(..))
 import qualified Blog (get)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (ReaderT)
@@ -11,6 +11,7 @@ import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
 import qualified Files (find)
 import JSON (exportBlog)
 import Paths_hablo (getDataDir)
+import Pretty ((.$))
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>))
 import Prelude hiding (concat, readFile, writeFile)
@@ -23,7 +24,7 @@ compile sources = concat (header:sources ++ [footer])
 
 generate :: ReaderT Blog IO ()
 generate = do
-  destinationDir <- (</> "js") <$> Blog.get root
+  destinationDir <- (</> "js") <$> (Blog.get $path.$root)
   blogJSON <- exportBlog
   liftIO $ do
     jsFiles <- (</> "js") <$> getDataDir >>= Files.find

src/JSON.hs

@@ -7,7 +7,7 @@ module JSON (
 import Article (Article)
 import qualified Article (Article(..))
 import Blog (Blog)
-import qualified Blog (Blog(..), Skin(..))
+import qualified Blog (Blog(..), Path(..), Skin(..))
 import Control.Monad.Reader (ReaderT, ask)
 import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
 import Data.ByteString.Lazy (ByteString)
@@ -28,6 +28,14 @@ data ArticleExport = ArticleExport {
 instance ToJSON ArticleExport where
   toEncoding = genericToEncoding defaultOptions
 
+data PathExport = PathExport {
+      articlesPath :: FilePath
+    , pagesPath :: Maybe FilePath
+  } deriving (Generic)
+
+instance ToJSON PathExport where
+  toEncoding = genericToEncoding defaultOptions
+
 data SkinExport = SkinExport {
       previewArticlesCount :: Int
     , previewLinesCount :: Int
@@ -38,8 +46,9 @@ instance ToJSON SkinExport where
 
 data BlogDB = BlogDB {
       articles :: Map String ArticleExport
-    , tags :: Map String [String]
+    , path :: PathExport
     , skin :: SkinExport
+    , tags :: Map String [String]
   } deriving (Generic)
 
 instance ToJSON BlogDB where
@@ -59,9 +68,13 @@ exportBlog = do
   blog <- ask
   return . encode $ BlogDB {
         articles = mapWithKey (export blog) $ Blog.articles blog
-      , tags = Set.elems <$> Blog.tags blog
+      , path = PathExport {
+              articlesPath = Blog.articlesPath $ Blog.path blog
+            , pagesPath = Blog.pagesPath $ Blog.path blog
+          }
       , skin = SkinExport {
               previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog
             , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog
           }
+      , tags = Set.elems <$> Blog.tags blog
     }