{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE QuasiQuotes         #-}
{-# LANGUAGE StrictData          #-}

{-|
Module      : Headroom.Template
Description : Extensible templating support
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing interface for working with template files in extensible way.
Supported template is represented by the 'Template' /type class/.
-}

module Headroom.Template
  ( -- * Extendable Template Support
    Template(..)
    -- * Helper Functions
  , emptyTemplate
    -- * Error Data Types
  , TemplateError(..)
  )
where

import           Data.String.Interpolate             ( iii )
import           Headroom.Template.TemplateRef       ( TemplateRef(..) )
import           Headroom.Types                      ( fromHeadroomError
                                                     , toHeadroomError
                                                     )
import           Headroom.Variables.Types            ( Variables(..) )
import           RIO
import qualified RIO.Text                           as T


-- | /Type class/ representing supported template file.
class Template a where

  -- | Returns list of supported file extensions for this template type.
  templateExtensions :: NonEmpty Text
                     -- ^ list of supported file extensions


  -- | Parses template from given raw text.
  parseTemplate :: MonadThrow m
                => TemplateRef
                -- ^ reference to template source
                -> Text
                -- ^ raw template text
                -> m a
                -- ^ parsed template


  -- | Renders parsed template and replaces all variables with actual values.
  renderTemplate :: MonadThrow m
                 => Variables
                 -- ^ values of variables to replace
                 -> a
                 -- ^ parsed template to render
                 -> m Text
                 -- ^ rendered template text


  -- | Returns the raw text of the template, same that has been parsed by
  -- 'parseTemplate' method.
  rawTemplate :: a
              -- ^ template for which to return raw template text
              -> Text
              -- ^ raw template text


  -- | Returns a reference to template source, from which this template was
  -- loaded.
  templateRef :: a
              -- ^ template for which to return reference
              -> TemplateRef
              -- ^ template reference


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Returns empty template of selected type.
emptyTemplate :: (MonadThrow m, Template a) => m a
emptyTemplate :: m a
emptyTemplate = TemplateRef -> Text -> m a
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
TemplateRef -> Text -> m a
parseTemplate (Text -> TemplateRef
InlineRef Text
T.empty) Text
T.empty


---------------------------------  ERROR TYPES  --------------------------------

-- | Error during processing template.
data TemplateError
  = MissingVariables Text [Text] -- ^ missing variable values
  | ParseError Text              -- ^ error parsing raw template text
  deriving (TemplateError -> TemplateError -> Bool
(TemplateError -> TemplateError -> Bool)
-> (TemplateError -> TemplateError -> Bool) -> Eq TemplateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateError -> TemplateError -> Bool
$c/= :: TemplateError -> TemplateError -> Bool
== :: TemplateError -> TemplateError -> Bool
$c== :: TemplateError -> TemplateError -> Bool
Eq, Int -> TemplateError -> ShowS
[TemplateError] -> ShowS
TemplateError -> String
(Int -> TemplateError -> ShowS)
-> (TemplateError -> String)
-> ([TemplateError] -> ShowS)
-> Show TemplateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateError] -> ShowS
$cshowList :: [TemplateError] -> ShowS
show :: TemplateError -> String
$cshow :: TemplateError -> String
showsPrec :: Int -> TemplateError -> ShowS
$cshowsPrec :: Int -> TemplateError -> ShowS
Show, Typeable)


instance Exception TemplateError where
  displayException :: TemplateError -> String
displayException = TemplateError -> String
displayException'
  toException :: TemplateError -> SomeException
toException      = TemplateError -> SomeException
forall e. Exception e => e -> SomeException
toHeadroomError
  fromException :: SomeException -> Maybe TemplateError
fromException    = SomeException -> Maybe TemplateError
forall e. Exception e => SomeException -> Maybe e
fromHeadroomError


displayException' :: TemplateError -> String
displayException' :: TemplateError -> String
displayException' = \case
  MissingVariables Text
name [Text]
variables -> [iii|
      Missing variables for #{name}: #{variables}
    |]
  ParseError Text
msg -> [iii|
      Error parsing template: #{msg}
    |]