From f81776d3de5dd43d0f3c965bfc9e41c6eecd9e9b Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Sat, 2 Feb 2019 17:26:07 +0100
Subject: [PATCH] Add two arguments to pass HTML files for the head and the
 banner of pages

---
 src/Arguments.hs | 63 ++++++++++++++++++++++++++++++++++++------------
 src/Main.hs      |  4 +--
 2 files changed, 49 insertions(+), 18 deletions(-)

diff --git a/src/Arguments.hs b/src/Arguments.hs
index 2b2e900..db1d16a 100644
--- a/src/Arguments.hs
+++ b/src/Arguments.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Arguments (
       Arguments(..)
-    , configuration
+    , get
   ) where
 
 import Data.Monoid ((<>))
 import Options.Applicative
-import System.Directory (doesDirectoryExist, makeAbsolute)
+import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
 import System.Exit (die)
 import System.FilePath.Posix (dropTrailingPathSeparator, isValid)
 
@@ -14,11 +14,13 @@ data Arguments = Arguments {
       sourceDir :: FilePath
     , blogName :: Maybe String
     , previewCountArg :: Int
+    , bannerPath :: Maybe FilePath
+    , headPath :: Maybe FilePath
   }
 
-arguments :: Parser Arguments
-arguments = Arguments
-  <$> argument directory (metavar "INPUT_DIR")
+parseArguments :: Parser Arguments
+parseArguments = Arguments
+  <$> argument filePath (metavar "INPUT_DIR")
   <*> option (optional str) (
           metavar "BLOG_NAME"
         <> value Nothing
@@ -33,19 +35,48 @@ arguments = Arguments
         <> long "preview-count"
         <> help "number of articles listed on the page of each category"
       )
+  <*> option (optional filePath) (
+          metavar "BANNER_PATH"
+        <> value Nothing
+        <> short 'b'
+        <> long "banner"
+        <> help "path to the file to use for the blog's banner"
+      )
+  <*> option (optional filePath) (
+          metavar "HEAD_PATH"
+        <> value Nothing
+        <> short 'H'
+        <> long "head"
+        <> help "path to the file to add in the blog's head"
+      )
 
-directory :: ReadM FilePath
-directory = eitherReader $ \path ->
+filePath :: ReadM FilePath
+filePath = eitherReader $ \path ->
   if isValid path
     then Right $ dropTrailingPathSeparator path
     else Left "This string doesn't represent a valid path"
 
-configuration :: IO Arguments
-configuration = do
-  inputArguments <- execParser $ info (arguments <**> helper) fullDesc
-  directoryExists <- doesDirectoryExist $ sourceDir inputArguments
-  if directoryExists
-    then do
-      absolutePath <- makeAbsolute $ sourceDir inputArguments
-      return $ inputArguments { sourceDir = absolutePath }
-    else die "INPUT_DIR doesn't exist"
+ifNotDie :: (a -> IO Bool) -> (a -> String) -> a -> IO ()
+ifNotDie check messageBuilder input = do
+  bool <- check input
+  if bool
+    then return ()
+    else die $ messageBuilder input
+
+get :: IO Arguments
+get = do
+  arguments <- execParser $ info (parseArguments <**> helper) fullDesc
+  doesDirectoryExist `ifNotDie` noSuchDirectory $ sourceDir arguments
+  absoluteSourceDir <- makeAbsolute $ sourceDir arguments
+  mapM_ (doesFileExist `ifNotDie` noSuchFile) $ bannerPath arguments
+  absoluteBannerPath <- mapM makeAbsolute $ bannerPath arguments
+  mapM_ (doesFileExist `ifNotDie` noSuchFile) $ headPath arguments
+  absoluteHeadPath <- mapM makeAbsolute $ headPath arguments
+  return $ arguments {
+        sourceDir = absoluteSourceDir
+      , bannerPath = absoluteBannerPath
+      , headPath = absoluteHeadPath
+    }
+  where
+    noSuchDirectory = (++ ": no such directory")
+    noSuchFile = (++ ": no such file")
diff --git a/src/Main.hs b/src/Main.hs
index 927a95f..53cd507 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,7 +1,7 @@
 {- LANGUAGE NamedFieldPuns #-}
 module Main where
 
-import Arguments (configuration)
+import qualified Arguments (get)
 import qualified Blog (get)
 import qualified Dom (generate)
 import qualified JSON (generate)
@@ -9,7 +9,7 @@ import Control.Monad.Reader (runReaderT)
 
 main :: IO ()
 main = do
-  configuration
+  Arguments.get
   >>= Blog.get
   >>= runReaderT (do
     Dom.generate