{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Headroom.HeaderFn
( runHeaderFn
, configuredHeaderFn
, postProcessHeader
, ConfiguredEnv(..)
, mkConfiguredEnv
, ceCurrentYearL
, ceHeaderFnConfigsL
, ceUpdateCopyrightModeL
)
where
import Headroom.Configuration.Types ( CtHeaderFnConfigs
, HeaderFnConfig(..)
, HeaderFnConfigs(..)
, hfcConfigL
, hfcsUpdateCopyrightL
, uccSelectedAuthorsL
)
import Headroom.Data.Has ( Has(..) )
import Headroom.Data.Lens ( suffixLenses )
import Headroom.HeaderFn.Types ( HeaderFn(..) )
import Headroom.HeaderFn.UpdateCopyright
( SelectedAuthors(..)
, UpdateCopyrightMode(..)
, updateCopyright
)
import Headroom.Meta ( TemplateType )
import Headroom.Template ( Template(..) )
import Headroom.Types ( CurrentYear(..) )
import Headroom.Variables.Types ( Variables(..) )
import Lens.Micro ( traverseOf )
import RIO
runHeaderFn :: HeaderFn env
-> env
-> Text
-> Text
(HeaderFn 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
configuredHeaderFn :: (Has CurrentYear env, Has UpdateCopyrightMode env)
=> CtHeaderFnConfigs
-> HeaderFn env
HeaderFnConfigs {HeaderFnConfig 'Complete UpdateCopyrightConfig
hfcsUpdateCopyright :: forall (p1 :: Phase).
HeaderFnConfigs p1 -> HeaderFnConfig p1 UpdateCopyrightConfig
hfcsUpdateCopyright :: HeaderFnConfig 'Complete UpdateCopyrightConfig
..} = [HeaderFn env] -> HeaderFn env
forall a. Monoid a => [a] -> a
mconcat
[HeaderFnConfig 'Complete UpdateCopyrightConfig
-> HeaderFn env -> HeaderFn env
forall p (p :: Phase) (c :: Phase -> *).
(Monoid p, (p ::: Bool) ~ Bool) =>
HeaderFnConfig p c -> p -> p
ifEnabled HeaderFnConfig 'Complete UpdateCopyrightConfig
hfcsUpdateCopyright HeaderFn env
forall env.
(Has CurrentYear env, Has UpdateCopyrightMode env) =>
HeaderFn env
updateCopyright]
where
ifEnabled :: HeaderFnConfig p c -> p -> p
ifEnabled HeaderFnConfig {c p
p ::: Bool
hfcConfig :: forall (p :: Phase) (c1 :: Phase -> *). HeaderFnConfig p c1 -> c1 p
hfcEnabled :: forall (p :: Phase) (c1 :: Phase -> *).
HeaderFnConfig p c1 -> p ::: Bool
hfcConfig :: c p
hfcEnabled :: p ::: Bool
..} p
fn | Bool
p ::: Bool
hfcEnabled = p
fn
| Bool
otherwise = p
forall a. Monoid a => a
mempty
postProcessHeader :: ConfiguredEnv
-> Text
-> Text
ConfiguredEnv
env = HeaderFn ConfiguredEnv -> ConfiguredEnv -> Text -> Text
forall env. HeaderFn env -> env -> Text -> Text
runHeaderFn (CtHeaderFnConfigs -> HeaderFn ConfiguredEnv
forall env.
(Has CurrentYear env, Has UpdateCopyrightMode env) =>
CtHeaderFnConfigs -> HeaderFn env
configuredHeaderFn CtHeaderFnConfigs
configs) ConfiguredEnv
env
where configs :: CtHeaderFnConfigs
configs = ConfiguredEnv -> CtHeaderFnConfigs
ceHeaderFnConfigs ConfiguredEnv
env
data ConfiguredEnv = ConfiguredEnv
{ ConfiguredEnv -> CurrentYear
ceCurrentYear :: !CurrentYear
, :: !CtHeaderFnConfigs
, 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)
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 :: (MonadThrow m)
=> CurrentYear
-> Variables
-> CtHeaderFnConfigs
-> m ConfiguredEnv
mkConfiguredEnv :: CurrentYear -> Variables -> CtHeaderFnConfigs -> m ConfiguredEnv
mkConfiguredEnv CurrentYear
ceCurrentYear Variables
vars CtHeaderFnConfigs
configs = do
CtHeaderFnConfigs
ceHeaderFnConfigs <- Variables -> CtHeaderFnConfigs -> m CtHeaderFnConfigs
forall (m :: * -> *).
MonadThrow m =>
Variables -> CtHeaderFnConfigs -> m CtHeaderFnConfigs
compileTemplates Variables
vars CtHeaderFnConfigs
configs
let ceUpdateCopyrightMode :: UpdateCopyrightMode
ceUpdateCopyrightMode = CtHeaderFnConfigs -> UpdateCopyrightMode
mode CtHeaderFnConfigs
ceHeaderFnConfigs
ConfiguredEnv -> m ConfiguredEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfiguredEnv :: CurrentYear
-> CtHeaderFnConfigs -> UpdateCopyrightMode -> ConfiguredEnv
ConfiguredEnv { CurrentYear
UpdateCopyrightMode
CtHeaderFnConfigs
ceUpdateCopyrightMode :: UpdateCopyrightMode
ceHeaderFnConfigs :: CtHeaderFnConfigs
ceCurrentYear :: CurrentYear
ceUpdateCopyrightMode :: UpdateCopyrightMode
ceCurrentYear :: CurrentYear
ceHeaderFnConfigs :: CtHeaderFnConfigs
.. }
where
authorsL :: ((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p2)
authorsL = (HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig))
-> HeaderFnConfigs p2
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p2)
forall (p1 :: Phase) (p2 :: Phase).
Lens
(HeaderFnConfigs p1)
(HeaderFnConfigs p2)
(HeaderFnConfig p1 UpdateCopyrightConfig)
(HeaderFnConfig p2 UpdateCopyrightConfig)
hfcsUpdateCopyrightL ((HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig))
-> HeaderFnConfigs p2
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p2))
-> (((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig))
-> ((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p2
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p2))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig)
forall (p :: Phase) (c1 :: Phase -> *) (c2 :: Phase -> *).
Lens (HeaderFnConfig p c1) (HeaderFnConfig p c2) (c1 p) (c2 p)
hfcConfigL ((UpdateCopyrightConfig p2
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p2))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig))
-> (((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p2
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p2))
-> ((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> Const
(Maybe (NonEmpty Text)) (HeaderFnConfig p2 UpdateCopyrightConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p2
-> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p2)
forall (p1 :: Phase) (p2 :: Phase).
Lens
(UpdateCopyrightConfig p1)
(UpdateCopyrightConfig p2)
(p1 ::: Maybe (NonEmpty Text))
(p2 ::: Maybe (NonEmpty Text))
uccSelectedAuthorsL
mode :: CtHeaderFnConfigs -> UpdateCopyrightMode
mode CtHeaderFnConfigs
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)
(CtHeaderFnConfigs
configs' CtHeaderFnConfigs
-> Getting
(Maybe (NonEmpty Text)) CtHeaderFnConfigs (Maybe (NonEmpty Text))
-> Maybe (NonEmpty Text)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (NonEmpty Text)) CtHeaderFnConfigs (Maybe (NonEmpty Text))
forall (p2 :: Phase).
((p2 ::: Maybe (NonEmpty Text))
-> Const (Maybe (NonEmpty Text)) (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p2)
authorsL)
compileTemplates :: (MonadThrow m)
=> Variables
-> CtHeaderFnConfigs
-> m CtHeaderFnConfigs
compileTemplates :: Variables -> CtHeaderFnConfigs -> m CtHeaderFnConfigs
compileTemplates Variables
vars CtHeaderFnConfigs
configs = CtHeaderFnConfigs
configs CtHeaderFnConfigs
-> (CtHeaderFnConfigs -> m CtHeaderFnConfigs)
-> m CtHeaderFnConfigs
forall a b. a -> (a -> b) -> b
& LensLike
m
CtHeaderFnConfigs
CtHeaderFnConfigs
(Maybe (NonEmpty Text))
(Maybe (NonEmpty Text))
-> LensLike
m
CtHeaderFnConfigs
CtHeaderFnConfigs
(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
CtHeaderFnConfigs
CtHeaderFnConfigs
(Maybe (NonEmpty Text))
(Maybe (NonEmpty Text))
forall (p2 :: Phase).
((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2 -> m (HeaderFnConfigs p2)
authorsL Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text))
compileAuthors'
where
authorsL :: ((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2 -> m (HeaderFnConfigs p2)
authorsL = (HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig))
-> HeaderFnConfigs p2 -> m (HeaderFnConfigs p2)
forall (p1 :: Phase) (p2 :: Phase).
Lens
(HeaderFnConfigs p1)
(HeaderFnConfigs p2)
(HeaderFnConfig p1 UpdateCopyrightConfig)
(HeaderFnConfig p2 UpdateCopyrightConfig)
hfcsUpdateCopyrightL ((HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig))
-> HeaderFnConfigs p2 -> m (HeaderFnConfigs p2))
-> (((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig))
-> ((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p2
-> m (HeaderFnConfigs p2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p2 -> m (UpdateCopyrightConfig p2))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig)
forall (p :: Phase) (c1 :: Phase -> *) (c2 :: Phase -> *).
Lens (HeaderFnConfig p c1) (HeaderFnConfig p c2) (c1 p) (c2 p)
hfcConfigL ((UpdateCopyrightConfig p2 -> m (UpdateCopyrightConfig p2))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig))
-> (((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p2 -> m (UpdateCopyrightConfig p2))
-> ((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> HeaderFnConfig p2 UpdateCopyrightConfig
-> m (HeaderFnConfig p2 UpdateCopyrightConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p2 ::: Maybe (NonEmpty Text))
-> m (p2 ::: Maybe (NonEmpty Text)))
-> UpdateCopyrightConfig p2 -> m (UpdateCopyrightConfig p2)
forall (p1 :: Phase) (p2 :: Phase).
Lens
(UpdateCopyrightConfig p1)
(UpdateCopyrightConfig p2)
(p1 ::: Maybe (NonEmpty Text))
(p2 ::: 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
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
"author " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
author) Text
author
Variables -> TemplateType -> m Text
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Variables -> t -> m Text
renderTemplate Variables
vars TemplateType
parsed