Simplify Blog.Wording module and change conditional template blocks syntax a tiny bit

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Revision history for hablo
 
+## 1.0.2.0 -- 2019-08-27
+
+* Format for [conditional blocks](/Tissevert/hablo/wiki/Template-variables#metadata) changed to allow an internal simplification. This is transparent if you're creating a new blog or using the default wording but be sure to edit your wording if you're using a custom one :
+
+`${? … ?}` becomes `{? … ?}`
+
 ## 1.0.1.0 -- 2019-04-28
 
 * Print warnings about malformed Markdown articles instead of ignoring them silently

doc/Template-variables.md

@@ -60,10 +60,10 @@ The template of the text used to present the metadata associated to each article
 - `$date`
 - `$tags`
 
-As mentioned in the introduction, some of them may be null so you may want to protect the whole `metadata` template with `${? ?}` like it is done in this variable's default value :
+As mentioned in the introduction, some of them may be null so you may want to protect the whole `metadata` template with `{? ?}` like it is done in this variable's default value :
 
 ```
-metadata = ${?by ${author} ?}on ${date}${? tagged ${tags}?}
+metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
 ```
 
 If an article has an author, the rendered `metadata` string will start with «by <AUTHOR>», otherwise it will directly start with «on <SOME DATE>». Likewise all articles with tags will have their `metadata` end with « tagged » and then the list of comma-separated tags but if an article doesn't have tags, it will simply end after the date.

hablo.cabal

@@ -3,7 +3,7 @@ cabal-version:       >= 1.10
 -- For further documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hablo
-version:             1.0.1.1
+version:             1.0.2.0
 synopsis:            A minimalist static blog generator
 description:
   Hablo is a fediverse-oriented static blog generator for articles written

share/defaultWording.conf

@@ -7,5 +7,5 @@ dateFormat = en-US
 latestLink = See only latest
 latestPage = Latest articles
 latestTaggedPage = Latest articles tagged ${tag}
-metadata = ${?by ${author} ?}on ${date}${? tagged ${tags}?}
+metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
 tagsList = Tags

share/js/template.js

@@ -7,7 +7,7 @@ function Template() {
 		if(blog.wording[template] != undefined) {
 			var template = blog.wording[template];
 		}
-		template = template.replace(/\${\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
+		template = template.replace(/{\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
 		var failed = [false];
 		var result = template.replace(
 			/([^$]|^)\$(?:{(\w+)}|(\w+)\b)/g,

src/ArticlesList.hs

@@ -8,13 +8,11 @@ module ArticlesList (
   ) where
 
 import Article (Article)
-import Blog (Blog(..), Wording(..), get)
+import Blog (Blog(..), get)
+import Blog.Wording (render)
 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 ((</>))
 
 data ArticlesList = ArticlesList {
@@ -28,10 +26,13 @@ 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
-  template <- Blog.get $wording.$(if full then allTaggedPage else latestTaggedPage)
-  untagged <- Blog.get $wording.$(if full then allPage else latestPage)
-  return $ maybe untagged (toStrict . render template . tag) tagged
+pageTitle (ArticlesList {full, tagged}) = title (full, tagged) <$> Blog.get wording
   where
-    tag :: String -> Text -> Text
-    tag t = \"tag"  -> pack t
+    title (True, Nothing) = render "allPage" []
+    title (True, Just tag) = render "allTaggedPage" [("tag", pack tag)]
+    title (False, Nothing) = render "latestPage" []
+    title (False, Just tag) = render "latestTaggedPage" [("tag", pack tag)]
+    
+    
+    
+    

src/Blog.hs

@@ -4,7 +4,7 @@ module Blog (
       Blog(..)
     , Path(..)
     , Skin(..)
-    , Wording(..)
+    , Wording
     , build
     , get
   ) where
@@ -17,7 +17,7 @@ import Blog.Path (Path(..))
 import qualified Blog.Path as Path (build)
 import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
-import Blog.Wording (Wording(..))
+import Blog.Wording (Wording)
 import qualified Blog.Wording as Wording (build)
 import Control.Monad ((>=>), filterM, foldM, forM)
 import Control.Monad.Reader (MonadReader, ask)

src/Blog/Wording.hs

@@ -3,18 +3,20 @@
 module Blog.Wording (
       Wording(..)
     , build
+    , render
   ) where
 
 import Arguments (Arguments(..))
 import Control.Monad (foldM)
-import Data.Aeson (ToJSON(..), (.=), object, pairs)
+import Data.Aeson (ToJSON(..))
 import Data.List (intercalate)
 import Data.Map (Map, (!))
-import qualified Data.Map as Map (empty, fromList, map, union)
-import Data.Monoid ((<>))
+import qualified Data.Map as Map (empty, fromList, insert, keys, map, union)
 import Data.Text (Text)
 import qualified Data.Text as Text (pack, unpack)
+import Data.Text.Lazy (toStrict)
 import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
+import qualified Data.Text.Template as Template (render)
 import Paths_hablo (getDataFileName)
 import Text.ParserCombinators.Parsec (
       Parser
@@ -23,40 +25,31 @@ import Text.ParserCombinators.Parsec (
   )
 import System.Exit (die)
 
-data Wording = Wording {
-      allLink :: Text
-    , allPage :: Text
-    , allTaggedPage :: Template
-    , commentsLink :: Text
-    , commentsSection :: Text
-    , dateFormat :: Text
-    , latestLink :: Text
-    , latestPage :: Text
-    , latestTaggedPage :: Template
-    , metadata :: Text
-    , tagsList :: Text
-  }
+newtype Wording = Wording (Map String Template)
 
-keys :: [String]
-keys = [
-      "allLink", "allPage", "allTaggedPage", "commentsLink", "commentsSection"
-    , "dateFormat", "latestLink", "latestPage", "latestTaggedPage", "metadata"
-    , "tagsList"
+variables :: Map String [Text]
+variables = Map.fromList [
+      ("allLink", [])
+    , ("allPage", [])
+    , ("allTaggedPage", ["tag"])
+    , ("commentsLink", [])
+    , ("commentsSection", [])
+    , ("dateFormat", [])
+    , ("latestLink", [])
+    , ("latestPage", [])
+    , ("latestTaggedPage", ["tag"])
+    , ("metadata", ["author", "date", "tags"])
+    , ("tagsList", [])
   ]
 
-values :: [Wording -> Text]
-values = [
-      allLink, allPage, showTemplate . allTaggedPage, commentsLink, commentsSection
-    , dateFormat, latestLink, latestPage, showTemplate . latestTaggedPage
-    , metadata, tagsList
-  ]
-
-texts :: Wording -> [Text]
-texts wording = ($ wording) <$> values
 
 instance ToJSON Wording where
-  toJSON = object . zipWith (.=) (Text.pack <$> keys) . texts
-  toEncoding = pairs . foldl (<>) mempty . zipWith (.=) (Text.pack <$> keys) . texts
+  toJSON (Wording m) = toJSON (showTemplate <$> m)
+  toEncoding (Wording m) = toEncoding (showTemplate <$> m)
+
+render :: String -> [(Text, Text)] -> Wording -> Text
+render key env (Wording wMap) =
+  toStrict $ Template.render (wMap ! key) (Map.fromList env !)
 
 addWording :: Map String Text -> FilePath -> IO (Map String Text)
 addWording currentWording wordingFile = do
@@ -72,41 +65,30 @@ wordingP = Map.map Text.pack . Map.fromList <$>
     restOfLine = many $ noneOf "\r\n"
     eol = try (string "\r\n") <|> string "\r" <|> string "\n"
     skip = optional (char '#' *> restOfLine) *> eol
-    line = (,) <$> (choice (try . string <$> keys) <* equal) <*> restOfLine
+    line = (,) <$> (choice (try . string <$> Map.keys variables) <* equal) <*> restOfLine
     equal = many (char ' ') *> char '=' *> many (char ' ')
 
-checkTemplateWith :: [Text] -> String -> Map String Text -> IO Template
-checkTemplateWith variables key wording =
+makeTemplate :: String -> Map String Text -> IO Template
+makeTemplate key wording =
   let templateText = wording ! key in
-  let testEnvironment = flip lookup [(s, "") | s <- variables] in
+  let testEnvironment = flip lookup [(s, "") | s <- availableVariables] in
   case templateSafe templateText of
     Left (row, col) -> die $ syntaxError (show row) (show col)
     Right template ->
       maybe (die badTemplate) (return . const template) (renderA template testEnvironment)
   where
-    availableVariables =
-      " (available variables: " ++ intercalate ", " (Text.unpack <$> variables) ++ ")"
+    availableVariables = variables ! key
+    variablesMessage =
+      " (available variables: " ++ intercalate ", " (Text.unpack <$> availableVariables) ++ ")"
     syntaxError row col =
       "Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col 
-    badTemplate = "Invalid template for variable " ++ key ++ availableVariables
+    badTemplate = "Invalid template for variable " ++ key ++ variablesMessage
 
 build :: Arguments -> IO Wording
 build arguments = do
   defaultWording <- getDataFileName "defaultWording.conf"
   let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording]
-  wording <- foldM addWording Map.empty wordingFiles
-  allTaggedPage <- checkTemplateWith ["tag"] "allTaggedPage" wording
-  latestTaggedPage <- checkTemplateWith ["tag"] "latestTaggedPage" wording
-  return Wording {
-        allLink = wording ! "allLink"
-      , allPage = wording ! "allPage"
-      , allTaggedPage
-      , commentsLink = wording ! "commentsLink"
-      , commentsSection = wording ! "commentsSection"
-      , dateFormat = wording ! "dateFormat"
-      , latestLink = wording ! "latestLink"
-      , latestPage = wording ! "latestPage"
-      , latestTaggedPage
-      , metadata = wording ! "metadata"
-      , tagsList = wording ! "tagsList"
-    }
+  wordindMap <- foldM addWording Map.empty wordingFiles
+  Wording <$> foldM (
+      \templated key -> flip (Map.insert key) templated <$> makeTemplate key wordindMap
+    ) Map.empty (Map.keys variables)

src/Dom.hs

@@ -7,8 +7,9 @@ module Dom (
 import Article (Article(..))
 import qualified Article (preview)
 import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
-import Blog (Blog(..), Path(..), Skin(..), Wording(..))
+import Blog (Blog(..), Path(..), Skin(..))
 import qualified Blog (get)
+import Blog.Wording (render)
 import Control.Applicative ((<|>))
 import Control.Monad.Reader (ReaderT)
 import qualified Data.Map as Map (keys, lookup)
@@ -52,7 +53,8 @@ instance Page ArticlesList where
         mapM_ (article False . preview) featured
       )
     where
-      otherLink = Blog.get $wording.$(if full then latestLink else allLink)
+      link = render (if full then "latestLink" else "allLink") []
+      otherLink = Blog.get $wording.$(link)
 
 article :: Bool -> Article -> HtmlGenerator ()
 article raw (Article {key, body, title}) = do
@@ -107,7 +109,7 @@ page aPage =
       body_ (do
           maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner)
           div_ [id_ "navigator"] (do
-              h2_ =<< (Blog.get $wording.$tagsList.$toHtml)
+              h2_ =<< (Blog.get $wording.$(render "tagsList" []).$toHtml)
               ul_ . mapM_ tag . Map.keys =<< Blog.get tags
             )
           div_ [id_ "contents"] $ content aPage