module ConfCrypt.Template ( renderTemplate ) where import ConfCrypt.Types (Parameter(..), typeToOutputString) import Control.Monad (void) import Data.Maybe (maybe) import Data.Text (Text, pack) import Text.Megaparsec (Parsec, (<|>), anySingle, try, noneOf, many, some, parse, errorBundlePretty, ShowErrorComponent) import Text.Megaparsec.Char (string') renderTemplate :: Text -> Either Text (Parameter -> Text) renderTemplate template = case parse parseTemplate "" template of Left err -> Left . pack $ errorBundlePretty err Right parsed -> Right (\param -> foldMap (replaceVars param) parsed) where replaceVars p (Text_ t) = t replaceVars p (Variable_ Name) = paramName p replaceVars p (Variable_ Value) = paramValue p replaceVars p (Variable_ Type) = maybe "" typeToOutputString $ paramType p type Parser = Parsec TemplateParseError Text newtype TemplateParseError = TemplateParseError Text deriving (Show, Ord, Eq, ShowErrorComponent) parseTemplate :: Parser [Template] parseTemplate = many (txt <|> var) where var = Variable_ <$> parseVariable txt = Text_ <$> parseLiteral data Template = Variable_ Variable | Text_ Text deriving Show parseLiteral :: Parser Text parseLiteral = "%" <$ try (string' "%%") <|> pack <$> some (noneOf ("%" :: String)) data Variable = Name | Value | Type deriving Show parseVariable :: Parser Variable parseVariable = Name <$ try (string' "%n") <|> Value <$ try (string' "%v") <|> Type <$ try (string' "%t") <|> unrecognized where unrecognized = do void $ string' "%" invalid <- anySingle fail $ "Unrecognized variable " ++ [invalid]