Refactor to put more work (checking files existance, making path absolutes) into the Files module and simplify Arguments a bit

src/Arguments.hs

@@ -9,9 +9,7 @@ import Control.Applicative ((<|>), (<**>), optional)
 import Options.Applicative (Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc, header, help, helper, info, long, metavar, short, str, value)
 import qualified Options.Applicative as Optparse (option)
 import qualified Paths_hablo as Hablo (version)
-import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
-import System.Exit (die)
-import System.FilePath ((</>), dropTrailingPathSeparator, isValid)
+import System.FilePath (dropTrailingPathSeparator, isValid)
 
 data Arguments = BlogConfig {
       sourceDir :: FilePath
@@ -89,37 +87,9 @@ filePath = eitherReader $ \path ->
     then Right $ dropTrailingPathSeparator path
     else Left "This string doesn't represent a valid path"
 
-ifNotDie :: (a -> IO Bool) -> (a -> String) -> a -> IO ()
-ifNotDie check messageBuilder input = do
-  bool <- check input
-  if bool
-    then return ()
-    else die $ messageBuilder input
-
-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
-  mapM_ (doesFileExist `ifNotDie` noSuchFile) $ headPath aBlogConfig
-  absoluteHeadPath <- mapM makeAbsolute $ headPath aBlogConfig
-  return $ aBlogConfig {
-        sourceDir = absoluteSourceDir
-      , bannerPath = absoluteBannerPath
-      , headPath = absoluteHeadPath
-    }
-  where
-    noSuchDirectory = (++ ": no such directory")
-    noSuchFile = (++ ": no such file")
-
 get :: IO Arguments
 get = do
-  checkAndMakeAbsolute =<< (execParser $
-      info
-        (arguments <**> helper)
-        (fullDesc <> header ("Hablo v" ++ showVersion Hablo.version))
-    )
+  execParser $
+    info
+      (arguments <**> helper)
+      (fullDesc <> header ("Hablo v" ++ showVersion Hablo.version))

src/ArticlesList.hs

@@ -13,6 +13,7 @@ import Control.Monad.Reader (MonadReader)
 import Data.Text (Text, pack)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Template (render)
+import Files (absoluteLink)
 import Pretty ((.$))
 import System.FilePath.Posix ((</>))
 
@@ -23,12 +24,8 @@ data ArticlesList = ArticlesList {
   }
 
 otherUrl :: ArticlesList -> String
-otherUrl (ArticlesList {full, tagged}) =
-  if full
-    then url tagged
-    else url tagged </> "all.html"
-  where
-    url = maybe "/" ("/" </>)
+otherUrl (ArticlesList {full, tagged}) = absoluteLink $
+  (if full then id else (</> "all.html")) $ maybe "" id tagged
 
 pageTitle :: (MonadReader Blog m) => ArticlesList -> m Text
 pageTitle (ArticlesList {full, tagged}) = do

src/Blog.hs

@@ -67,15 +67,19 @@ tagged collection path = do
       else Set.empty
   return (takeFileName path, foldl Set.union Set.empty keys)
 
-build :: Arguments -> IO Blog
-build arguments = withCurrentDirectory (root path) $ do
-  skin <- Skin.build name arguments
-  wording <- Wording.build arguments
+discover :: Path -> IO (Collection, Map String (Set String))
+discover path = withCurrentDirectory (root path) $ do
   articles <- findArticles $ articlesPath path
   tags <- Map.fromList . filter (not . Set.null . snd)
     <$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
-  return $ Blog {articles, name, path, skin, tags, wording}
-  where
-    path = Path.build arguments
-    name = maybe (takeFileName . dropTrailingPathSeparator $ root path) id
+  return (articles, tags)
+
+build :: Arguments -> IO Blog
+build arguments = do
+  path <- Path.build arguments
+  let name = maybe (takeFileName . dropTrailingPathSeparator $ root path) id
             $ Arguments.name arguments
+  skin <- Skin.build name arguments
+  wording <- Wording.build arguments
+  (articles, tags) <- discover path
+  return $ Blog {articles, name, path, skin, tags, wording}

src/Blog/Path.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 module Blog.Path (
       Path(..)
     , build
@@ -5,6 +6,7 @@ module Blog.Path (
 
 import Arguments (Arguments)
 import qualified Arguments as Arguments (Arguments(..))
+import Files (File(..), absolute, filePath)
 
 data Path = Path {
       articlesPath :: FilePath
@@ -13,10 +15,11 @@ data Path = Path {
     , root :: FilePath
   }
 
-build :: Arguments -> Path
-build arguments = Path {
-      articlesPath = Arguments.articlesPath arguments
-    , commentsAt = Arguments.commentsAt arguments
-    , pagesPath = Arguments.pagesPath arguments
-    , root = Arguments.sourceDir arguments
-  }
+build :: Arguments -> IO Path
+build arguments = do
+  articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
+  pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
+  root <- absolute . Dir $ Arguments.sourceDir arguments
+  return $ Path {
+      articlesPath, commentsAt = Arguments.commentsAt arguments, pagesPath, root
+    }

src/Blog/Skin.hs

@@ -8,6 +8,7 @@ import Arguments (Arguments)
 import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArticlesCount, previewLinesCount)
 import Control.Monad (filterM)
 import Data.Maybe (listToMaybe)
+import Files (absoluteLink)
 import Prelude hiding (head)
 import System.Directory (doesFileExist)
 import System.FilePath ((</>), (<.>))
@@ -21,14 +22,10 @@ data Skin = Skin {
     , previewLinesCount :: Int
   }
 
-absolute :: FilePath -> FilePath
-absolute ('.':path) = path
-absolute path = "/" </> path
-
 findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
-findImage _ (Just path) = return . Just $ absolute path
+findImage _ (Just path) = return . Just $ absoluteLink path
 findImage name Nothing =
-  fmap absolute . listToMaybe <$> filterM doesFileExist pathsToCheck
+  fmap absoluteLink . listToMaybe <$> filterM doesFileExist pathsToCheck
   where
     directories = [".", "image", "images", "pictures", "skin", "static"]
     extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]

src/Dom.hs

@@ -14,6 +14,7 @@ import Control.Monad.Reader (ReaderT)
 import qualified Data.Map as Map (keys, lookup)
 import Data.Monoid ((<>))
 import Data.Text (Text, pack, empty)
+import Files (absoluteLink)
 import Lucid
 import Lucid.Base (makeAttribute)
 import Prelude hiding (head, lookup)
@@ -55,7 +56,7 @@ instance Page ArticlesList where
 
 article :: Bool -> Article -> HtmlGenerator ()
 article raw (Article {key, body, title}) = do
-  url <- ("/" </>) . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
+  url <- absoluteLink . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
   article_ (do
       header_ (do
           aElem [href_ . pack $ url] . h1_ $ toHtml title
@@ -79,7 +80,7 @@ navigationA :: Term arg result => arg -> result
 navigationA = "a" `termWith` [class_ "navigation"]
 
 tag :: String -> HtmlGenerator ()
-tag tagName = li_ (navigationA [href_ $ pack ("/" </> tagName)] $ toHtml tagName)
+tag tagName = li_ (navigationA [href_ . pack $ absoluteLink tagName] $ toHtml tagName)
 
 defaultBanner :: HtmlGenerator ()
 defaultBanner = do

src/Files.hs

@@ -1,9 +1,34 @@
 module Files (
-    find
+      File(..)
+    , absolute
+    , absoluteLink
+    , filePath
+    , find
   ) where
 
+import System.Exit (die)
+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
 import System.FilePath ((</>))
-import System.Directory (listDirectory)
+
+data File = File FilePath | Dir FilePath
+
+absolute :: File -> IO (FilePath)
+absolute file = filePath file >>= makeAbsolute
+
+absoluteLink :: FilePath -> FilePath
+absoluteLink ('.':path) = path
+absoluteLink path = "/" </> path
+
+filePath :: File -> IO FilePath
+filePath file = do
+  let (thePath, test, errorMessage) =
+        case file of
+          File path -> (path, doesFileExist, (++ ": no such file"))
+          Dir path -> (path, doesDirectoryExist, (++ ": no such directory"))
+  bool <- test thePath
+  if bool
+    then return thePath
+    else die $ errorMessage thePath
 
 find :: FilePath -> IO [FilePath]
 find path =