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

{-|
Module      : Headroom.Template
Description : Generic representation of supported template type
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing generic representation of supported template type, using
the 'Template' /type class/.
-}

module Headroom.Template
  ( Template(..)
  , TemplateError(..)
  )
where

import           Headroom.Types                 ( fromHeadroomError
                                                , toHeadroomError
                                                )
import           Headroom.Variables.Types       ( Variables(..) )
import           RIO
import qualified RIO.Text                      as T


-- | Type class representing generic license header template support.
class Template t 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
                => Maybe Text
                -- ^ name of the template (optional)
                -> Text
                -- ^ raw template text
                -> m t
                -- ^ parsed template


  -- | Renders parsed template and replaces all variables with actual values.
  renderTemplate :: MonadThrow m
                 => Variables
                 -- ^ values of variables to replace
                 -> t
                 -- ^ 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 :: t
              -- ^ template for which to return raw template text
              -> Text
              -- ^ raw template text


---------------------------------  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' = Text -> String
T.unpack (Text -> String)
-> (TemplateError -> Text) -> TemplateError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  MissingVariables Text
name [Text]
variables -> Text -> [Text] -> Text
forall a. Show a => Text -> a -> Text
missingVariables Text
name [Text]
variables
  ParseError Text
msg                  -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
parseError Text
msg
 where
  missingVariables :: Text -> a -> Text
missingVariables Text
name a
variables =
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Missing variables for '", Text
name, Text
"': ", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
variables]
  parseError :: a -> a
parseError a
msg = a
"Error parsing template: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
msg