{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}

{-|
Module      : Headroom.HeaderFn
Description : Support for /license header functions/
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

/License header 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.HeaderFn
  ( runHeaderFn
  , configuredHeaderFn
  , postProcessHeader
    -- * Environment Data Types
  , ConfiguredEnv(..)
  , mkConfiguredEnv
  )
where

import           Headroom.Configuration.Types        ( CtHeaderFnConfigs
                                                     , HeaderFnConfig(..)
                                                     , HeaderFnConfigs(..)
                                                     , UpdateCopyrightConfig(..)
                                                     )
import           Headroom.Data.Has                   ( Has(..) )
import           Headroom.Data.Lens                  ( suffixLenses
                                                     , suffixLensesFor
                                                     )
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


suffixLenses ''HeaderFnConfigs
suffixLenses ''UpdateCopyrightConfig
suffixLensesFor ["hfcConfig"] ''HeaderFnConfig


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


-- | Composition of various /license header functions/, which environment is
-- based on /YAML/ configuration and which can be enabled/disabled to fit
-- end user's needs.
configuredHeaderFn :: (Has CurrentYear env, Has UpdateCopyrightMode env)
                   => CtHeaderFnConfigs
                   -- ^ configuration of /license header functions/
                   -> HeaderFn env
                   -- ^ composed /license header function/
configuredHeaderFn :: CtHeaderFnConfigs -> HeaderFn env
configuredHeaderFn HeaderFnConfigs {HeaderFnConfig 'Complete UpdateCopyrightConfig
hfcsUpdateCopyright :: forall (p :: Phase).
HeaderFnConfigs p -> HeaderFnConfig p 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) (c :: Phase -> *). HeaderFnConfig p c -> c p
hfcEnabled :: forall (p :: Phase) (c :: Phase -> *).
HeaderFnConfig p c -> 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


-- | 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 = 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


-- | Environemnt data type for the composed /license header function/
-- ('configuredHeaderFn').
data ConfiguredEnv = ConfiguredEnv
  { ConfiguredEnv -> CurrentYear
ceCurrentYear         :: !CurrentYear
  -- ^ current year
  , ConfiguredEnv -> CtHeaderFnConfigs
ceHeaderFnConfigs     :: !CtHeaderFnConfigs
  -- ^ configuration of /license header functions/
  , ConfiguredEnv -> UpdateCopyrightMode
ceUpdateCopyrightMode :: !UpdateCopyrightMode
  -- ^ mode used by the 'updateCopyright' /license header function/
  }
  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 'CtHeaderFnConfigs'.
mkConfiguredEnv :: (MonadThrow m)
                => CurrentYear
                -- ^ current year
                -> Variables
                -- ^ template variables
                -> CtHeaderFnConfigs
                -- ^ configuration of /license header functions/
                -> m ConfiguredEnv
                -- ^ environment data type
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 :: ((p ::: Maybe (NonEmpty Text))
 -> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p)
authorsL = (HeaderFnConfig p UpdateCopyrightConfig
 -> Const
      (Maybe (NonEmpty Text)) (HeaderFnConfig p UpdateCopyrightConfig))
-> HeaderFnConfigs p
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p)
forall (p :: Phase) (p :: Phase).
Lens
  (HeaderFnConfigs p)
  (HeaderFnConfigs p)
  (HeaderFnConfig p UpdateCopyrightConfig)
  (HeaderFnConfig p UpdateCopyrightConfig)
hfcsUpdateCopyrightL ((HeaderFnConfig p UpdateCopyrightConfig
  -> Const
       (Maybe (NonEmpty Text)) (HeaderFnConfig p UpdateCopyrightConfig))
 -> HeaderFnConfigs p
 -> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p))
-> (((p ::: Maybe (NonEmpty Text))
     -> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
    -> HeaderFnConfig p UpdateCopyrightConfig
    -> Const
         (Maybe (NonEmpty Text)) (HeaderFnConfig p UpdateCopyrightConfig))
-> ((p ::: Maybe (NonEmpty Text))
    -> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p
 -> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p))
-> HeaderFnConfig p UpdateCopyrightConfig
-> Const
     (Maybe (NonEmpty Text)) (HeaderFnConfig p UpdateCopyrightConfig)
forall (p :: Phase) (c :: Phase -> *) (c :: Phase -> *).
Lens (HeaderFnConfig p c) (HeaderFnConfig p c) (c p) (c p)
hfcConfigL ((UpdateCopyrightConfig p
  -> Const (Maybe (NonEmpty Text)) (UpdateCopyrightConfig p))
 -> HeaderFnConfig p UpdateCopyrightConfig
 -> Const
      (Maybe (NonEmpty Text)) (HeaderFnConfig 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)))
-> HeaderFnConfig p UpdateCopyrightConfig
-> Const
     (Maybe (NonEmpty Text)) (HeaderFnConfig 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 :: 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 (p :: Phase).
((p ::: Maybe (NonEmpty Text))
 -> Const (Maybe (NonEmpty Text)) (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p
-> Const (Maybe (NonEmpty Text)) (HeaderFnConfigs p)
authorsL)


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

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 (p :: Phase).
((p ::: Maybe (NonEmpty Text)) -> m (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p -> m (HeaderFnConfigs p)
authorsL Maybe (NonEmpty Text) -> m (Maybe (NonEmpty Text))
compileAuthors'
 where
  authorsL :: ((p ::: Maybe (NonEmpty Text)) -> m (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p -> m (HeaderFnConfigs p)
authorsL        = (HeaderFnConfig p UpdateCopyrightConfig
 -> m (HeaderFnConfig p UpdateCopyrightConfig))
-> HeaderFnConfigs p -> m (HeaderFnConfigs p)
forall (p :: Phase) (p :: Phase).
Lens
  (HeaderFnConfigs p)
  (HeaderFnConfigs p)
  (HeaderFnConfig p UpdateCopyrightConfig)
  (HeaderFnConfig p UpdateCopyrightConfig)
hfcsUpdateCopyrightL ((HeaderFnConfig p UpdateCopyrightConfig
  -> m (HeaderFnConfig p UpdateCopyrightConfig))
 -> HeaderFnConfigs p -> m (HeaderFnConfigs p))
-> (((p ::: Maybe (NonEmpty Text))
     -> m (p ::: Maybe (NonEmpty Text)))
    -> HeaderFnConfig p UpdateCopyrightConfig
    -> m (HeaderFnConfig p UpdateCopyrightConfig))
-> ((p ::: Maybe (NonEmpty Text))
    -> m (p ::: Maybe (NonEmpty Text)))
-> HeaderFnConfigs p
-> m (HeaderFnConfigs p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p))
-> HeaderFnConfig p UpdateCopyrightConfig
-> m (HeaderFnConfig p UpdateCopyrightConfig)
forall (p :: Phase) (c :: Phase -> *) (c :: Phase -> *).
Lens (HeaderFnConfig p c) (HeaderFnConfig p c) (c p) (c p)
hfcConfigL ((UpdateCopyrightConfig p -> m (UpdateCopyrightConfig p))
 -> HeaderFnConfig p UpdateCopyrightConfig
 -> m (HeaderFnConfig 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)))
-> HeaderFnConfig p UpdateCopyrightConfig
-> m (HeaderFnConfig 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
    TemplateType
parsed <- Maybe Text -> Text -> m TemplateType
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
Maybe Text -> Text -> m a
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 a (m :: * -> *).
(Template a, MonadThrow m) =>
Variables -> a -> m Text
renderTemplate Variables
vars TemplateType
parsed