Remove the option to generate into a directory other than the parent directory of the one containing the articles to get rid of the hassle of copying the markdown sources and simplify working with relative URLs during the generation process

src/Arguments.hs

@@ -1,34 +1,21 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Arguments (
       Arguments(..)
-    , Configuration
-    , getConfiguration
+    , configuration
   ) where
 
 import Options.Applicative
-import System.FilePath.Posix (dropTrailingPathSeparator, isValid, takeDirectory, takeFileName)
---import System.Directory (doesDirectoryExist)
+import System.FilePath.Posix (dropTrailingPathSeparator, isValid)
 
-data Arguments a b = Arguments {
+data Arguments = Arguments {
       sourceDir :: FilePath
-    , outputDir :: a
-    , blogName :: b
-    , previewCount :: Int
+    , blogName :: Maybe String
+    , previewCountArg :: Int
   }
 
-type InputArguments = Arguments (Maybe FilePath) (Maybe String)
-type Configuration = Arguments FilePath String
-
-arguments :: Parser InputArguments
+arguments :: Parser Arguments
 arguments = Arguments
   <$> argument directory (metavar "INPUT_DIR")
-  <*> option (optional directory) (
-          metavar "OUTPUT_DIR"
-        <> value Nothing
-        <> short 'o'
-        <> long "output"
-        <> help "directory in which to generate the blog"
-      )
   <*> option (optional str) (
           metavar "BLOG_NAME"
         <> value Nothing
@@ -44,29 +31,15 @@ arguments = Arguments
         <> help "number of articles listed on the page of each category"
       )
 
-{-
-existingDirectory :: ReadM FilePath
-existingDirectory = eitherReader $ \path ->
-  if doesDirectoryExist path
-    then Right path
-    else Left "The input directory must be an existing path"
--}
-
 directory :: ReadM FilePath
 directory = eitherReader $ \path ->
   if isValid path
     then Right $ dropTrailingPathSeparator path
     else Left "This string doesn't represent a valid path"
 
-getConfiguration :: IO Configuration
-getConfiguration = do
-  invocation <- execParser $
+configuration :: IO Arguments
+configuration =
+  execParser $
     info (arguments <**> helper)
       ( fullDesc
       )
-  let outputDirOrDefault = maybe (takeDirectory $ sourceDir invocation) id (outputDir invocation)
-  let blogNameOrDefault = maybe (takeFileName outputDirOrDefault) id (blogName invocation)
-  return $ invocation {
-        outputDir = outputDirOrDefault
-      , blogName = blogNameOrDefault
-    }

src/Blog.hs

@@ -5,16 +5,15 @@ module Blog (
     , get
   ) where
 
-import Arguments (Arguments(..), Configuration)
+import Arguments (Arguments(..))
 import Control.Monad ((>=>), filterM, forM)
 import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (MonadReader(..), ReaderT)
 import Data.Map (Map)
 import qualified Data.Map as Map (fromList, member)
 import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
 import System.Directory (doesFileExist, listDirectory)
-import System.FilePath.Posix ((</>), takeExtension, takeFileName)
+import System.FilePath.Posix ((</>), takeExtension, takeDirectory, takeFileName)
 import System.Posix.Types (FileID)
 import System.Posix.Files (FileStatus, getFileStatus, fileID)
 
@@ -28,6 +27,8 @@ type Collection = Map FileID Article
 data Blog = Blog {
       articles :: Collection
     , name :: String
+    , previewCount :: Int
+    , root :: FilePath
     , tags :: Map String (Set FileID)
   }
 
@@ -62,11 +63,11 @@ tagged collection path = do
       else return Set.empty
   return (takeFileName path, foldl Set.union Set.empty fileIDs)
 
-get :: ReaderT Configuration IO Blog
-get = do
-  path <- sourceDir <$> ask
-  articles <- findArticles path
-  name <- blogName <$> ask
+get :: Arguments -> IO Blog
+get (Arguments {sourceDir, blogName, previewCountArg}) = do
+  let root = takeDirectory sourceDir
+  let name = maybe (takeFileName root) id $ blogName
+  articles <- findArticles sourceDir
   tags <- Map.fromList . filter (not . Set.null . snd)
-    <$> (find (path </> "tags") >>= mapM (articles `tagged`))
-  return $ Blog { articles , name, tags }
+    <$> (find (sourceDir </> "tags") >>= mapM (articles `tagged`))
+  return $ Blog { articles , name, previewCount = previewCountArg, root, tags }

src/Dom.hs

@@ -4,7 +4,6 @@ module Dom (
     generate
   ) where
 
-import Arguments (Arguments(..), Configuration)
 import Blog (Article(..), Blog(..))
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (MonadIO(..))
@@ -61,15 +60,15 @@ render (Page {category, full, articlesFeatured}) blog =
     pageTitle =
       if full then "All" else "Latest" ++ " articles" ++ maybe "" (" tagged " ++) category
 
-generateCollection :: (Maybe String, FilePath, [Article]) -> Blog -> ReaderT Configuration IO ()
-generateCollection (_, _, []) _ = return ()
-generateCollection (category, path, articlesFeatured) blog = do
-  n <- previewCount <$> ask
+generateCollection :: (Maybe String, FilePath, [Article]) -> ReaderT Blog IO ()
+generateCollection (_, _, []) = return ()
+generateCollection (category, path, articlesFeatured) = do
+  blog <- ask
   liftIO $ createDirectoryIfMissing False path
-  forM_ (pages n) $ \page ->
+  forM_ (pages $ previewCount blog) $ \page ->
     liftIO $ renderToFile (urlPath page) (render page blog)
   where
-    pages n = [
+    pages articlesCount = [
           Page {
               category
             , full = True
@@ -80,16 +79,16 @@ generateCollection (category, path, articlesFeatured) blog = do
               category
             , full = False
             , urlPath = path </> "index.html"
-            , articlesFeatured = take n articlesFeatured
+            , articlesFeatured = take articlesCount articlesFeatured
           }
       ]
 
-generate :: Blog -> ReaderT Configuration IO ()
-generate blog@(Blog {articles, tags}) = do
-  path <- outputDir <$> ask
-  generateCollection (Nothing, path, sortByDate $ Map.elems articles) blog
-  forM_ (Map.toList tags) $ \(tag, tagged) ->
-    generateCollection (Just tag, path </> tag, sortByDate $ getArticles tagged) blog
+generate :: ReaderT Blog IO ()
+generate = do
+  Blog {root, articles, tags} <- ask
+  generateCollection (Nothing, root, sortByDate $ Map.elems articles)
+  forM_ (Map.toList $ tags) $ \(tag, tagged) ->
+    generateCollection (Just tag, root </> tag, sortByDate $ getArticles tagged articles)
   where
-    getArticles tagged = Map.elems $ Map.filterWithKey (\k _ -> Set.member k tagged) articles
+    getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
     sortByDate = sortOn (Down . modificationTime . fileStatus)

src/JSON.hs

@@ -2,7 +2,6 @@ module JSON (
     generate
   ) where
 
-import Arguments (Arguments(..), Configuration)
 import Blog (Blog(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (MonadReader(..), ReaderT)
@@ -11,7 +10,7 @@ import Data.ByteString.Lazy (writeFile)
 import System.FilePath.Posix ((</>))
 import Prelude hiding (writeFile)
 
-generate :: Blog -> ReaderT Configuration IO ()
-generate _ = do
-  path <- outputDir <$> ask
+generate :: ReaderT Blog IO ()
+generate = do
+  path <- root <$> ask
   liftIO $ writeFile (path </> "articles.json") (encode $ object [])

src/Main.hs

@@ -1,7 +1,7 @@
 {- LANGUAGE NamedFieldPuns #-}
 module Main where
 
-import Arguments (getConfiguration)
+import Arguments (configuration)
 import qualified Blog (get)
 import qualified Dom (generate)
 import qualified JSON (generate)
@@ -9,9 +9,9 @@ import Control.Monad.Reader (runReaderT)
 
 main :: IO ()
 main = do
-  getConfiguration
+  configuration
+  >>= Blog.get
   >>= runReaderT (do
-    blog <- Blog.get
-    Dom.generate blog
-    JSON.generate blog
+    Dom.generate
+    JSON.generate
   )