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

{-|
Module      : Headroom.Variables
Description : Support for template variables
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module containing costructor and useful functions for the 'Variables' data type.
-}

module Headroom.Variables
  ( -- * Constructing Variables
    mkVariables
  , dynamicVariables
    -- * Parsing Variables
  , parseVariables
    -- * Processing Variables
  , compileVariables
  )
where

import           Headroom.Meta                  ( TemplateType )
import           Headroom.Template              ( Template(..) )
import           Headroom.Types                 ( CurrentYear(..)
                                                , fromHeadroomError
                                                , toHeadroomError
                                                )
import           Headroom.Variables.Types       ( Variables(..) )
import           RIO
import qualified RIO.HashMap                   as HM
import qualified RIO.Text                      as T


-- | Constructor function for 'Variables' data type.
--
-- >>> mkVariables [("key1", "value1")]
-- Variables (fromList [("key1","value1")])
mkVariables :: [(Text, Text)]
            -- ^ pairs of /key-value/
            -> Variables
            -- ^ constructed variables
mkVariables :: [(Text, Text)] -> Variables
mkVariables = HashMap Text Text -> Variables
Variables (HashMap Text Text -> Variables)
-> ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)]
-> Variables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList


-- | /Dynamic variables/ that are common for all parsed files.
--
-- * @___current_year__@ - current year
dynamicVariables :: CurrentYear
                 -- ^ current year
                 -> Variables
                 -- ^ map of /dynamic variables/
dynamicVariables :: CurrentYear -> Variables
dynamicVariables (CurrentYear Integer
year) =
  [(Text, Text)] -> Variables
mkVariables [(Text
"_current_year", Integer -> Text
forall a. Show a => a -> Text
tshow Integer
year)]


-- | Parses variables from raw input in @key=value@ format.
--
-- >>> parseVariables ["key1=value1"]
-- Variables (fromList [("key1","value1")])
parseVariables :: MonadThrow m
               => [Text]
               -- ^ list of raw variables
               -> m Variables
               -- ^ parsed variables
parseVariables :: [Text] -> m Variables
parseVariables [Text]
variables = ([(Text, Text)] -> Variables) -> m [(Text, Text)] -> m Variables
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> Variables
mkVariables ((Text -> m (Text, Text)) -> [Text] -> m [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> m (Text, Text)
forall (f :: * -> *). MonadThrow f => Text -> f (Text, Text)
parse [Text]
variables)
 where
  parse :: Text -> f (Text, Text)
parse Text
input = case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
input of
    [Text
key, Text
value] -> (Text, Text) -> f (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
value)
    [Text]
_            -> VariablesError -> f (Text, Text)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (VariablesError -> f (Text, Text))
-> VariablesError -> f (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> VariablesError
InvalidVariable Text
input


-- | Compiles variable values that are itself mini-templates, where their
-- variables will be substituted by other variable values (if possible).
-- Note that recursive variable reference and/or cyclic references are not
-- supported.
--
-- >>> compileVariables $ mkVariables [("name", "John"), ("msg", "Hello, {{ name }}")]
-- Variables (fromList [("msg","Hello, John"),("name","John")])
compileVariables :: (MonadThrow m)
                 => Variables
                 -- ^ input variables to compile
                 -> m Variables
                 -- ^ compiled variables
compileVariables :: Variables -> m Variables
compileVariables variables :: Variables
variables@(Variables HashMap Text Text
kvs) = do
  [(Text, Text)]
compiled <- ((Text, Text) -> m (Text, Text))
-> [(Text, Text)] -> m [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Text) -> m (Text, Text)
forall (m :: * -> *).
MonadThrow m =>
(Text, Text) -> m (Text, Text)
compileVariable (HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Text
kvs)
  Variables -> m Variables
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Variables -> m Variables) -> Variables -> m Variables
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Variables
mkVariables [(Text, Text)]
compiled
 where
  compileVariable :: (Text, Text) -> m (Text, Text)
compileVariable (Text
key, Text
value) = do
    TemplateType
parsed   <- Maybe Text -> Text -> m TemplateType
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Maybe Text -> Text -> m t
parseTemplate @TemplateType (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key) Text
value
    Text
rendered <- Variables -> TemplateType -> m Text
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Variables -> t -> m Text
renderTemplate Variables
variables TemplateType
parsed
    (Text, Text) -> m (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
rendered)


---------------------------------  Error Types  --------------------------------

-- | Exception specific to the "Headroom.Variables" module.
data VariablesError = InvalidVariable Text
                    -- ^ invalid variable input (as @key=value@)
  deriving (VariablesError -> VariablesError -> Bool
(VariablesError -> VariablesError -> Bool)
-> (VariablesError -> VariablesError -> Bool) -> Eq VariablesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariablesError -> VariablesError -> Bool
$c/= :: VariablesError -> VariablesError -> Bool
== :: VariablesError -> VariablesError -> Bool
$c== :: VariablesError -> VariablesError -> Bool
Eq, Int -> VariablesError -> ShowS
[VariablesError] -> ShowS
VariablesError -> String
(Int -> VariablesError -> ShowS)
-> (VariablesError -> String)
-> ([VariablesError] -> ShowS)
-> Show VariablesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariablesError] -> ShowS
$cshowList :: [VariablesError] -> ShowS
show :: VariablesError -> String
$cshow :: VariablesError -> String
showsPrec :: Int -> VariablesError -> ShowS
$cshowsPrec :: Int -> VariablesError -> ShowS
Show)


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


displayException' :: VariablesError -> String
displayException' :: VariablesError -> String
displayException' = Text -> String
T.unpack (Text -> String)
-> (VariablesError -> Text) -> VariablesError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  InvalidVariable Text
raw -> (Text
"Cannot parse variable key=value from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw)