{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}

{-|
Module      : Headroom.Command.Run
Description : Handler for the @run@ command.
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module representing the @run@ command, the core command of /Headroom/, which is
responsible for license header management.
-}

module Headroom.Command.Run
  ( commandRun
  , loadBuiltInTemplates
  , loadTemplateFiles
  , typeOfTemplate
    -- * License Header Post-processing
  , postProcessHeader'
  , sanitizeHeader
  )
where

import           Data.Time.Calendar             ( toGregorian )
import           Data.Time.Clock                ( getCurrentTime )
import           Data.Time.Clock.POSIX          ( getPOSIXTime )
import           Data.Time.LocalTime            ( getCurrentTimeZone
                                                , localDay
                                                , utcToLocalTime
                                                )
import           Headroom.Command.Types         ( CommandRunOptions(..) )
import           Headroom.Command.Utils         ( bootstrap )
import           Headroom.Configuration         ( loadConfiguration
                                                , makeConfiguration
                                                , parseConfiguration
                                                )
import           Headroom.Configuration.Types   ( Configuration(..)
                                                , CtConfiguration
                                                , CtHeaderFnConfigs
                                                , HeaderConfig(..)
                                                , HeaderSyntax(..)
                                                , LicenseType(..)
                                                , PtConfiguration
                                                , RunMode(..)
                                                , TemplateSource(..)
                                                )
import           Headroom.Data.EnumExtra        ( EnumExtra(..) )
import           Headroom.Data.Has              ( Has(..) )
import           Headroom.Data.Lens             ( suffixLenses
                                                , suffixLensesFor
                                                )
import           Headroom.Data.TextExtra        ( mapLines )
import           Headroom.Embedded              ( defaultConfig
                                                , licenseTemplate
                                                )
import           Headroom.Ext                   ( extractTemplateMeta )
import           Headroom.FileSupport           ( addHeader
                                                , dropHeader
                                                , extractFileInfo
                                                , replaceHeader
                                                )
import           Headroom.FileSupport.Types     ( FileInfo(..) )
import           Headroom.FileSystem            ( FileSystem(..)
                                                , excludePaths
                                                , fileExtension
                                                , mkFileSystem
                                                )
import           Headroom.FileType              ( configByFileType
                                                , fileTypeByExt
                                                )
import           Headroom.FileType.Types        ( FileType(..) )
import           Headroom.HeaderFn              ( mkConfiguredEnv
                                                , postProcessHeader
                                                )
import           Headroom.Meta                  ( TemplateType
                                                , productInfo
                                                )
import           Headroom.Template              ( Template(..) )
import           Headroom.Types                 ( CurrentYear(..)
                                                , TemplateMeta(..)
                                                )
import           Headroom.UI                    ( Progress(..)
                                                , zipWithProgress
                                                )
import           Headroom.Variables             ( compileVariables
                                                , dynamicVariables
                                                , parseVariables
                                                )
import           Headroom.Variables.Types       ( Variables(..) )
import           RIO
import           RIO.FilePath                   ( takeBaseName )
import qualified RIO.List                      as L
import qualified RIO.Map                       as M
import qualified RIO.Text                      as T


suffixLensesFor ["cHeaderFnConfigs"] ''Configuration


type TemplatesMap = Map FileType (Maybe TemplateMeta, TemplateType)

-- | Action to be performed based on the selected 'RunMode'.
data RunAction = RunAction
  { RunAction -> Bool
raProcessed    :: Bool
  -- ^ whether the given file was processed
  , RunAction -> Text -> Text
raFunc         :: Text -> Text
  -- ^ function to process the file
  , RunAction -> Text
raProcessedMsg :: Text
  -- ^ message to show when file was processed
  , RunAction -> Text
raSkippedMsg   :: Text
  -- ^ message to show when file was skipped
  }


-- | Initial /RIO/ startup environment for the /Run/ command.
data StartupEnv = StartupEnv
  { StartupEnv -> LogFunc
envLogFunc    :: LogFunc
  -- ^ logging function
  , StartupEnv -> CommandRunOptions
envRunOptions :: CommandRunOptions
  -- ^ options
  }

suffixLenses ''StartupEnv

-- | Full /RIO/ environment for the /Run/ command.
data Env = Env
  { Env -> StartupEnv
envEnv           :: StartupEnv
  -- ^ startup /RIO/ environment
  , Env -> CtConfiguration
envConfiguration :: CtConfiguration
  -- ^ application configuration
  , Env -> CurrentYear
envCurrentYear   :: CurrentYear
  -- ^ current year
  , Env -> FileSystem (RIO Env)
envFileSystem    :: FileSystem (RIO Env)
  -- ^ file system operations
  }

suffixLenses ''Env

instance Has CtConfiguration Env where
  hasLens :: (CtConfiguration -> f CtConfiguration) -> Env -> f Env
hasLens = (CtConfiguration -> f CtConfiguration) -> Env -> f Env
Lens' Env CtConfiguration
envConfigurationL

instance Has CtHeaderFnConfigs Env where
  hasLens :: (CtHeaderFnConfigs -> f CtHeaderFnConfigs) -> Env -> f Env
hasLens = (CtConfiguration -> f CtConfiguration) -> Env -> f Env
Lens' Env CtConfiguration
envConfigurationL ((CtConfiguration -> f CtConfiguration) -> Env -> f Env)
-> ((CtHeaderFnConfigs -> f CtHeaderFnConfigs)
    -> CtConfiguration -> f CtConfiguration)
-> (CtHeaderFnConfigs -> f CtHeaderFnConfigs)
-> Env
-> f Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CtHeaderFnConfigs -> f CtHeaderFnConfigs)
-> CtConfiguration -> f CtConfiguration
forall (p :: Phase). Lens' (Configuration p) (HeaderFnConfigs p)
cHeaderFnConfigsL

instance Has StartupEnv StartupEnv where
  hasLens :: (StartupEnv -> f StartupEnv) -> StartupEnv -> f StartupEnv
hasLens = (StartupEnv -> f StartupEnv) -> StartupEnv -> f StartupEnv
forall a. a -> a
id

instance Has StartupEnv Env where
  hasLens :: (StartupEnv -> f StartupEnv) -> Env -> f Env
hasLens = (StartupEnv -> f StartupEnv) -> Env -> f Env
Lens' Env StartupEnv
envEnvL

instance HasLogFunc StartupEnv where
  logFuncL :: (LogFunc -> f LogFunc) -> StartupEnv -> f StartupEnv
logFuncL = (LogFunc -> f LogFunc) -> StartupEnv -> f StartupEnv
Lens' StartupEnv LogFunc
envLogFuncL

instance HasLogFunc Env where
  logFuncL :: (LogFunc -> f LogFunc) -> Env -> f Env
logFuncL = forall t. Has StartupEnv t => Lens' t StartupEnv
forall a t. Has a t => Lens' t a
hasLens @StartupEnv ((StartupEnv -> f StartupEnv) -> Env -> f Env)
-> ((LogFunc -> f LogFunc) -> StartupEnv -> f StartupEnv)
-> (LogFunc -> f LogFunc)
-> Env
-> f Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> StartupEnv -> f StartupEnv
forall env. HasLogFunc env => Lens' env LogFunc
logFuncL

instance Has CommandRunOptions StartupEnv where
  hasLens :: (CommandRunOptions -> f CommandRunOptions)
-> StartupEnv -> f StartupEnv
hasLens = (CommandRunOptions -> f CommandRunOptions)
-> StartupEnv -> f StartupEnv
Lens' StartupEnv CommandRunOptions
envRunOptionsL

instance Has CommandRunOptions Env where
  hasLens :: (CommandRunOptions -> f CommandRunOptions) -> Env -> f Env
hasLens = forall t. Has StartupEnv t => Lens' t StartupEnv
forall a t. Has a t => Lens' t a
hasLens @StartupEnv ((StartupEnv -> f StartupEnv) -> Env -> f Env)
-> ((CommandRunOptions -> f CommandRunOptions)
    -> StartupEnv -> f StartupEnv)
-> (CommandRunOptions -> f CommandRunOptions)
-> Env
-> f Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandRunOptions -> f CommandRunOptions)
-> StartupEnv -> f StartupEnv
forall a t. Has a t => Lens' t a
hasLens

instance Has CurrentYear Env where
  hasLens :: (CurrentYear -> f CurrentYear) -> Env -> f Env
hasLens = (CurrentYear -> f CurrentYear) -> Env -> f Env
Lens' Env CurrentYear
envCurrentYearL

instance Has (FileSystem (RIO Env)) Env where
  hasLens :: (FileSystem (RIO Env) -> f (FileSystem (RIO Env))) -> Env -> f Env
hasLens = (FileSystem (RIO Env) -> f (FileSystem (RIO Env))) -> Env -> f Env
Lens' Env (FileSystem (RIO Env))
envFileSystemL


env' :: CommandRunOptions -> LogFunc -> IO Env
env' :: CommandRunOptions -> LogFunc -> IO Env
env' CommandRunOptions
opts LogFunc
logFunc = do
  let envEnv :: StartupEnv
envEnv        = StartupEnv :: LogFunc -> CommandRunOptions -> StartupEnv
StartupEnv { envLogFunc :: LogFunc
envLogFunc = LogFunc
logFunc, envRunOptions :: CommandRunOptions
envRunOptions = CommandRunOptions
opts }
      envFileSystem :: FileSystem (RIO Env)
envFileSystem = FileSystem (RIO Env)
forall (m :: * -> *). MonadIO m => FileSystem m
mkFileSystem
  CtConfiguration
envConfiguration <- StartupEnv -> RIO StartupEnv CtConfiguration -> IO CtConfiguration
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO StartupEnv
envEnv RIO StartupEnv CtConfiguration
forall env.
(HasLogFunc env, Has CommandRunOptions env) =>
RIO env CtConfiguration
finalConfiguration
  CurrentYear
envCurrentYear   <- IO CurrentYear
forall (m :: * -> *). MonadIO m => m CurrentYear
currentYear
  Env -> IO Env
forall (f :: * -> *) a. Applicative f => a -> f a
pure Env :: StartupEnv
-> CtConfiguration -> CurrentYear -> FileSystem (RIO Env) -> Env
Env { CurrentYear
CtConfiguration
FileSystem (RIO Env)
StartupEnv
envCurrentYear :: CurrentYear
envConfiguration :: CtConfiguration
envFileSystem :: FileSystem (RIO Env)
envEnv :: StartupEnv
envFileSystem :: FileSystem (RIO Env)
envCurrentYear :: CurrentYear
envConfiguration :: CtConfiguration
envEnv :: StartupEnv
.. }


-- | Handler for /Run/ command.
commandRun :: CommandRunOptions
           -- ^ /Run/ command options
           -> IO ()
           -- ^ execution result
commandRun :: CommandRunOptions -> IO ()
commandRun CommandRunOptions
opts = (LogFunc -> IO Env) -> Bool -> RIO Env () -> IO ()
forall env a. (LogFunc -> IO env) -> Bool -> RIO env a -> IO a
bootstrap (CommandRunOptions -> LogFunc -> IO Env
env' CommandRunOptions
opts) (CommandRunOptions -> Bool
croDebug CommandRunOptions
opts) (RIO Env () -> IO ()) -> RIO Env () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  CommandRunOptions {Bool
[FilePath]
[Text]
[Regex]
Maybe TemplateSource
Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateSource :: CommandRunOptions -> Maybe TemplateSource
croExcludedPaths :: CommandRunOptions -> [Regex]
croSourcePaths :: CommandRunOptions -> [FilePath]
croRunMode :: CommandRunOptions -> Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateSource :: Maybe TemplateSource
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDebug :: CommandRunOptions -> Bool
..} <- RIO Env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
..}     <- forall t (m :: * -> *).
(Has CtConfiguration t, MonadReader t m) =>
m CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtConfiguration
  let isCheck :: Bool
isCheck = RunMode
'Complete ::: RunMode
cRunMode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
Check
  RIO Env ()
forall env.
(HasLogFunc env, Has CommandRunOptions env) =>
RIO env ()
warnOnDryRun
  POSIXTime
startTS            <- IO POSIXTime -> RIO Env POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  TemplatesMap
templates          <- Map FileType TemplateType -> TemplatesMap
withTemplateMeta (Map FileType TemplateType -> TemplatesMap)
-> RIO Env (Map FileType TemplateType) -> RIO Env TemplatesMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO Env (Map FileType TemplateType)
forall env.
(Has CtConfiguration env, Has (FileSystem (RIO env)) env,
 HasLogFunc env) =>
RIO env (Map FileType TemplateType)
loadTemplates
  [FilePath]
sourceFiles        <- [FileType] -> RIO Env [FilePath]
forall env.
(Has CtConfiguration env, Has (FileSystem (RIO env)) env,
 HasLogFunc env) =>
[FileType] -> RIO env [FilePath]
findSourceFiles (TemplatesMap -> [FileType]
forall k a. Map k a -> [k]
M.keys TemplatesMap
templates)
  (Int
total, Int
processed) <- TemplatesMap -> [FilePath] -> RIO Env (Int, Int)
forall env.
(Has CtConfiguration env, Has CtHeaderFnConfigs env,
 Has CommandRunOptions env, Has CurrentYear env, HasLogFunc env) =>
TemplatesMap -> [FilePath] -> RIO env (Int, Int)
processSourceFiles TemplatesMap
templates [FilePath]
sourceFiles
  POSIXTime
endTS              <- IO POSIXTime -> RIO Env POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"-----"
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Utf8Builder
"Done: "
    , if Bool
isCheck then Utf8Builder
"outdated " else Utf8Builder
"modified "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
processed
    , if Bool
isCheck then Utf8Builder
", up-to-date " else Utf8Builder
", skipped "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
processed)
    , Utf8Builder
" file(s) in "
    , POSIXTime -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (POSIXTime
endTS POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
startTS)
    , Utf8Builder
" second(s)."
    ]
  RIO Env ()
forall env.
(HasLogFunc env, Has CommandRunOptions env) =>
RIO env ()
warnOnDryRun
  Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
croDryRun Bool -> Bool -> Bool
&& Bool
isCheck Bool -> Bool -> Bool
&& Int
processed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ExitCode -> RIO Env ()
forall (m :: * -> *) a. MonadIO m => ExitCode -> m a
exitWith (ExitCode -> RIO Env ()) -> ExitCode -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1)


warnOnDryRun :: (HasLogFunc env, Has CommandRunOptions env) => RIO env ()
warnOnDryRun :: RIO env ()
warnOnDryRun = do
  CommandRunOptions {Bool
[FilePath]
[Text]
[Regex]
Maybe TemplateSource
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateSource :: Maybe TemplateSource
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateSource :: CommandRunOptions -> Maybe TemplateSource
croExcludedPaths :: CommandRunOptions -> [Regex]
croSourcePaths :: CommandRunOptions -> [FilePath]
croRunMode :: CommandRunOptions -> Maybe RunMode
croDebug :: CommandRunOptions -> Bool
..} <- RIO env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
croDryRun (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"[!] Running with '--dry-run', no files are changed!"


findSourceFiles :: ( Has CtConfiguration env
                   , Has (FileSystem (RIO env)) env
                   , HasLogFunc env
                   )
                => [FileType]
                -> RIO env [FilePath]
findSourceFiles :: [FileType] -> RIO env [FilePath]
findSourceFiles [FileType]
fileTypes = do
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
..} <- RIO env CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  FileSystem {GetCurrentDirectoryFn (RIO env)
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetCurrentDirectory :: GetCurrentDirectoryFn (RIO env)
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
..}    <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Using source paths: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
'Complete ::: [FilePath]
cSourcePaths
  [FilePath]
files <-
    [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath])
-> RIO env [[FilePath]] -> RIO env [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListFilesFn (RIO env) -> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FindFilesByTypesFn (RIO env)
fsFindFilesByTypes HeadersConfig 'Complete
cLicenseHeaders [FileType]
fileTypes) [FilePath]
'Complete ::: [FilePath]
cSourcePaths
  let files' :: [FilePath]
files' = [Regex] -> [FilePath] -> [FilePath]
excludePaths [Regex]
'Complete ::: [Regex]
cExcludedPaths [FilePath]
files
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Utf8Builder
"Found "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files'
    , Utf8Builder
" source file(s) (excluded "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files Int -> Int -> Int
forall a. Num a => a -> a -> a
- [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files'
    , Utf8Builder
" file(s))"
    ]
  [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
files'


processSourceFiles :: ( Has CtConfiguration env
                      , Has CtHeaderFnConfigs env
                      , Has CommandRunOptions env
                      , Has CurrentYear env
                      , HasLogFunc env
                      )
                   => TemplatesMap
                   -> [FilePath]
                   -> RIO env (Int, Int)
processSourceFiles :: TemplatesMap -> [FilePath] -> RIO env (Int, Int)
processSourceFiles TemplatesMap
templates [FilePath]
paths = do
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
..} <- RIO env CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  CurrentYear
year               <- RIO env CurrentYear
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  let dVars :: Variables
dVars        = CurrentYear -> Variables
dynamicVariables CurrentYear
year
      withFileType :: [(FileType, FilePath)]
withFileType = (FilePath -> Maybe (FileType, FilePath))
-> [FilePath] -> [(FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HeadersConfig 'Complete -> FilePath -> Maybe (FileType, FilePath)
findFileType HeadersConfig 'Complete
cLicenseHeaders) [FilePath]
paths
      withTemplate :: [((Maybe TemplateMeta, TemplateType), FileType, FilePath)]
withTemplate = ((FileType, FilePath)
 -> Maybe ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
-> [(FileType, FilePath)]
-> [((Maybe TemplateMeta, TemplateType), FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((FileType
 -> FilePath
 -> Maybe ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
-> (FileType, FilePath)
-> Maybe ((Maybe TemplateMeta, TemplateType), FileType, FilePath)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FileType
-> FilePath
-> Maybe ((Maybe TemplateMeta, TemplateType), FileType, FilePath)
forall t.
FileType
-> t -> Maybe ((Maybe TemplateMeta, TemplateType), FileType, t)
findTemplate) [(FileType, FilePath)]
withFileType
  Variables
cVars     <- Variables -> RIO env Variables
forall (m :: * -> *). MonadThrow m => Variables -> m Variables
compileVariables (Variables
dVars Variables -> Variables -> Variables
forall a. Semigroup a => a -> a -> a
<> Variables
cVariables)
  [Bool]
processed <- ((Progress,
  ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
 -> RIO env Bool)
-> [(Progress,
     ((Maybe TemplateMeta, TemplateType), FileType, FilePath))]
-> RIO env [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Variables
-> Variables
-> (Progress,
    ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
-> RIO env Bool
forall env.
(Has CtConfiguration env, Has CtHeaderFnConfigs env,
 Has CommandRunOptions env, Has CurrentYear env, HasLogFunc env) =>
Variables
-> Variables
-> (Progress,
    ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
-> RIO env Bool
process Variables
cVars Variables
dVars) ([((Maybe TemplateMeta, TemplateType), FileType, FilePath)]
-> [(Progress,
     ((Maybe TemplateMeta, TemplateType), FileType, FilePath))]
forall a. [a] -> [(Progress, a)]
zipWithProgress [((Maybe TemplateMeta, TemplateType), FileType, FilePath)]
withTemplate)
  (Int, Int) -> RIO env (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([((Maybe TemplateMeta, TemplateType), FileType, FilePath)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [((Maybe TemplateMeta, TemplateType), FileType, FilePath)]
withTemplate, [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Bool] -> Int) -> ([Bool] -> [Bool]) -> [Bool] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ [Bool]
processed)
 where
  findFileType :: HeadersConfig 'Complete -> FilePath -> Maybe (FileType, FilePath)
findFileType HeadersConfig 'Complete
conf FilePath
path =
    (FileType -> (FileType, FilePath))
-> Maybe FileType -> Maybe (FileType, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, FilePath
path) (FilePath -> Maybe Text
fileExtension FilePath
path Maybe Text -> (Text -> Maybe FileType) -> Maybe FileType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HeadersConfig 'Complete -> Text -> Maybe FileType
fileTypeByExt HeadersConfig 'Complete
conf)
  findTemplate :: FileType
-> t -> Maybe ((Maybe TemplateMeta, TemplateType), FileType, t)
findTemplate FileType
ft t
p = (, FileType
ft, t
p) ((Maybe TemplateMeta, TemplateType)
 -> ((Maybe TemplateMeta, TemplateType), FileType, t))
-> Maybe (Maybe TemplateMeta, TemplateType)
-> Maybe ((Maybe TemplateMeta, TemplateType), FileType, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileType
-> TemplatesMap -> Maybe (Maybe TemplateMeta, TemplateType)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileType
ft TemplatesMap
templates
  process :: Variables
-> Variables
-> (Progress,
    ((Maybe TemplateMeta, TemplateType), FileType, FilePath))
-> RIO env Bool
process Variables
cVars Variables
dVars (Progress
pr, ((Maybe TemplateMeta
tm, TemplateType
tt), FileType
ft, FilePath
p)) =
    Variables
-> Variables
-> Progress
-> Maybe TemplateMeta
-> TemplateType
-> FileType
-> FilePath
-> RIO env Bool
forall env.
(Has CommandRunOptions env, Has CtConfiguration env,
 Has CtHeaderFnConfigs env, Has CurrentYear env, HasLogFunc env) =>
Variables
-> Variables
-> Progress
-> Maybe TemplateMeta
-> TemplateType
-> FileType
-> FilePath
-> RIO env Bool
processSourceFile Variables
cVars Variables
dVars Progress
pr Maybe TemplateMeta
tm TemplateType
tt FileType
ft FilePath
p


processSourceFile :: ( Has CommandRunOptions env
                     , Has CtConfiguration env
                     , Has CtHeaderFnConfigs env
                     , Has CurrentYear env
                     , HasLogFunc env
                     )
                  => Variables
                  -> Variables
                  -> Progress
                  -> Maybe TemplateMeta
                  -> TemplateType
                  -> FileType
                  -> FilePath
                  -> RIO env Bool
processSourceFile :: Variables
-> Variables
-> Progress
-> Maybe TemplateMeta
-> TemplateType
-> FileType
-> FilePath
-> RIO env Bool
processSourceFile Variables
cVars Variables
dVars Progress
progress Maybe TemplateMeta
meta TemplateType
template FileType
fileType FilePath
path = do
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
..}     <- forall t (m :: * -> *).
(Has CtConfiguration t, MonadReader t m) =>
m CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtConfiguration
  CommandRunOptions {Bool
[FilePath]
[Text]
[Regex]
Maybe TemplateSource
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateSource :: Maybe TemplateSource
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateSource :: CommandRunOptions -> Maybe TemplateSource
croExcludedPaths :: CommandRunOptions -> [Regex]
croSourcePaths :: CommandRunOptions -> [FilePath]
croRunMode :: CommandRunOptions -> Maybe RunMode
croDebug :: CommandRunOptions -> Bool
..} <- RIO env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Text
fileContent            <- FilePath -> RIO env Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
path
  let fileInfo :: FileInfo
fileInfo@FileInfo {Maybe (Int, Int)
FileType
Variables
CtHeaderConfig
fiVariables :: FileInfo -> Variables
fiHeaderPos :: FileInfo -> Maybe (Int, Int)
fiHeaderConfig :: FileInfo -> CtHeaderConfig
fiFileType :: FileInfo -> FileType
fiVariables :: Variables
fiHeaderPos :: Maybe (Int, Int)
fiHeaderConfig :: CtHeaderConfig
fiFileType :: FileType
..} = FileType
-> CtHeaderConfig -> Maybe TemplateMeta -> Text -> FileInfo
extractFileInfo
        FileType
fileType
        (HeadersConfig 'Complete -> FileType -> CtHeaderConfig
configByFileType HeadersConfig 'Complete
cLicenseHeaders FileType
fileType)
        Maybe TemplateMeta
meta
        Text
fileContent
      variables :: Variables
variables = Variables
dVars Variables -> Variables -> Variables
forall a. Semigroup a => a -> a -> a
<> Variables
cVars Variables -> Variables -> Variables
forall a. Semigroup a => a -> a -> a
<> Variables
fiVariables
      syntax :: 'Complete ::: HeaderSyntax
syntax    = CtHeaderConfig -> 'Complete ::: HeaderSyntax
forall (p :: Phase). HeaderConfig p -> p ::: HeaderSyntax
hcHeaderSyntax CtHeaderConfig
fiHeaderConfig
  Text
header'        <- Variables -> TemplateType -> RIO env Text
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Variables -> t -> m Text
renderTemplate Variables
variables TemplateType
template
  Text
header         <- HeaderSyntax -> Variables -> Text -> RIO env Text
forall env.
(Has CtHeaderFnConfigs env, Has CurrentYear env) =>
HeaderSyntax -> Variables -> Text -> RIO env Text
postProcessHeader' HeaderSyntax
syntax Variables
variables Text
header'
  RunAction {Bool
Text
Text -> Text
raSkippedMsg :: Text
raProcessedMsg :: Text
raFunc :: Text -> Text
raProcessed :: Bool
raSkippedMsg :: RunAction -> Text
raProcessedMsg :: RunAction -> Text
raFunc :: RunAction -> Text -> Text
raProcessed :: RunAction -> Bool
..} <- FileInfo -> Text -> RIO env RunAction
forall env.
Has CtConfiguration env =>
FileInfo -> Text -> RIO env RunAction
chooseAction FileInfo
fileInfo Text
header
  let result :: Text
result  = Text -> Text
raFunc Text
fileContent
      changed :: Bool
changed = Bool
raProcessed Bool -> Bool -> Bool
&& (Text
fileContent Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
result)
      message :: Text
message = if Bool
changed then Text
raProcessedMsg else Text
raSkippedMsg
      isCheck :: Bool
isCheck = RunMode
'Complete ::: RunMode
cRunMode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
Check
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"File info: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileInfo -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FileInfo
fileInfo
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Progress -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Progress
progress, Utf8Builder
" ", Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
message, FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path]
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
croDryRun Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isCheck Bool -> Bool -> Bool
&& Bool
changed) (FilePath -> Text -> RIO env ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
path Text
result)
  Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
changed


chooseAction :: (Has CtConfiguration env)
             => FileInfo
             -> Text
             -> RIO env RunAction
chooseAction :: FileInfo -> Text -> RIO env RunAction
chooseAction FileInfo
info Text
header = do
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
..} <- forall t (m :: * -> *).
(Has CtConfiguration t, MonadReader t m) =>
m CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtConfiguration
  let hasHeader :: Bool
hasHeader = Maybe (Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int, Int) -> Bool) -> Maybe (Int, Int) -> Bool
forall a b. (a -> b) -> a -> b
$ FileInfo -> Maybe (Int, Int)
fiHeaderPos FileInfo
info
  RunAction -> RIO env RunAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunAction -> RIO env RunAction) -> RunAction -> RIO env RunAction
forall a b. (a -> b) -> a -> b
$ RunMode -> Bool -> RunAction
go RunMode
'Complete ::: RunMode
cRunMode Bool
hasHeader
 where
  go :: RunMode -> Bool -> RunAction
go RunMode
runMode Bool
hasHeader = case RunMode
runMode of
    RunMode
Add     -> Bool -> RunAction
aAction Bool
hasHeader
    RunMode
Check   -> Bool -> RunAction
cAction Bool
hasHeader
    RunMode
Drop    -> Bool -> RunAction
dAction Bool
hasHeader
    RunMode
Replace -> Bool -> RunAction
rAction Bool
hasHeader
  aAction :: Bool -> RunAction
aAction Bool
hasHeader = Bool -> (Text -> Text) -> Text -> Text -> RunAction
RunAction (Bool -> Bool
not Bool
hasHeader)
                                (FileInfo -> Text -> Text -> Text
addHeader FileInfo
info Text
header)
                                (Text -> Text
justify Text
"Adding header to:")
                                (Text -> Text
justify Text
"Header already exists in:")
  cAction :: Bool -> RunAction
cAction Bool
hasHeader = (Bool -> RunAction
rAction Bool
hasHeader)
    { raProcessedMsg :: Text
raProcessedMsg = Text -> Text
justify Text
"Outdated header found in:"
    , raSkippedMsg :: Text
raSkippedMsg   = Text -> Text
justify Text
"Header up-to-date in:"
    }
  dAction :: Bool -> RunAction
dAction Bool
hasHeader = Bool -> (Text -> Text) -> Text -> Text -> RunAction
RunAction Bool
hasHeader
                                (FileInfo -> Text -> Text
dropHeader FileInfo
info)
                                (Text -> Text
justify Text
"Dropping header from:")
                                (Text -> Text
justify Text
"No header exists in:")
  rAction :: Bool -> RunAction
rAction Bool
hasHeader = if Bool
hasHeader then RunAction
rAction' else RunMode -> Bool -> RunAction
go RunMode
Add Bool
hasHeader
  rAction' :: RunAction
rAction' = Bool -> (Text -> Text) -> Text -> Text -> RunAction
RunAction Bool
True
                       (FileInfo -> Text -> Text -> Text
replaceHeader FileInfo
info Text
header)
                       (Text -> Text
justify Text
"Replacing header in:")
                       (Text -> Text
justify Text
"Header up-to-date in:")
  justify :: Text -> Text
justify = Int -> Char -> Text -> Text
T.justifyLeft Int
30 Char
' '


-- | Loads templates from the given paths.
loadTemplateFiles :: (Has (FileSystem (RIO env)) env, HasLogFunc env)
                  => [FilePath]
                  -- ^ paths to template files
                  -> RIO env (Map FileType TemplateType)
                  -- ^ map of file types and templates
loadTemplateFiles :: [FilePath] -> RIO env (Map FileType TemplateType)
loadTemplateFiles [FilePath]
paths' = do
  FileSystem {GetCurrentDirectoryFn (RIO env)
DoesFileExistFn (RIO env)
ListFilesFn (RIO env)
CreateDirectoryFn (RIO env)
LoadFileFn (RIO env)
FindFilesByExtsFn (RIO env)
FindFilesFn (RIO env)
FindFilesByTypesFn (RIO env)
fsLoadFile :: LoadFileFn (RIO env)
fsListFiles :: ListFilesFn (RIO env)
fsGetCurrentDirectory :: GetCurrentDirectoryFn (RIO env)
fsFindFilesByTypes :: FindFilesByTypesFn (RIO env)
fsFindFilesByExts :: FindFilesByExtsFn (RIO env)
fsFindFiles :: FindFilesFn (RIO env)
fsDoesFileExist :: DoesFileExistFn (RIO env)
fsCreateDirectory :: CreateDirectoryFn (RIO env)
fsLoadFile :: forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsListFiles :: forall (m :: * -> *). FileSystem m -> ListFilesFn m
fsGetCurrentDirectory :: forall (m :: * -> *). FileSystem m -> GetCurrentDirectoryFn m
fsFindFilesByTypes :: forall (m :: * -> *). FileSystem m -> FindFilesByTypesFn m
fsFindFilesByExts :: forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFiles :: forall (m :: * -> *). FileSystem m -> FindFilesFn m
fsDoesFileExist :: forall (m :: * -> *). FileSystem m -> DoesFileExistFn m
fsCreateDirectory :: forall (m :: * -> *). FileSystem m -> CreateDirectoryFn m
..} <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  [FilePath]
paths           <- [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath])
-> RIO env [[FilePath]] -> RIO env [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListFilesFn (RIO env) -> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FindFilesByExtsFn (RIO env)
`fsFindFilesByExts` [Text]
extensions) [FilePath]
paths'
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Using template paths: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
paths
  [(FileType, FilePath)]
withTypes <- [Maybe (FileType, FilePath)] -> [(FileType, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FileType, FilePath)] -> [(FileType, FilePath)])
-> RIO env [Maybe (FileType, FilePath)]
-> RIO env [(FileType, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> RIO env (Maybe (FileType, FilePath)))
-> [FilePath] -> RIO env [Maybe (FileType, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
p -> (FileType -> (FileType, FilePath))
-> Maybe FileType -> Maybe (FileType, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, FilePath
p) (Maybe FileType -> Maybe (FileType, FilePath))
-> RIO env (Maybe FileType) -> RIO env (Maybe (FileType, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RIO env (Maybe FileType)
forall env. HasLogFunc env => FilePath -> RIO env (Maybe FileType)
typeOfTemplate FilePath
p) [FilePath]
paths
  [(FileType, TemplateType)]
parsed    <- ((FileType, FilePath) -> RIO env (FileType, TemplateType))
-> [(FileType, FilePath)] -> RIO env [(FileType, TemplateType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
    (\(FileType
t, FilePath
p) ->
      (FileType
t, ) (TemplateType -> (FileType, TemplateType))
-> RIO env TemplateType -> RIO env (FileType, TemplateType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Text
T.strip (Text -> Text) -> RIO env Text -> RIO env Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadFileFn (RIO env)
fsLoadFile FilePath
p) RIO env Text
-> (Text -> RIO env TemplateType) -> RIO env TemplateType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> Text -> RIO env TemplateType
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Maybe Text -> Text -> m t
parseTemplate (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
p))
    )
    [(FileType, FilePath)]
withTypes
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo
    (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder
"Found ", Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [(FileType, TemplateType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(FileType, TemplateType)]
parsed, Utf8Builder
" license template(s)"]
  Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FileType TemplateType -> RIO env (Map FileType TemplateType))
-> Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall a b. (a -> b) -> a -> b
$ [(FileType, TemplateType)] -> Map FileType TemplateType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FileType, TemplateType)]
parsed
  where extensions :: [Text]
extensions = NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Template TemplateType => NonEmpty Text
forall t. Template t => NonEmpty Text
templateExtensions @TemplateType


-- | Loads built-in templates, stored in "Headroom.Embedded", for the given
-- 'LicenseType'.
loadBuiltInTemplates :: (HasLogFunc env)
                     => LicenseType
                     -- ^ license type for which to selected templates
                     -> RIO env (Map FileType TemplateType)
                     -- ^ map of file types and templates
loadBuiltInTemplates :: LicenseType -> RIO env (Map FileType TemplateType)
loadBuiltInTemplates LicenseType
licenseType = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Using built-in templates for license: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> LicenseType -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow LicenseType
licenseType
  [(FileType, TemplateType)]
parsed <- ((FileType, Text) -> RIO env (FileType, TemplateType))
-> [(FileType, Text)] -> RIO env [(FileType, TemplateType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(FileType
t, Text
r) -> (FileType
t, ) (TemplateType -> (FileType, TemplateType))
-> RIO env TemplateType -> RIO env (FileType, TemplateType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Text -> RIO env TemplateType
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Maybe Text -> Text -> m t
parseTemplate Maybe Text
forall a. Maybe a
Nothing Text
r) [(FileType, Text)]
rawTemplates
  Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FileType TemplateType -> RIO env (Map FileType TemplateType))
-> Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall a b. (a -> b) -> a -> b
$ [(FileType, TemplateType)] -> Map FileType TemplateType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FileType, TemplateType)]
parsed
 where
  rawTemplates :: [(FileType, Text)]
rawTemplates = (FileType -> (FileType, Text)) -> [FileType] -> [(FileType, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FileType
ft -> (FileType
ft, FileType -> Text
template FileType
ft)) (EnumExtra FileType => [FileType]
forall a. EnumExtra a => [a]
allValues @FileType)
  template :: FileType -> Text
template     = LicenseType -> FileType -> Text
forall a. IsString a => LicenseType -> FileType -> a
licenseTemplate LicenseType
licenseType


loadTemplates :: ( Has CtConfiguration env
                 , Has (FileSystem (RIO env)) env
                 , HasLogFunc env
                 )
              => RIO env (Map FileType TemplateType)
loadTemplates :: RIO env (Map FileType TemplateType)
loadTemplates = do
  Configuration {Variables
HeadersConfig 'Complete
CtHeaderFnConfigs
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: TemplateSource
'Complete ::: RunMode
cHeaderFnConfigs :: CtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateSource :: 'Complete ::: TemplateSource
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cHeaderFnConfigs :: forall (p :: Phase). Configuration p -> HeaderFnConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateSource :: forall (p :: Phase). Configuration p -> p ::: TemplateSource
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
..} <- forall t (m :: * -> *).
(Has CtConfiguration t, MonadReader t m) =>
m CtConfiguration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtConfiguration
  case 'Complete ::: TemplateSource
cTemplateSource of
    TemplateFiles    paths       -> [FilePath] -> RIO env (Map FileType TemplateType)
forall env.
(Has (FileSystem (RIO env)) env, HasLogFunc env) =>
[FilePath] -> RIO env (Map FileType TemplateType)
loadTemplateFiles [FilePath]
paths
    BuiltInTemplates licenseType -> LicenseType -> RIO env (Map FileType TemplateType)
forall env.
HasLogFunc env =>
LicenseType -> RIO env (Map FileType TemplateType)
loadBuiltInTemplates LicenseType
licenseType


withTemplateMeta :: Map FileType TemplateType -> TemplatesMap
withTemplateMeta :: Map FileType TemplateType -> TemplatesMap
withTemplateMeta = [(FileType, (Maybe TemplateMeta, TemplateType))] -> TemplatesMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FileType, (Maybe TemplateMeta, TemplateType))] -> TemplatesMap)
-> (Map FileType TemplateType
    -> [(FileType, (Maybe TemplateMeta, TemplateType))])
-> Map FileType TemplateType
-> TemplatesMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FileType, TemplateType)]
-> [(FileType, (Maybe TemplateMeta, TemplateType))]
go ([(FileType, TemplateType)]
 -> [(FileType, (Maybe TemplateMeta, TemplateType))])
-> (Map FileType TemplateType -> [(FileType, TemplateType)])
-> Map FileType TemplateType
-> [(FileType, (Maybe TemplateMeta, TemplateType))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FileType TemplateType -> [(FileType, TemplateType)]
forall k a. Map k a -> [(k, a)]
M.toList
  where go :: [(FileType, TemplateType)]
-> [(FileType, (Maybe TemplateMeta, TemplateType))]
go = ((FileType, TemplateType)
 -> (FileType, (Maybe TemplateMeta, TemplateType)))
-> [(FileType, TemplateType)]
-> [(FileType, (Maybe TemplateMeta, TemplateType))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(FileType
k, TemplateType
v) -> (FileType
k, (FileType -> TemplateType -> Maybe TemplateMeta
forall t. Template t => FileType -> t -> Maybe TemplateMeta
extractTemplateMeta FileType
k TemplateType
v, TemplateType
v)))


-- | Takes path to the template file and returns detected type of the template.
typeOfTemplate :: HasLogFunc env
               => FilePath
               -- ^ path to the template file
               -> RIO env (Maybe FileType)
               -- ^ detected template type
typeOfTemplate :: FilePath -> RIO env (Maybe FileType)
typeOfTemplate FilePath
path = do
  let fileType :: Maybe FileType
fileType = Text -> Maybe FileType
forall a. EnumExtra a => Text -> Maybe a
textToEnum (Text -> Maybe FileType)
-> (FilePath -> Text) -> FilePath -> Maybe FileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeBaseName (FilePath -> Maybe FileType) -> FilePath -> Maybe FileType
forall a b. (a -> b) -> a -> b
$ FilePath
path
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FileType -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FileType
fileType)
       (Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Skipping unrecognized template type: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path)
  Maybe FileType -> RIO env (Maybe FileType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileType
fileType


loadConfigurationSafe :: (HasLogFunc env)
                      => FilePath
                      -> RIO env (Maybe PtConfiguration)
loadConfigurationSafe :: FilePath -> RIO env (Maybe PtConfiguration)
loadConfigurationSafe FilePath
path = RIO env (Maybe PtConfiguration)
-> (IOException -> RIO env (Maybe PtConfiguration))
-> RIO env (Maybe PtConfiguration)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (PtConfiguration -> Maybe PtConfiguration
forall a. a -> Maybe a
Just (PtConfiguration -> Maybe PtConfiguration)
-> RIO env PtConfiguration -> RIO env (Maybe PtConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RIO env PtConfiguration
forall (m :: * -> *). MonadIO m => FilePath -> m PtConfiguration
loadConfiguration FilePath
path) IOException -> RIO env (Maybe PtConfiguration)
forall env (m :: * -> *) a.
(MonadReader env m, MonadIO m, HasLogFunc env) =>
IOException -> m (Maybe a)
onError
 where
  onError :: IOException -> m (Maybe a)
onError IOException
err = do
    Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ IOException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (IOException
err :: IOException)
    Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Utf8Builder
"Configuration file '"
      , FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path
      , Utf8Builder
"' not found. You can either specify all required parameter by "
      , Utf8Builder
"command line arguments, or generate one using "
      , Utf8Builder
"'headroom gen -c >.headroom.yaml'. See official documentation "
      , Utf8Builder
"for more details."
      ]
    Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing


finalConfiguration :: (HasLogFunc env, Has CommandRunOptions env)
                   => RIO env CtConfiguration
finalConfiguration :: RIO env CtConfiguration
finalConfiguration = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
productInfo
  Maybe PtConfiguration
defaultConfig' <- PtConfiguration -> Maybe PtConfiguration
forall a. a -> Maybe a
Just (PtConfiguration -> Maybe PtConfiguration)
-> RIO env PtConfiguration -> RIO env (Maybe PtConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> RIO env PtConfiguration
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m PtConfiguration
parseConfiguration ByteString
forall a. IsString a => a
defaultConfig
  Maybe PtConfiguration
cmdLineConfig  <- PtConfiguration -> Maybe PtConfiguration
forall a. a -> Maybe a
Just (PtConfiguration -> Maybe PtConfiguration)
-> RIO env PtConfiguration -> RIO env (Maybe PtConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env PtConfiguration
forall env. Has CommandRunOptions env => RIO env PtConfiguration
optionsToConfiguration
  Maybe PtConfiguration
yamlConfig     <- FilePath -> RIO env (Maybe PtConfiguration)
forall env.
HasLogFunc env =>
FilePath -> RIO env (Maybe PtConfiguration)
loadConfigurationSafe FilePath
".headroom.yaml"
  let mergedConfig :: PtConfiguration
mergedConfig =
        [PtConfiguration] -> PtConfiguration
forall a. Monoid a => [a] -> a
mconcat ([PtConfiguration] -> PtConfiguration)
-> ([Maybe PtConfiguration] -> [PtConfiguration])
-> [Maybe PtConfiguration]
-> PtConfiguration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe PtConfiguration] -> [PtConfiguration]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PtConfiguration] -> PtConfiguration)
-> [Maybe PtConfiguration] -> PtConfiguration
forall a b. (a -> b) -> a -> b
$ [Maybe PtConfiguration
defaultConfig', Maybe PtConfiguration
yamlConfig, Maybe PtConfiguration
cmdLineConfig]
  CtConfiguration
config <- PtConfiguration -> RIO env CtConfiguration
forall (m :: * -> *).
MonadThrow m =>
PtConfiguration -> m CtConfiguration
makeConfiguration PtConfiguration
mergedConfig
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Default config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Maybe PtConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Maybe PtConfiguration
defaultConfig'
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"YAML config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Maybe PtConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Maybe PtConfiguration
yamlConfig
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"CmdLine config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Maybe PtConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Maybe PtConfiguration
cmdLineConfig
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Merged config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PtConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow PtConfiguration
mergedConfig
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Final config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CtConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow CtConfiguration
config
  CtConfiguration -> RIO env CtConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure CtConfiguration
config


optionsToConfiguration :: (Has CommandRunOptions env) => RIO env PtConfiguration
optionsToConfiguration :: RIO env PtConfiguration
optionsToConfiguration = do
  CommandRunOptions {Bool
[FilePath]
[Text]
[Regex]
Maybe TemplateSource
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateSource :: Maybe TemplateSource
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateSource :: CommandRunOptions -> Maybe TemplateSource
croExcludedPaths :: CommandRunOptions -> [Regex]
croSourcePaths :: CommandRunOptions -> [FilePath]
croRunMode :: CommandRunOptions -> Maybe RunMode
croDebug :: CommandRunOptions -> Bool
..} <- RIO env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Variables
variables              <- [Text] -> RIO env Variables
forall (m :: * -> *). MonadThrow m => [Text] -> m Variables
parseVariables [Text]
croVariables
  PtConfiguration -> RIO env PtConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure Configuration :: forall (p :: Phase).
(p ::: RunMode)
-> (p ::: [FilePath])
-> (p ::: [Regex])
-> (p ::: TemplateSource)
-> Variables
-> HeadersConfig p
-> HeaderFnConfigs p
-> Configuration p
Configuration { cRunMode :: 'Partial ::: RunMode
cRunMode         = Last RunMode
-> (RunMode -> Last RunMode) -> Maybe RunMode -> Last RunMode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Last RunMode
forall a. Monoid a => a
mempty RunMode -> Last RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RunMode
croRunMode
                     , cSourcePaths :: 'Partial ::: [FilePath]
cSourcePaths     = ([FilePath] -> Bool) -> [FilePath] -> Last [FilePath]
forall (f :: * -> *) a.
(Monoid (f a), Applicative f) =>
(a -> Bool) -> a -> f a
ifNot [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
croSourcePaths
                     , cExcludedPaths :: 'Partial ::: [Regex]
cExcludedPaths   = ([Regex] -> Bool) -> [Regex] -> Last [Regex]
forall (f :: * -> *) a.
(Monoid (f a), Applicative f) =>
(a -> Bool) -> a -> f a
ifNot [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Regex]
croExcludedPaths
                     , cTemplateSource :: 'Partial ::: TemplateSource
cTemplateSource  = Last TemplateSource
-> (TemplateSource -> Last TemplateSource)
-> Maybe TemplateSource
-> Last TemplateSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Last TemplateSource
forall a. Monoid a => a
mempty TemplateSource -> Last TemplateSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TemplateSource
croTemplateSource
                     , cVariables :: Variables
cVariables       = Variables
variables
                     , cLicenseHeaders :: HeadersConfig 'Partial
cLicenseHeaders  = HeadersConfig 'Partial
forall a. Monoid a => a
mempty
                     , cHeaderFnConfigs :: HeaderFnConfigs 'Partial
cHeaderFnConfigs = HeaderFnConfigs 'Partial
forall a. Monoid a => a
mempty
                     }
  where ifNot :: (a -> Bool) -> a -> f a
ifNot a -> Bool
cond a
value = if a -> Bool
cond a
value then f a
forall a. Monoid a => a
mempty else a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value


currentYear :: (MonadIO m) => m CurrentYear
currentYear :: m CurrentYear
currentYear = do
  UTCTime
now      <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  TimeZone
timezone <- IO TimeZone -> m TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
getCurrentTimeZone
  let zoneNow :: LocalTime
zoneNow      = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
timezone UTCTime
now
      (Integer
year, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay LocalTime
zoneNow
  CurrentYear -> m CurrentYear
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CurrentYear -> m CurrentYear) -> CurrentYear -> m CurrentYear
forall a b. (a -> b) -> a -> b
$ Integer -> CurrentYear
CurrentYear Integer
year


-- | Performs post-processing on rendered /license header/, based on given
-- configuration. Currently the main points are to:
--
--  1. sanitize possibly corrupted comment syntax ('sanitizeHeader')
--  2. apply /license header functions/ ('postProcessHeader')
postProcessHeader' :: (Has CtHeaderFnConfigs env, Has CurrentYear env)
                   => HeaderSyntax
                   -- ^ syntax of the license header comments
                   -> Variables
                   -- ^ template variables
                   -> Text
                   -- ^ rendered /license header/ to post-process
                   -> RIO env Text
                   -- ^ post-processed /license header/
postProcessHeader' :: HeaderSyntax -> Variables -> Text -> RIO env Text
postProcessHeader' HeaderSyntax
syntax Variables
vars Text
rawHeader = do
  CtHeaderFnConfigs
configs <- forall t (m :: * -> *).
(Has CtHeaderFnConfigs t, MonadReader t m) =>
m CtHeaderFnConfigs
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtHeaderFnConfigs
  CurrentYear
year    <- RIO env CurrentYear
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  ConfiguredEnv
cEnv    <- CurrentYear
-> Variables -> CtHeaderFnConfigs -> RIO env ConfiguredEnv
forall (m :: * -> *).
MonadThrow m =>
CurrentYear -> Variables -> CtHeaderFnConfigs -> m ConfiguredEnv
mkConfiguredEnv CurrentYear
year Variables
vars CtHeaderFnConfigs
configs
  let processed :: Text
processed = HeaderSyntax -> Text -> Text
sanitizeHeader HeaderSyntax
syntax (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredEnv -> Text -> Text
postProcessHeader ConfiguredEnv
cEnv (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
rawHeader
  Text -> RIO env Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
processed


-- | Ensures that all lines in license header starts with /line-comment/ syntax
-- if such syntax is used for license header.
--
-- >>> sanitizeHeader (LineComment "--") "-- foo\nbar\n-- baz"
-- "-- foo\n-- bar\n-- baz"
sanitizeHeader :: HeaderSyntax
               -- ^ syntax of the license header comments
               -> Text
               -- ^ input text to sanitize
               -> Text
               -- ^ sanitized text
sanitizeHeader :: HeaderSyntax -> Text -> Text
sanitizeHeader (BlockComment Text
_ Text
_      ) Text
text = Text
text
sanitizeHeader (LineComment Text
prefixedBy) Text
text = (Text -> Text) -> Text -> Text
mapLines Text -> Text
process Text
text
 where
  process :: Text -> Text
process Text
line | Text -> Text -> Bool
T.isPrefixOf Text
prefixedBy Text
line = Text
line
               | Bool
otherwise                    = Text
prefixedBy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line