{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Headroom.PostProcess
( postProcess
, configuredPostProcess
, postProcessHeader
, ConfiguredEnv(..)
, mkConfiguredEnv
)
where
import Headroom.Configuration.Types ( CtPostProcessConfigs
, PostProcessConfig(..)
, PostProcessConfigs(..)
, UpdateCopyrightConfig(..)
)
import Headroom.Data.Has ( Has(..) )
import Headroom.Data.Lens ( suffixLenses
, suffixLensesFor
)
import Headroom.PostProcess.Types ( PostProcess(..) )
import Headroom.PostProcess.UpdateCopyright
( SelectedAuthors(..)
, UpdateCopyrightMode(..)
, updateCopyright
)
import Headroom.Template ( Template(..) )
import Headroom.Template.TemplateRef ( TemplateRef(..) )
import Headroom.Types ( CurrentYear(..) )
import Headroom.Variables.Types ( Variables(..) )
import Lens.Micro ( traverseOf )
import RIO
suffixLenses ''PostProcessConfigs
suffixLenses ''UpdateCopyrightConfig
suffixLensesFor ["ppcConfig"] ''PostProcessConfig
postProcess :: PostProcess env
-> env
-> Text
-> Text
postProcess :: PostProcess env -> env -> Text -> Text
postProcess (PostProcess Text -> Reader env Text
fn) env
env Text
input = Reader env Text -> env -> Text
forall r a. Reader r a -> r -> a
runReader (Text -> Reader env Text
fn Text
input) env
env
configuredPostProcess :: (Has CurrentYear env, Has UpdateCopyrightMode env)
=> CtPostProcessConfigs
-> PostProcess env
configuredPostProcess :: CtPostProcessConfigs -> PostProcess env
configuredPostProcess PostProcessConfigs {PostProcessConfig 'Complete UpdateCopyrightConfig
ppcsUpdateCopyright :: forall (p :: Phase).
PostProcessConfigs p -> PostProcessConfig p UpdateCopyrightConfig
ppcsUpdateCopyright :: PostProcessConfig 'Complete UpdateCopyrightConfig
..} = [PostProcess env] -> PostProcess env
forall a. Monoid a => [a] -> a
mconcat
[PostProcessConfig 'Complete UpdateCopyrightConfig
-> PostProcess env -> PostProcess env
forall p (p :: Phase) (c :: Phase -> *).
(Monoid p, (p ::: Bool) ~ Bool) =>
PostProcessConfig p c -> p -> p
ifEnabled PostProcessConfig 'Complete UpdateCopyrightConfig
ppcsUpdateCopyright PostProcess env
forall env.
(Has CurrentYear env, Has UpdateCopyrightMode env) =>
PostProcess env
updateCopyright]
where
ifEnabled :: PostProcessConfig p c -> p -> p
ifEnabled PostProcessConfig {c p
p ::: Bool
ppcConfig :: forall (p :: Phase) (c :: Phase -> *). PostProcessConfig p c -> c p
ppcEnabled :: forall (p :: Phase) (c :: Phase -> *).
PostProcessConfig p c -> p ::: Bool
ppcConfig :: c p
ppcEnabled :: p ::: Bool
..} p
fn | Bool
p ::: Bool
ppcEnabled = p
fn
| Bool
otherwise = p
forall a. Monoid a => a
mempty
postProcessHeader :: ConfiguredEnv
-> Text
-> Text
ConfiguredEnv
env =
PostProcess ConfiguredEnv -> ConfiguredEnv -> Text -> Text
forall env. PostProcess env -> env -> Text -> Text
postProcess (CtPostProcessConfigs -> PostProcess ConfiguredEnv
forall env.
(Has CurrentYear env, Has UpdateCopyrightMode env) =>
CtPostProcessConfigs -> PostProcess env
configuredPostProcess (ConfiguredEnv -> CtPostProcessConfigs
cePostProcessConfigs ConfiguredEnv
env)) ConfiguredEnv
env
data ConfiguredEnv = ConfiguredEnv
{ ConfiguredEnv -> CurrentYear
ceCurrentYear :: CurrentYear
, ConfiguredEnv -> CtPostProcessConfigs
cePostProcessConfigs :: CtPostProcessConfigs
, ConfiguredEnv -> UpdateCopyrightMode
ceUpdateCopyrightMode :: UpdateCopyrightMode
}
deriving (ConfiguredEnv -> ConfiguredEnv -> Bool
(ConfiguredEnv -> ConfiguredEnv -> Bool)
-> (ConfiguredEnv -> ConfiguredEnv -> Bool) -> Eq ConfiguredEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfiguredEnv -> ConfiguredEnv -> Bool
$c/= :: ConfiguredEnv -> ConfiguredEnv -> Bool
== :: ConfiguredEnv -> ConfiguredEnv -> Bool
$c== :: ConfiguredEnv -> ConfiguredEnv -> Bool
Eq, Int -> ConfiguredEnv -> ShowS
[ConfiguredEnv] -> ShowS
ConfiguredEnv -> String
(Int -> ConfiguredEnv -> ShowS)
-> (ConfiguredEnv -> String)
-> ([ConfiguredEnv] -> ShowS)
-> Show ConfiguredEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfiguredEnv] -> ShowS
$cshowList :: [ConfiguredEnv] -> ShowS
show :: ConfiguredEnv -> String
$cshow :: ConfiguredEnv -> String
showsPrec :: Int -> ConfiguredEnv -> ShowS
$cshowsPrec :: Int -> ConfiguredEnv -> ShowS
Show)
suffixLensesFor ["ceCurrentYear", "ceUpdateCopyrightMode"] ''ConfiguredEnv
instance Has CurrentYear ConfiguredEnv where
hasLens :: (CurrentYear -> f CurrentYear) -> ConfiguredEnv -> f ConfiguredEnv
hasLens = (CurrentYear -> f CurrentYear) -> ConfiguredEnv -> f ConfiguredEnv
Lens' ConfiguredEnv CurrentYear
ceCurrentYearL
instance Has UpdateCopyrightMode ConfiguredEnv where
hasLens :: (UpdateCopyrightMode -> f UpdateCopyrightMode)
-> ConfiguredEnv -> f ConfiguredEnv
hasLens = (UpdateCopyrightMode -> f UpdateCopyrightMode)
-> ConfiguredEnv -> f ConfiguredEnv
Lens' ConfiguredEnv UpdateCopyrightMode
ceUpdateCopyrightModeL
mkConfiguredEnv :: forall a m
. (Template a, MonadThrow m)
=> CurrentYear
-> Variables
-> CtPostProcessConfigs
-> m ConfiguredEnv
mkConfiguredEnv :: CurrentYear -> Variables -> CtPostProcessConfigs -> m ConfiguredEnv
mkConfiguredEnv CurrentYear
ceCurrentYear Variables
vars CtPostProcessConfigs
configs = do
CtPostProcessConfigs
cePostProcessConfigs <- Variables -> CtPostProcessConfigs -> m CtPostProcessConfigs
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
Variables -> CtPostProcessConfigs -> m CtPostProcessConfigs
compileTemplates @a Variables
vars CtPostProcessConfigs
configs
let ceUpdateCopyrightMode :: UpdateCopyrightMode
ceUpdateCopyrightMode = CtPostProcessConfigs -> UpdateCopyrightMode
mode CtPostProcessConfigs
cePostProcessConfigs
ConfiguredEnv -> m ConfiguredEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfiguredEnv :: CurrentYear
-> CtPostProcessConfigs -> UpdateCopyrightMode -> ConfiguredEnv
ConfiguredEnv { CurrentYear
UpdateCopyrightMode
CtPostProcessConfigs
ceUpdateCopyrightMode :: UpdateCopyrightMode
cePostProcessConfigs :: CtPostProcessConfigs
ceCurrentYear :: CurrentYear
ceUpdateCopyrightMode :: UpdateCopyrightMode
ceCurrentYear :: CurrentYear
cePostProcessConfigs :: CtPostProcessConfigs
.. }
where
authorsL :: ((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p
-> Const (Maybe (NonEmpty Text)) (PostProcessConfigs p)
authorsL = (PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text))
(PostProcessConfig p UpdateCopyrightConfig))
-> PostProcessConfigs p
-> Const (Maybe (NonEmpty Text)) (PostProcessConfigs p)
forall (p :: Phase) (p :: Phase).
Lens
(PostProcessConfigs p)
(PostProcessConfigs p)
(PostProcessConfig p UpdateCopyrightConfig)
(PostProcessConfig p UpdateCopyrightConfig)
ppcsUpdateCopyrightL ((PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text))
(PostProcessConfig p UpdateCopyrightConfig))
-> PostProcessConfigs p
-> Const (Maybe (NonEmpty Text)) (PostProcessConfigs p))
-> (((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text))
(PostProcessConfig p UpdateCopyrightConfig))
-> ((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p
-> Const (Maybe (NonEmpty Text)) (PostProcessConfigs p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p))
-> PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (PostProcessConfig p UpdateCopyrightConfig)
forall (p :: Phase) (c :: Phase -> *) (c :: Phase -> *).
Lens (PostProcessConfig p c) (PostProcessConfig p c) (c p) (c p)
ppcConfigL ((UpdateCopyrightConfig p
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p))
-> PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text))
(PostProcessConfig p UpdateCopyrightConfig))
-> (((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p))
-> ((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfig p UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (PostProcessConfig p UpdateCopyrightConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p)
forall (p :: Phase) (p :: Phase).
Lens
(UpdateCopyrightConfig p)
(UpdateCopyrightConfig p)
(p ::: Maybe (NonEmpty Text))
(p ::: Maybe (NonEmpty Text))
uccSelectedAuthorsL
mode :: CtPostProcessConfigs -> UpdateCopyrightMode
mode = \CtPostProcessConfigs
configs' -> UpdateCopyrightMode
-> (NonEmpty Text -> UpdateCopyrightMode)
-> Maybe (NonEmpty Text)
-> UpdateCopyrightMode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UpdateCopyrightMode
UpdateAllAuthors
(SelectedAuthors -> UpdateCopyrightMode
UpdateSelectedAuthors (SelectedAuthors -> UpdateCopyrightMode)
-> (NonEmpty Text -> SelectedAuthors)
-> NonEmpty Text
-> UpdateCopyrightMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> SelectedAuthors
SelectedAuthors)
(CtPostProcessConfigs
configs' CtPostProcessConfigs
-> Getting
(Maybe (NonEmpty Text))
CtPostProcessConfigs
(Maybe (NonEmpty Text))
-> Maybe (NonEmpty Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (NonEmpty Text))
CtPostProcessConfigs
(Maybe (NonEmpty Text))
forall (p :: Phase).
((p ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p
-> Const (Maybe (NonEmpty Text)) (PostProcessConfigs p)
authorsL)
compileTemplates :: forall a m
. (Template a, MonadThrow m)
=> Variables
-> CtPostProcessConfigs
-> m CtPostProcessConfigs
compileTemplates :: Variables -> CtPostProcessConfigs -> m CtPostProcessConfigs
compileTemplates Variables
vars CtPostProcessConfigs
configs = CtPostProcessConfigs
configs CtPostProcessConfigs
-> (CtPostProcessConfigs -> m CtPostProcessConfigs)
-> m CtPostProcessConfigs
forall a b. a -> (a -> b) -> b
& LensLike
m
CtPostProcessConfigs
CtPostProcessConfigs
(Maybe (NonEmpty Text))
(Maybe (NonEmpty Text))
-> LensLike
m
CtPostProcessConfigs
CtPostProcessConfigs
(Maybe (NonEmpty Text))
(Maybe (NonEmpty Text))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
m
CtPostProcessConfigs
CtPostProcessConfigs
(Maybe (NonEmpty Text))
(Maybe (NonEmpty Text))
forall (p :: Phase).
((p ::: Maybe (NonEmpty Text)) -> m (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p -> m (PostProcessConfigs p)
authorsL Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text))
compileAuthors'
where
authorsL :: ((p ::: Maybe (NonEmpty Text)) -> m (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p -> m (PostProcessConfigs p)
authorsL = (PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig))
-> PostProcessConfigs p -> m (PostProcessConfigs p)
forall (p :: Phase) (p :: Phase).
Lens
(PostProcessConfigs p)
(PostProcessConfigs p)
(PostProcessConfig p UpdateCopyrightConfig)
(PostProcessConfig p UpdateCopyrightConfig)
ppcsUpdateCopyrightL ((PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig))
-> PostProcessConfigs p -> m (PostProcessConfigs p))
-> (((p ::: Maybe (NonEmpty Text))
-> m (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig))
-> ((p ::: Maybe (NonEmpty Text))
-> m (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfigs p
-> m (PostProcessConfigs p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p))
-> PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig)
forall (p :: Phase) (c :: Phase -> *) (c :: Phase -> *).
Lens (PostProcessConfig p c) (PostProcessConfig p c) (c p) (c p)
ppcConfigL ((UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p))
-> PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig))
-> (((p ::: Maybe (NonEmpty Text))
-> m (p ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p))
-> ((p ::: Maybe (NonEmpty Text))
-> m (p ::: Maybe (NonEmpty Text)))
-> PostProcessConfig p UpdateCopyrightConfig
-> m (PostProcessConfig p UpdateCopyrightConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p ::: Maybe (NonEmpty Text)) -> m (p ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p)
forall (p :: Phase) (p :: Phase).
Lens
(UpdateCopyrightConfig p)
(UpdateCopyrightConfig p)
(p ::: Maybe (NonEmpty Text))
(p ::: Maybe (NonEmpty Text))
uccSelectedAuthorsL
compileAuthors' :: Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text))
compileAuthors' = (NonEmpty Text -> m (NonEmpty Text))
-> Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((NonEmpty Text -> m (NonEmpty Text))
-> Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text)))
-> ((Text -> m Text) -> NonEmpty Text -> m (NonEmpty Text))
-> (Text -> m Text)
-> Maybe (NonEmpty Text)
-> m (Maybe (NonEmpty Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> m Text) -> NonEmpty Text -> m (NonEmpty Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> m Text)
-> Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text)))
-> (Text -> m Text)
-> Maybe (NonEmpty Text)
-> m (Maybe (NonEmpty Text))
forall a b. (a -> b) -> a -> b
$ Text -> m Text
compileAuthor
compileAuthor :: Text -> m Text
compileAuthor = \Text
author -> do
a
parsed <- TemplateRef -> Text -> m a
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
TemplateRef -> Text -> m a
parseTemplate @a (Text -> TemplateRef
InlineRef Text
author) Text
author
Variables -> a -> m Text
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
Variables -> a -> m Text
renderTemplate Variables
vars a
parsed