{-# 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
Description : Support for /post-processors/
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

/Post-processing functions/ are basically functions that allows to post-process
already rendered /license headers/. This is useful to perform some additional
operations such as some sort of text alignment, update some parts of the header,
etc.
-}

module Headroom.PostProcess
  ( postProcess
  , configuredPostProcess
  , postProcessHeader
    -- * Environment Data Types
  , 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


-- | Runs the /post-processing function/ using the given /environment/ and text
-- of rendered /license header/ as input.
postProcess :: PostProcess env
            -- ^ /post-processor/ to run
            -> env
            -- ^ environment value
            -> Text
            -- ^ text of rendered /license header/
            -> Text
            -- ^ processed text of /license header/
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


-- | Composition of various /post-processors/, which environment is
-- based on /YAML/ configuration and which can be enabled/disabled to fit
-- end user's needs.
configuredPostProcess :: (Has CurrentYear env, Has UpdateCopyrightMode env)
                      => CtPostProcessConfigs
                      -- ^ configuration of /post-processors/
                      -> PostProcess env
                      -- ^ composed /post-processor/
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


-- | Takes already rendered /license header/ and post-process it based on the
-- given configuration.
postProcessHeader :: ConfiguredEnv
                  -- ^ configuration used to define post-processing behaviour
                  -> Text
                  -- ^ rendered text of /license header/
                  -> Text
                  -- ^ post-processed text of /license header/
postProcessHeader :: ConfiguredEnv -> Text -> Text
postProcessHeader 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


-- | Environemnt data type for the composed /post-processor/
-- ('configuredPostProcess').
data ConfiguredEnv = ConfiguredEnv
  { ConfiguredEnv -> CurrentYear
ceCurrentYear         :: CurrentYear
  -- ^ current year
  , ConfiguredEnv -> CtPostProcessConfigs
cePostProcessConfigs  :: CtPostProcessConfigs
  -- ^ configuration of /post-processor/
  , ConfiguredEnv -> UpdateCopyrightMode
ceUpdateCopyrightMode :: UpdateCopyrightMode
  -- ^ mode used by the 'updateCopyright' /post-processor/
  }
  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


-- | Constructor function for 'ConfiguredEnv' data type. This function takes
-- 'Variables' as argument, because it performs template compilation on
-- selected fields of 'CtPostProcessConfigs'.
mkConfiguredEnv :: forall a m
                 . (Template a, MonadThrow m)
                => CurrentYear
                -- ^ current year
                -> Variables
                -- ^ template variables
                -> CtPostProcessConfigs
                -- ^ configuration for /post-processors/
                -> m ConfiguredEnv
                -- ^ environment data type
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)


------------------------------  PRIVATE FUNCTIONS  -----------------------------

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