From 94e323d715503266a3782913010fa9552e9c956c Mon Sep 17 00:00:00 2001 From: Tissevert Date: Tue, 27 Aug 2019 13:23:17 +0200 Subject: [PATCH] Simplify Blog.Wording module and change conditional template blocks syntax a tiny bit --- CHANGELOG.md | 6 +++ doc/Template-variables.md | 4 +- hablo.cabal | 2 +- share/defaultWording.conf | 2 +- share/js/template.js | 2 +- src/ArticlesList.hs | 21 ++++----- src/Blog.hs | 4 +- src/Blog/Wording.hs | 92 ++++++++++++++++----------------------- src/Dom.hs | 8 ++-- 9 files changed, 66 insertions(+), 75 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4f549b3..6b66129 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/doc/Template-variables.md b/doc/Template-variables.md index 5ad041a..270b753 100644 --- a/doc/Template-variables.md +++ b/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 », otherwise it will directly start with «on ». 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. diff --git a/hablo.cabal b/hablo.cabal index 7ba852a..f1ad46c 100644 --- a/hablo.cabal +++ b/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 diff --git a/share/defaultWording.conf b/share/defaultWording.conf index cca2ff7..0fd4281 100644 --- a/share/defaultWording.conf +++ b/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 diff --git a/share/js/template.js b/share/js/template.js index aed435a..1bac571 100644 --- a/share/js/template.js +++ b/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, diff --git a/src/ArticlesList.hs b/src/ArticlesList.hs index 0a5ead9..0b71b6a 100644 --- a/src/ArticlesList.hs +++ b/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)] + + + + diff --git a/src/Blog.hs b/src/Blog.hs index 9fa0e22..d7d0b96 100644 --- a/src/Blog.hs +++ b/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) diff --git a/src/Blog/Wording.hs b/src/Blog/Wording.hs index 9de30ab..e20e2d9 100644 --- a/src/Blog/Wording.hs +++ b/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) diff --git a/src/Dom.hs b/src/Dom.hs index 61067ae..cdbeebc 100644 --- a/src/Dom.hs +++ b/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