Directly store each Markdown content's path in the data structure to save having to re-build the same concatenation again and again for all the various outputs where the path matters ; also handles elegantly the «issue» of pagesPath being a Maybe FilePath because pages are optional

src/Blog/Skin.hs

@@ -36,7 +36,7 @@ instance ToJSON Skin where
 findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
 findImage _ (Just path) = return . Just $ absoluteLink path
 findImage name Nothing =
-  fmap absoluteLink . listToMaybe <$> filterM doesFileExist pathsToCheck
+  listToMaybe <$> filterM doesFileExist pathsToCheck
   where
     directories = [".", "image", "images", "pictures", "skin", "static"]
     extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]

src/DOM.hs

@@ -9,7 +9,7 @@ import qualified Article (preview)
 import ArticlesList (
     ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
   )
-import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
+import Blog (Blog(..), Skin(..), URL(..), template)
 import Control.Monad.Reader (ReaderT, asks)
 import qualified Data.Map as Map (keys)
 import Data.Text (pack, empty)
@@ -24,7 +24,7 @@ import Lucid (
 import Markdown (Markdown(..))
 import Prelude hiding (head, lookup)
 import Pretty ((.$))
-import System.FilePath.Posix ((</>), (<.>))
+import System.FilePath.Posix ((<.>))
 
 type HtmlGenerator = HtmlT (ReaderT Blog IO)
 
@@ -54,8 +54,8 @@ instance HasContent ArticlesList where
       rssLink False = return ()
 
 markdown :: Bool -> Markdown -> HtmlGenerator ()
-markdown raw (Markdown {key, body, title}) = do
+markdown raw (Markdown {key, Markdown.path, body, title}) =
-  url <- absoluteLink . (</> key <.> extension) <$> (asks $path.$articlesPath)
+  let url = absoluteLink $ path <.> extension in
   article_ [id_ $ pack key] (do
       header_ (do
           a_ [href_ $ pack url] . h1_ $ toHtml title
@@ -78,7 +78,9 @@ defaultBanner = do
     )
 
 faviconLink :: FilePath -> HtmlGenerator ()
-faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"]
+faviconLink url = link_ [
+    rel_ "shortcut icon", href_ . pack $ absoluteLink url, type_ "image/x-icon"
+  ]
 
 optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
 optional = maybe (return ()) 

src/DOM/Card.hs

@@ -21,6 +21,7 @@ import Lucid.Base (makeAttribute)
 import qualified Markdown (Markdown(..))
 import Page (Page(..))
 import Pretty ((.$))
+import System.FilePath.Posix ((</>), (<.>))
 
 class HasCard a where
   cardType :: Renderer m => a -> m Text
@@ -46,7 +47,7 @@ make element siteURL = do
   og "site_name" =<< (asks $name.$pack)
   where
     maybeImage = maybe (return ()) (og "image" . sitePrefix)
-    sitePrefix = pack . (siteURL ++)
+    sitePrefix = pack . (siteURL </>)
 
 instance HasCard Article where
   cardType _ = return "article"
@@ -57,7 +58,7 @@ instance HasCard Article where
   image (Article (Markdown.Markdown {Markdown.metadata})) =
     return $ Map.lookup "featuredImage" metadata
   title = return . Markdown.title . Article.getMarkdown
-  urlPath = fmap (\t -> "/articles/" ++ t ++ ".html") . title
+  urlPath (Article markdown) = return $ Markdown.path markdown <.> "html"
 
 instance HasCard Page where
   cardType _ = return "website"
@@ -68,7 +69,7 @@ instance HasCard Page where
   image (Page (Markdown.Markdown {Markdown.metadata})) =
     return $ Map.lookup "featuredImage" metadata
   title = return . Markdown.title . Page.getMarkdown
-  urlPath = fmap (\t -> "/pages/" ++ t ++ ".html") . title
+  urlPath (Page markdown) = return $ Markdown.path markdown <.> "html"
 
 instance HasCard ArticlesList where
   cardType _ = return "website"
@@ -76,6 +77,6 @@ instance HasCard ArticlesList where
   image _ = return Nothing
   title (ArticlesList {collection}) = Collection.title collection
   urlPath al@(ArticlesList {collection}) =
-    return $ maybe "" ('/':) (tag collection) ++ file
+    return $ maybe "" id (tag collection) </> file
     where
-      file = '/' : (if full al then "all" else "index") ++ ".html"
+      file = (if full al then "all" else "index") <.> ".html"

src/HTML.hs

@@ -29,8 +29,8 @@ articlesLists collection@(Collection {basePath}) = [
 
 generateArticles :: [Article] -> ReaderT Blog IO ()
 generateArticles = mapM_ $ \article -> do
-  baseDir <- (</>) <$> (asks $path.$root) <*> (asks $path.$articlesPath)
+  let relativePath = Markdown.path (Article.getMarkdown article) <.> "html"
-  let filePath = baseDir </> key (Article.getMarkdown article) <.> "html"
+  filePath <- (</> relativePath) <$> (asks $Blog.path.$root)
   (renderTextT $ htmlDocument article) >>= liftIO . TextIO.writeFile filePath
 
 generateCollection :: Collection -> ReaderT Blog IO ()

src/Markdown.hs

@@ -4,7 +4,6 @@ module Markdown (
     , Metadata
     , at
     , getKey
-    , parser
   ) where
 
 import Control.Applicative ((<|>))
@@ -15,24 +14,27 @@ import Text.ParserCombinators.Parsec (
      ParseError, Parser
     , (<?>)
     , anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
-    , oneOf, option, parse, skipMany, sourceLine, string, try
+    , oneOf, option, parse, skipMany, sourceLine, sourceName, string, try
   )
 
 type Metadata = Map String String
 data Markdown = Markdown {
       key :: String
+    , path :: String
     , title :: String
     , metadata :: Metadata
     , bodyOffset :: Int
     , body :: [String]
   }
 
-parser :: String -> Parser Markdown
+parser :: Parser Markdown
-parser key = do
+parser = do
   (title, metadata) <- skipMany eol *> (headerP <|> reverseHeaderP)
   bodyOffset <- skipMany eol *> (pred . sourceLine <$> getPosition)
   body <- lines <$> many anyChar <* eof
-  return $ Markdown {key, title, metadata, bodyOffset, body}
+  inputFile <- sourceName <$> getPosition
+  let (key, path) = (getKey inputFile, dropExtension inputFile)
+  return $ Markdown {key, path, title, metadata, bodyOffset, body}
   where
     headerP = (,) <$> titleP <* many eol <*> metadataP
     reverseHeaderP = flip (,) <$> metadataP  <* many eol<*> titleP
@@ -67,4 +69,4 @@ getKey :: FilePath -> String
 getKey = dropExtension . takeFileName
 
 at :: FilePath -> IO (Either ParseError Markdown)
-at filePath = parse (parser (getKey filePath)) filePath <$> readFile filePath
+at filePath = parse parser filePath <$> readFile filePath

src/RSS.hs

@@ -8,7 +8,7 @@ module RSS (
 import Article (Article(..))
 import ArticlesList (ArticlesList(..), getArticles)
 import qualified ArticlesList (description)
-import Blog (Blog(..), Path(..), Renderer, URL(..))
+import Blog (Blog(urls), Renderer, URL(..))
 import Collection (Collection(..), getAll)
 import qualified Collection (title)
 import Control.Monad.IO.Class (MonadIO(..))
@@ -58,13 +58,12 @@ pubDate_ :: Term arg result => arg -> result
 pubDate_ = term "pubDate"
 
 articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
-articleItem siteURL (Article (Markdown {key, metadata, title})) =
+articleItem siteURL (Article (Markdown {path, metadata, title})) =
   item_ $ do
     title_ $ toHtml title
-    link_ . toHtml =<< link <$> (asks $path.$articlesPath)
+    link_ $ toHtml (siteURL </> path <.> "html")
     pubDate_ . toHtml . rfc822Date $ metadata ! "date"
   where
-    link path = siteURL </> path </> key <.> "html"
     rfc822Date =
         formatTime defaultTimeLocale rfc822DateFormat
       . posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)