Template.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Gemoire.Template
-- Copyright   :  (c) 2024 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- A minimal template parser to use with generated static gemlogs
--
-- Gemoire uses its own template system, where the templates are plain texts
-- with special inline components. The valid components are:
--
--     * @{$pholder$}@ - A placeholder with the key @pholder@
--     * @{$pholder:default value$}@ - A placeholder with a default value
--     * @{&pholder:fallback&}@ - With a fallback /key/ to use in case @pholder@ has no value
--     * @{&pholder:fallback:default value&}@ - With a fallback /key/ and a default /value/
--     * @{# comment! #}@ - An unrendered comment
--     * @{\ constant \}@ - An unevaluated block, akin to escaping things inside it
--
-- All inline components can be multiline in any way, including placeholder keys.
-- The arguments can also be surrounded by any amount of whitespace, which will
-- get stripped /except/ when specifying a default value.
--
-- The surrounding braces are parsed in order, so the components /can not/ be nested.
module Gemoire.Template
    ( -- * Formatting
      template
    , format

      -- * Types
    , Values
    , Template
    , Component (..)

      -- * Utility
    , vempty
    , vlist
    ) where

import Control.Arrow (second, (&&&), (***))
import Control.Monad (join)
import Data.Bool (bool)
import Data.HashMap.Strict (HashMap, empty, findWithDefault, fromList, (!?))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T

-- | A basic template, in the form of a string of either plain text
-- blocks or meaningful components
type Template = [Either Text Component]

-- | A parsed template component with a special meaning
data Component
    = -- | A placeholder with an optional default value
      Placeholder !Text !(Maybe Text)
    | -- | A placeholder with another key to fallback to if the first one
      -- has no value, and an optional default value
      Fallback !Text !Text !(Maybe Text)
    deriving (Eq, Show)

-- | An unordered `HashMap' of formatting keys and values
type Values = HashMap Text Text

-- | Construct a `Template' from the given `Text'.
--
-- See the module description for how the templates are formed.
--
-- The whitespaces in the arguments will be stripped /except/ for default values.
--
-- The surrounding braces are parsed in order, so the components /can not/ be nested.
template :: Text -> Template
template text
    | T.null text = []
    | otherwise =
        let (str, ((pfx, inside), (sfx, rest))) =
                second (shiftDelimiters . join (***) (T.splitAt 1) . T.break (== '}')) $
                    T.break (== '{') text
            optstr = bool [Left str] [] $ T.null str
         in case (pfx, sfx) of
                ("{$", "$}") ->
                    let (name, def) = second (T.stripPrefix ":") $ T.break (== ':') inside
                     in optstr <> [Right $ Placeholder (T.strip name) def] <> template rest
                ("{&", "&}") ->
                    let (name, (fback, def)) =
                            second (second (T.stripPrefix ":") . T.break (== ':') . T.drop 1) $
                                T.break (== ':') inside
                     in optstr <> [Right $ Fallback (T.strip name) (T.strip fback) def] <> template rest
                ("{#", _) ->
                    let (_, end) = second (T.drop 2) $ T.breakOn "#}" (inside <> sfx <> rest)
                     in optstr <> template end
                ("{\\", _) ->
                    let (constant, end) = second (T.drop 2) $ T.breakOn "\\}" (inside <> sfx <> rest)
                     in optstr <> [Left constant] <> template end
                _ -> [Left (str <> pfx)] <> template (inside <> sfx)
  where
    shiftDelimiters :: ((Text, Text), (Text, Text)) -> ((Text, Text), (Text, Text))
    shiftDelimiters ((pfx, pholder), (sfx, rest)) =
        ( (((pfx <>) . T.take 1) &&& (T.drop 1 . T.dropEnd 1)) pholder
        , (T.takeEnd 1 pholder <> sfx, rest)
        )

-- | Format the `Template' using given `Values' map.
format :: Template -> Values -> Text
format [] _ = ""
format (p : ps) vars =
    ( case p of
        Left text -> text
        Right (Placeholder key def) -> findWithDefault (fromMaybe "" def) key vars
        Right (Fallback key1 key2 def) ->
            findWithDefault (fromMaybe (fromMaybe "" def) (vars !? key2)) key1 vars
    )
        <> format ps vars

-- | An empty `Values' map for convenience
vempty :: Values
vempty = empty

-- | `fromList' for convenience
vlist :: [(Text, Text)] -> Values
vlist = fromList