{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Headroom.Command.Run
( commandRun
, loadTemplateRefs
, typeOfTemplate
, postProcessHeader'
)
where
import Control.Monad.Extra ( ifM )
import Data.String.Interpolate ( i
, iii
)
import Data.Time.Calendar ( toGregorian )
import Data.Time.Clock ( getCurrentTime )
import Data.Time.Clock.POSIX ( getPOSIXTime )
import Data.Time.LocalTime ( getCurrentTimeZone
, localDay
, utcToLocalTime
)
import Data.VCS.Ignore ( Git
, Repo(..)
, findRepo
)
import Headroom.Command.Types ( CommandRunOptions(..) )
import Headroom.Command.Utils ( bootstrap )
import Headroom.Configuration ( loadConfiguration
, makeConfiguration
, parseConfiguration
)
import Headroom.Configuration.Types ( Configuration(..)
, CtConfiguration
, CtPostProcessConfigs
, HeaderConfig(..)
, HeaderSyntax(..)
, PtConfiguration
, RunMode(..)
)
import Headroom.Data.EnumExtra ( EnumExtra(..) )
import Headroom.Data.Has ( Has(..) )
import Headroom.Data.Lens ( suffixLenses
, suffixLensesFor
)
import Headroom.Embedded ( defaultConfig
, licenseTemplate
)
import Headroom.FileSupport ( analyzeSourceCode
, fileSupport
)
import Headroom.FileType ( fileTypeByExt )
import Headroom.FileType.Types ( FileType(..) )
import Headroom.Header ( addHeader
, dropHeader
, extractHeaderInfo
, extractHeaderTemplate
, replaceHeader
)
import Headroom.Header.Sanitize ( sanitizeSyntax )
import Headroom.Header.Types ( HeaderInfo(..)
, HeaderTemplate(..)
)
import Headroom.IO.FileSystem ( FileSystem(..)
, excludePaths
, fileExtension
, mkFileSystem
)
import Headroom.IO.Network ( Network(..)
, mkNetwork
)
import Headroom.Meta ( TemplateType
, configFileName
, productInfo
)
import Headroom.PostProcess ( mkConfiguredEnv
, postProcessHeader
)
import Headroom.SourceCode ( SourceCode
, toText
)
import Headroom.Template ( Template(..) )
import Headroom.Template.TemplateRef ( TemplateRef(..)
, renderRef
)
import Headroom.Types ( CurrentYear(..) )
import Headroom.UI ( Progress(..)
, zipWithProgress
)
import Headroom.UI.Table ( Table2(..) )
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 ["cPostProcessConfigs"] ''Configuration
data RunAction = RunAction
{ RunAction -> Bool
raProcessed :: Bool
, RunAction -> SourceCode -> SourceCode
raFunc :: SourceCode -> SourceCode
, RunAction -> Text
raProcessedMsg :: Text
, RunAction -> Text
raSkippedMsg :: Text
}
data StartupEnv = StartupEnv
{ StartupEnv -> LogFunc
envLogFunc :: LogFunc
, StartupEnv -> CommandRunOptions
envRunOptions :: CommandRunOptions
}
suffixLenses ''StartupEnv
data Env = Env
{ Env -> StartupEnv
envEnv :: StartupEnv
, Env -> CtConfiguration
envConfiguration :: CtConfiguration
, Env -> CurrentYear
envCurrentYear :: CurrentYear
, Env -> Network (RIO Env)
envNetwork :: Network (RIO Env)
, Env -> FileSystem (RIO Env)
envFileSystem :: FileSystem (RIO Env)
}
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 CtPostProcessConfigs Env where
hasLens :: (CtPostProcessConfigs -> f CtPostProcessConfigs) -> Env -> f Env
hasLens = (CtConfiguration -> f CtConfiguration) -> Env -> f Env
Lens' Env CtConfiguration
envConfigurationL ((CtConfiguration -> f CtConfiguration) -> Env -> f Env)
-> ((CtPostProcessConfigs -> f CtPostProcessConfigs)
-> CtConfiguration -> f CtConfiguration)
-> (CtPostProcessConfigs -> f CtPostProcessConfigs)
-> Env
-> f Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CtPostProcessConfigs -> f CtPostProcessConfigs)
-> CtConfiguration -> f CtConfiguration
forall (p :: Phase). Lens' (Configuration p) (PostProcessConfigs p)
cPostProcessConfigsL
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 (Network (RIO Env)) Env where
hasLens :: (Network (RIO Env) -> f (Network (RIO Env))) -> Env -> f Env
hasLens = (Network (RIO Env) -> f (Network (RIO Env))) -> Env -> f Env
Lens' Env (Network (RIO Env))
envNetworkL
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 }
envNetwork :: Network (RIO Env)
envNetwork = Network (RIO Env)
forall (m :: * -> *). MonadIO m => Network m
mkNetwork
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
-> Network (RIO Env)
-> FileSystem (RIO Env)
-> Env
Env { CurrentYear
Network (RIO Env)
CtConfiguration
FileSystem (RIO Env)
StartupEnv
envCurrentYear :: CurrentYear
envConfiguration :: CtConfiguration
envFileSystem :: FileSystem (RIO Env)
envNetwork :: Network (RIO Env)
envEnv :: StartupEnv
envFileSystem :: FileSystem (RIO Env)
envNetwork :: Network (RIO Env)
envCurrentYear :: CurrentYear
envConfiguration :: CtConfiguration
envEnv :: StartupEnv
.. }
commandRun :: CommandRunOptions
-> IO ()
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]
[TemplateRef]
Maybe LicenseType
Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateRefs :: CommandRunOptions -> [TemplateRef]
croBuiltInTemplates :: CommandRunOptions -> Maybe LicenseType
croExcludeIgnoredPaths :: CommandRunOptions -> Bool
croExcludedPaths :: CommandRunOptions -> [Regex]
croSourcePaths :: CommandRunOptions -> [FilePath]
croRunMode :: CommandRunOptions -> Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateRefs :: [TemplateRef]
croBuiltInTemplates :: Maybe LicenseType
croExcludeIgnoredPaths :: Bool
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 {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
cExcludedPaths :: forall (p :: Phase). Configuration p -> p ::: [Regex]
cSourcePaths :: forall (p :: Phase). Configuration p -> p ::: [FilePath]
cRunMode :: forall (p :: Phase). Configuration p -> p ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
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
Map FileType HeaderTemplate
templates <- RIO Env (Map FileType HeaderTemplate)
forall env.
(Has CtConfiguration env, Has (FileSystem (RIO env)) env,
Has (Network (RIO env)) env, HasLogFunc env) =>
RIO env (Map FileType HeaderTemplate)
loadTemplates
[FilePath]
sourceFiles <- [FileType] -> RIO Env [FilePath]
forall env.
(Has CtConfiguration env, Has (FileSystem (RIO env)) env,
HasLogFunc env) =>
[FileType] -> RIO env [FilePath]
findSourceFiles (Map FileType HeaderTemplate -> [FileType]
forall k a. Map k a -> [k]
M.keys Map FileType HeaderTemplate
templates)
()
_ <- Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"-----"
(Int
total, Int
processed) <- Map FileType HeaderTemplate -> [FilePath] -> RIO Env (Int, Int)
forall a env.
(Template a, Has CtConfiguration env, Has CtPostProcessConfigs env,
Has CommandRunOptions env, Has CurrentYear env, HasLogFunc env) =>
Map FileType HeaderTemplate -> [FilePath] -> RIO env (Int, Int)
processSourceFiles @TemplateType Map FileType HeaderTemplate
templates [FilePath]
sourceFiles
POSIXTime
endTS <- IO POSIXTime -> RIO Env POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
processed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (RIO Env () -> RIO Env ()) -> RIO Env () -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone Utf8Builder
"-----"
Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logStickyDone (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
" files 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
" seconds."
]
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]
[TemplateRef]
Maybe LicenseType
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateRefs :: [TemplateRef]
croBuiltInTemplates :: Maybe LicenseType
croExcludeIgnoredPaths :: Bool
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateRefs :: CommandRunOptions -> [TemplateRef]
croBuiltInTemplates :: CommandRunOptions -> Maybe LicenseType
croExcludeIgnoredPaths :: CommandRunOptions -> Bool
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 {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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
[FilePath]
notIgnored <- [Regex] -> [FilePath] -> [FilePath]
excludePaths [Regex]
'Complete ::: [Regex]
cExcludedPaths ([FilePath] -> [FilePath])
-> RIO env [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> RIO env [FilePath]
forall env.
(Has CtConfiguration env, Has (FileSystem (RIO env)) env,
HasLogFunc env) =>
[FilePath] -> RIO env [FilePath]
excludeIgnored [FilePath]
files
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo [iii|
Found #{length notIgnored} files to process
(excluded #{length files - length notIgnored})
|]
[FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
notIgnored
excludeIgnored :: ( Has CtConfiguration env
, Has (FileSystem (RIO env)) env
, HasLogFunc env
)
=> [FilePath]
-> RIO env [FilePath]
excludeIgnored :: [FilePath] -> RIO env [FilePath]
excludeIgnored [FilePath]
paths = do
Configuration {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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
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
currentDir <- GetCurrentDirectoryFn (RIO env)
fsGetCurrentDirectory
Maybe Git
maybeRepo <- RIO env Bool
-> RIO env (Maybe Git)
-> RIO env (Maybe Git)
-> RIO env (Maybe Git)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
'Complete ::: Bool
cExcludeIgnoredPaths)
(FilePath -> RIO env (Maybe Git)
findRepo' FilePath
currentDir)
(Maybe Git -> RIO env (Maybe Git)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Git
forall a. Maybe a
Nothing)
case Maybe Git
maybeRepo of
Just Git
repo -> DoesFileExistFn (RIO env) -> [FilePath] -> RIO env [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> RIO env Bool -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (RIO env Bool -> RIO env Bool)
-> DoesFileExistFn (RIO env) -> DoesFileExistFn (RIO env)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Git -> DoesFileExistFn (RIO env)
forall r (m :: * -> *).
(Repo r, MonadIO m) =>
r -> FilePath -> m Bool
isIgnored Git
repo) [FilePath]
paths
Maybe Git
Nothing -> [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
paths
where
findRepo' :: FilePath -> RIO env (Maybe Git)
findRepo' = \FilePath
dir -> do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Searching for VCS repository to extract exclude patterns from..."
Maybe Git
maybeRepo <- FilePath -> RIO env (Maybe Git)
forall (m :: * -> *) r.
(MonadIO m, Repo r) =>
FilePath -> m (Maybe r)
findRepo @_ @Git FilePath
dir
case Maybe Git
maybeRepo of
Just Git
r -> Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo [i|Found #{repoName r} repository in: #{dir}|]
Maybe Git
_ -> Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo [i|No VCS repository found in: #{dir}|]
Maybe Git -> RIO env (Maybe Git)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Git
maybeRepo
processSourceFiles :: forall a env
. ( Template a
, Has CtConfiguration env
, Has CtPostProcessConfigs env
, Has CommandRunOptions env
, Has CurrentYear env
, HasLogFunc env
)
=> Map FileType HeaderTemplate
-> [FilePath]
-> RIO env (Int, Int)
processSourceFiles :: Map FileType HeaderTemplate -> [FilePath] -> RIO env (Int, Int)
processSourceFiles Map FileType HeaderTemplate
templates [FilePath]
paths = do
Configuration {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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
withTemplate :: [(HeaderTemplate, FilePath)]
withTemplate = (FilePath -> Maybe (HeaderTemplate, FilePath))
-> [FilePath] -> [(HeaderTemplate, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HeadersConfig 'Complete
-> FilePath -> Maybe (HeaderTemplate, FilePath)
template HeadersConfig 'Complete
cLicenseHeaders) [FilePath]
paths
Variables
cVars <- Variables -> RIO env Variables
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
Variables -> m Variables
compileVariables @a (Variables
dVars Variables -> Variables -> Variables
forall a. Semigroup a => a -> a -> a
<> Variables
cVariables)
[Bool]
processed <- ((Progress, (HeaderTemplate, FilePath)) -> RIO env Bool)
-> [(Progress, (HeaderTemplate, 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, (HeaderTemplate, FilePath))
-> RIO env Bool
forall env.
(Has CtConfiguration env, Has CtPostProcessConfigs env,
Has CommandRunOptions env, Has CurrentYear env, HasLogFunc env) =>
Variables
-> Variables
-> (Progress, (HeaderTemplate, FilePath))
-> RIO env Bool
process Variables
cVars Variables
dVars) ([(HeaderTemplate, FilePath)]
-> [(Progress, (HeaderTemplate, FilePath))]
forall a. [a] -> [(Progress, a)]
zipWithProgress [(HeaderTemplate, FilePath)]
withTemplate)
(Int, Int) -> RIO env (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(HeaderTemplate, FilePath)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(HeaderTemplate, FilePath)]
withTemplate, [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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
fileType :: HeadersConfig 'Complete -> FilePath -> Maybe FileType
fileType HeadersConfig 'Complete
c FilePath
p = FilePath -> Maybe Text
fileExtension FilePath
p 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
c
template :: HeadersConfig 'Complete
-> FilePath -> Maybe (HeaderTemplate, FilePath)
template HeadersConfig 'Complete
c FilePath
p = (, FilePath
p) (HeaderTemplate -> (HeaderTemplate, FilePath))
-> Maybe HeaderTemplate -> Maybe (HeaderTemplate, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HeadersConfig 'Complete -> FilePath -> Maybe FileType
fileType HeadersConfig 'Complete
c FilePath
p Maybe FileType
-> (FileType -> Maybe HeaderTemplate) -> Maybe HeaderTemplate
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FileType
ft -> FileType -> Map FileType HeaderTemplate -> Maybe HeaderTemplate
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileType
ft Map FileType HeaderTemplate
templates)
process :: Variables
-> Variables
-> (Progress, (HeaderTemplate, FilePath))
-> RIO env Bool
process Variables
cVars Variables
dVars (Progress
pr, (HeaderTemplate
ht, FilePath
p)) = Variables
-> Variables
-> Progress
-> HeaderTemplate
-> FilePath
-> RIO env Bool
forall a env.
(Template a, Has CommandRunOptions env, Has CtConfiguration env,
Has CtPostProcessConfigs env, Has CurrentYear env,
HasLogFunc env) =>
Variables
-> Variables
-> Progress
-> HeaderTemplate
-> FilePath
-> RIO env Bool
processSourceFile @a Variables
cVars Variables
dVars Progress
pr HeaderTemplate
ht FilePath
p
processSourceFile :: forall a env
. ( Template a
, Has CommandRunOptions env
, Has CtConfiguration env
, Has CtPostProcessConfigs env
, Has CurrentYear env
, HasLogFunc env
)
=> Variables
-> Variables
-> Progress
-> HeaderTemplate
-> FilePath
-> RIO env Bool
processSourceFile :: Variables
-> Variables
-> Progress
-> HeaderTemplate
-> FilePath
-> RIO env Bool
processSourceFile Variables
cVars Variables
dVars Progress
progress ht :: HeaderTemplate
ht@HeaderTemplate {TemplateData
FileType
TemplateType
CtHeaderConfig
htTemplate :: HeaderTemplate -> TemplateType
htFileType :: HeaderTemplate -> FileType
htTemplateData :: HeaderTemplate -> TemplateData
htConfig :: HeaderTemplate -> CtHeaderConfig
htTemplate :: TemplateType
htFileType :: FileType
htTemplateData :: TemplateData
htConfig :: CtHeaderConfig
..} FilePath
path = do
Configuration {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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]
[TemplateRef]
Maybe LicenseType
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateRefs :: [TemplateRef]
croBuiltInTemplates :: Maybe LicenseType
croExcludeIgnoredPaths :: Bool
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateRefs :: CommandRunOptions -> [TemplateRef]
croBuiltInTemplates :: CommandRunOptions -> Maybe LicenseType
croExcludeIgnoredPaths :: CommandRunOptions -> Bool
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 fs :: FileSupport
fs = FileType -> FileSupport
fileSupport FileType
htFileType
source :: SourceCode
source = FileSupport -> Text -> SourceCode
analyzeSourceCode FileSupport
fs Text
fileContent
headerInfo :: HeaderInfo
headerInfo@HeaderInfo {Maybe (Int, Int)
FileType
Variables
CtHeaderConfig
hiVariables :: HeaderInfo -> Variables
hiHeaderPos :: HeaderInfo -> Maybe (Int, Int)
hiHeaderConfig :: HeaderInfo -> CtHeaderConfig
hiFileType :: HeaderInfo -> FileType
hiVariables :: Variables
hiHeaderPos :: Maybe (Int, Int)
hiHeaderConfig :: CtHeaderConfig
hiFileType :: FileType
..} = HeaderTemplate -> SourceCode -> HeaderInfo
extractHeaderInfo HeaderTemplate
ht SourceCode
source
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
hiVariables
syntax :: 'Complete ::: HeaderSyntax
syntax = CtHeaderConfig -> 'Complete ::: HeaderSyntax
forall (p :: Phase). HeaderConfig p -> p ::: HeaderSyntax
hcHeaderSyntax CtHeaderConfig
hiHeaderConfig
Text
header' <- Variables -> TemplateType -> RIO env Text
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
Variables -> a -> m Text
renderTemplate Variables
variables TemplateType
htTemplate
Text
header <- HeaderSyntax -> Variables -> Text -> RIO env Text
forall a env.
(Template a, Has CtPostProcessConfigs env, Has CurrentYear env) =>
HeaderSyntax -> Variables -> Text -> RIO env Text
postProcessHeader' @a HeaderSyntax
syntax Variables
variables Text
header'
RunAction {Bool
Text
SourceCode -> SourceCode
raSkippedMsg :: Text
raProcessedMsg :: Text
raFunc :: SourceCode -> SourceCode
raProcessed :: Bool
raSkippedMsg :: RunAction -> Text
raProcessedMsg :: RunAction -> Text
raFunc :: RunAction -> SourceCode -> SourceCode
raProcessed :: RunAction -> Bool
..} <- HeaderInfo -> Text -> RIO env RunAction
forall env.
Has CtConfiguration env =>
HeaderInfo -> Text -> RIO env RunAction
chooseAction HeaderInfo
headerInfo Text
header
let result :: SourceCode
result = SourceCode -> SourceCode
raFunc SourceCode
source
changed :: Bool
changed = Bool
raProcessed Bool -> Bool -> Bool
&& (SourceCode
source SourceCode -> SourceCode -> Bool
forall a. Eq a => a -> a -> Bool
/= SourceCode
result)
message :: Text
message = if Bool
changed then Text
raProcessedMsg else Text
raSkippedMsg
logFn :: Utf8Builder -> RIO env ()
logFn = if Bool
changed then Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo else Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
logSticky
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
"Header info: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> HeaderInfo -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow HeaderInfo
headerInfo
Utf8Builder -> RIO env ()
logFn (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 -> RIO env ()) -> Text -> RIO env ()
forall a b. (a -> b) -> a -> b
$ SourceCode -> Text
toText SourceCode
result)
Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
changed
chooseAction :: (Has CtConfiguration env)
=> HeaderInfo
-> Text
-> RIO env RunAction
chooseAction :: HeaderInfo -> Text -> RIO env RunAction
chooseAction HeaderInfo
info Text
header = do
Configuration {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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
$ HeaderInfo -> Maybe (Int, Int)
hiHeaderPos HeaderInfo
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 -> (SourceCode -> SourceCode) -> Text -> Text -> RunAction
RunAction (Bool -> Bool
not Bool
hasHeader)
(HeaderInfo -> Text -> SourceCode -> SourceCode
addHeader HeaderInfo
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 -> (SourceCode -> SourceCode) -> Text -> Text -> RunAction
RunAction Bool
hasHeader
(HeaderInfo -> SourceCode -> SourceCode
dropHeader HeaderInfo
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 -> (SourceCode -> SourceCode) -> Text -> Text -> RunAction
RunAction Bool
True
(HeaderInfo -> Text -> SourceCode -> SourceCode
replaceHeader HeaderInfo
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
' '
loadTemplateRefs :: forall a env
. ( Template a
, Has (Network (RIO env)) env
, Has (FileSystem (RIO env)) env
, HasLogFunc env
)
=> [TemplateRef]
-> RIO env (Map FileType a)
loadTemplateRefs :: [TemplateRef] -> RIO env (Map FileType a)
loadTemplateRefs [TemplateRef]
refs = do
FileSystem (RIO env)
fileSystem <- RIO env (FileSystem (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
Network (RIO env)
network <- RIO env (Network (RIO env))
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
[TemplateRef]
allRefs <- [[TemplateRef]] -> [TemplateRef]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TemplateRef]] -> [TemplateRef])
-> RIO env [[TemplateRef]] -> RIO env [TemplateRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TemplateRef -> RIO env [TemplateRef])
-> [TemplateRef] -> RIO env [[TemplateRef]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileSystem (RIO env) -> TemplateRef -> RIO env [TemplateRef]
getAllRefs FileSystem (RIO env)
fileSystem) [TemplateRef]
refs
[(FileType, TemplateRef)]
refsWTp <- (\[(Maybe FileType, TemplateRef)]
rs -> [ (FileType
ft, TemplateRef
ref) | (Just FileType
ft, TemplateRef
ref) <- [(Maybe FileType, TemplateRef)]
rs ]) ([(Maybe FileType, TemplateRef)] -> [(FileType, TemplateRef)])
-> RIO env [(Maybe FileType, TemplateRef)]
-> RIO env [(FileType, TemplateRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TemplateRef] -> RIO env [(Maybe FileType, TemplateRef)]
zipRs [TemplateRef]
allRefs
[(FileType, TemplateRef, Text)]
refsWCtn <- ((FileType, TemplateRef) -> RIO env (FileType, TemplateRef, Text))
-> [(FileType, TemplateRef)]
-> RIO env [(FileType, TemplateRef, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileSystem (RIO env)
-> Network (RIO env)
-> (FileType, TemplateRef)
-> RIO env (FileType, TemplateRef, Text)
forall t.
FileSystem (RIO env)
-> Network (RIO env)
-> (t, TemplateRef)
-> RIO env (t, TemplateRef, Text)
loadContent FileSystem (RIO env)
fileSystem Network (RIO env)
network) ([(FileType, TemplateRef)] -> [(FileType, TemplateRef)]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
filterPreferred [(FileType, TemplateRef)]
refsWTp)
[(FileType, a)] -> Map FileType a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FileType, a)] -> Map FileType a)
-> RIO env [(FileType, a)] -> RIO env (Map FileType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FileType, TemplateRef, Text) -> RIO env (FileType, a))
-> [(FileType, TemplateRef, Text)] -> RIO env [(FileType, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileType, TemplateRef, Text) -> RIO env (FileType, a)
forall t. (t, TemplateRef, Text) -> RIO env (t, a)
loadTemplate [(FileType, TemplateRef, Text)]
refsWCtn
where
zipRs :: [TemplateRef] -> RIO env [(Maybe FileType, TemplateRef)]
zipRs = \[TemplateRef]
rs -> ([Maybe FileType] -> [(Maybe FileType, TemplateRef)])
-> RIO env [Maybe FileType]
-> RIO env [(Maybe FileType, TemplateRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe FileType]
-> [TemplateRef] -> [(Maybe FileType, TemplateRef)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [TemplateRef]
rs) (RIO env [Maybe FileType]
-> RIO env [(Maybe FileType, TemplateRef)])
-> ([TemplateRef] -> RIO env [Maybe FileType])
-> [TemplateRef]
-> RIO env [(Maybe FileType, TemplateRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemplateRef -> RIO env (Maybe FileType))
-> [TemplateRef] -> RIO env [Maybe FileType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TemplateRef -> RIO env (Maybe FileType)
getFileType ([TemplateRef] -> RIO env [(Maybe FileType, TemplateRef)])
-> [TemplateRef] -> RIO env [(Maybe FileType, TemplateRef)]
forall a b. (a -> b) -> a -> b
$ [TemplateRef]
rs
exts :: [Text]
exts = 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 a => NonEmpty Text
forall a. Template a => NonEmpty Text
templateExtensions @a
getAllRefs :: FileSystem (RIO env) -> TemplateRef -> RIO env [TemplateRef]
getAllRefs = \FileSystem (RIO env)
fs TemplateRef
ref -> case TemplateRef
ref of
LocalTemplateRef FilePath
p -> (FilePath -> TemplateRef) -> [FilePath] -> [TemplateRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> TemplateRef
LocalTemplateRef ([FilePath] -> [TemplateRef])
-> RIO env [FilePath] -> RIO env [TemplateRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileSystem (RIO env) -> FindFilesByExtsFn (RIO env)
forall (m :: * -> *). FileSystem m -> FindFilesByExtsFn m
fsFindFilesByExts FileSystem (RIO env)
fs FilePath
p [Text]
exts
TemplateRef
_ -> [TemplateRef] -> RIO env [TemplateRef]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TemplateRef
ref]
loadContent :: FileSystem (RIO env)
-> Network (RIO env)
-> (t, TemplateRef)
-> RIO env (t, TemplateRef, Text)
loadContent = \FileSystem (RIO env)
fs Network (RIO env)
n (t
ft, TemplateRef
ref) -> (t
ft, TemplateRef
ref, ) (Text -> (t, TemplateRef, Text))
-> RIO env Text -> RIO env (t, TemplateRef, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case TemplateRef
ref of
InlineRef Text
content -> Text -> RIO env Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
content
LocalTemplateRef FilePath
path -> FileSystem (RIO env) -> LoadFileFn (RIO env)
forall (m :: * -> *). FileSystem m -> LoadFileFn m
fsLoadFile FileSystem (RIO env)
fs FilePath
path
UriTemplateRef URI
uri -> Network (RIO env) -> DownloadContentFn (RIO env)
forall (m :: * -> *). Network m -> DownloadContentFn m
nDownloadContent Network (RIO env)
n URI
uri
BuiltInRef LicenseType
lt FileType
ft' -> Text -> RIO env Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> RIO env Text) -> Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ LicenseType -> FileType -> Text
forall a. IsString a => LicenseType -> FileType -> a
licenseTemplate LicenseType
lt FileType
ft'
loadTemplate :: (t, TemplateRef, Text) -> RIO env (t, a)
loadTemplate = \(t
ft, TemplateRef
ref, Text -> Text
T.strip -> Text
c) -> (t
ft, ) (a -> (t, a)) -> RIO env a -> RIO env (t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TemplateRef -> Text -> RIO env a
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
TemplateRef -> Text -> m a
parseTemplate @a TemplateRef
ref Text
c
getFileType :: TemplateRef -> RIO env (Maybe FileType)
getFileType = \case
InlineRef Text
_ -> Maybe FileType -> RIO env (Maybe FileType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FileType
forall a. Maybe a
Nothing
BuiltInRef LicenseType
_ FileType
ft -> Maybe FileType -> RIO env (Maybe FileType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileType -> RIO env (Maybe FileType))
-> (FileType -> Maybe FileType)
-> FileType
-> RIO env (Maybe FileType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileType -> Maybe FileType
forall a. a -> Maybe a
Just (FileType -> RIO env (Maybe FileType))
-> FileType -> RIO env (Maybe FileType)
forall a b. (a -> b) -> a -> b
$ FileType
ft
TemplateRef
other -> FilePath -> RIO env (Maybe FileType)
forall env. HasLogFunc env => FilePath -> RIO env (Maybe FileType)
typeOfTemplate (FilePath -> RIO env (Maybe FileType))
-> (TemplateRef -> FilePath)
-> TemplateRef
-> RIO env (Maybe FileType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> (TemplateRef -> Text) -> TemplateRef -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateRef -> Text
renderRef (TemplateRef -> RIO env (Maybe FileType))
-> TemplateRef -> RIO env (Maybe FileType)
forall a b. (a -> b) -> a -> b
$ TemplateRef
other
filterPreferred :: [(a, b)] -> [(a, b)]
filterPreferred [(a, b)]
rs =
([(a, b)] -> Maybe (a, b)) -> [[(a, b)]] -> [(a, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([(a, b)] -> Maybe (a, b)
forall a. [a] -> Maybe a
L.headMaybe ([(a, b)] -> Maybe (a, b))
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> Maybe (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)]
forall a. Ord a => [a] -> [a]
L.sort) ([[(a, b)]] -> [(a, b)])
-> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\(a, b)
x (a, b)
y -> (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
y) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
rs
loadTemplates :: ( Has CtConfiguration env
, Has (FileSystem (RIO env)) env
, Has (Network (RIO env)) env
, HasLogFunc env
)
=> RIO env (Map FileType HeaderTemplate)
loadTemplates :: RIO env (Map FileType HeaderTemplate)
loadTemplates = do
Configuration {[TemplateRef]
Variables
HeadersConfig 'Complete
CtPostProcessConfigs
'Complete ::: Bool
'Complete ::: [FilePath]
'Complete ::: [Regex]
'Complete ::: Maybe LicenseType
'Complete ::: RunMode
cPostProcessConfigs :: CtPostProcessConfigs
cLicenseHeaders :: HeadersConfig 'Complete
cVariables :: Variables
cTemplateRefs :: [TemplateRef]
cBuiltInTemplates :: 'Complete ::: Maybe LicenseType
cExcludeIgnoredPaths :: 'Complete ::: Bool
cExcludedPaths :: 'Complete ::: [Regex]
cSourcePaths :: 'Complete ::: [FilePath]
cRunMode :: 'Complete ::: RunMode
cPostProcessConfigs :: forall (p :: Phase). Configuration p -> PostProcessConfigs p
cLicenseHeaders :: forall (p :: Phase). Configuration p -> HeadersConfig p
cVariables :: forall (p :: Phase). Configuration p -> Variables
cTemplateRefs :: forall (p :: Phase). Configuration p -> [TemplateRef]
cBuiltInTemplates :: forall (p :: Phase). Configuration p -> p ::: Maybe LicenseType
cExcludeIgnoredPaths :: forall (p :: Phase). Configuration p -> p ::: Bool
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 allRefs :: [TemplateRef]
allRefs = Maybe LicenseType -> [TemplateRef]
builtInRefs Maybe LicenseType
'Complete ::: Maybe LicenseType
cBuiltInTemplates [TemplateRef] -> [TemplateRef] -> [TemplateRef]
forall a. Semigroup a => a -> a -> a
<> [TemplateRef]
cTemplateRefs
Map FileType TemplateType
templates <- [TemplateRef] -> RIO env (Map FileType TemplateType)
forall a env.
(Template a, Has (Network (RIO env)) env,
Has (FileSystem (RIO env)) env, HasLogFunc env) =>
[TemplateRef] -> RIO env (Map FileType a)
loadTemplateRefs @TemplateType [TemplateRef]
allRefs
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ())
-> (Map FileType TemplateType -> Utf8Builder)
-> Map FileType TemplateType
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table2 -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Table2 -> Utf8Builder)
-> (Map FileType TemplateType -> Table2)
-> Map FileType TemplateType
-> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FileType, TemplateType)] -> Table2
stats ([(FileType, TemplateType)] -> Table2)
-> (Map FileType TemplateType -> [(FileType, TemplateType)])
-> Map FileType TemplateType
-> Table2
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 (Map FileType TemplateType -> RIO env ())
-> Map FileType TemplateType -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Map FileType TemplateType
templates
Map FileType HeaderTemplate
-> RIO env (Map FileType HeaderTemplate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FileType HeaderTemplate
-> RIO env (Map FileType HeaderTemplate))
-> Map FileType HeaderTemplate
-> RIO env (Map FileType HeaderTemplate)
forall a b. (a -> b) -> a -> b
$ (FileType -> TemplateType -> HeaderTemplate)
-> Map FileType TemplateType -> Map FileType HeaderTemplate
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (HeadersConfig 'Complete
-> FileType -> TemplateType -> HeaderTemplate
extractHeaderTemplate HeadersConfig 'Complete
cLicenseHeaders) Map FileType TemplateType
templates
where
stats :: [(FileType, TemplateType)] -> Table2
stats = [(Text, Text)] -> Table2
Table2 ([(Text, Text)] -> Table2)
-> ([(FileType, TemplateType)] -> [(Text, Text)])
-> [(FileType, TemplateType)]
-> Table2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FileType, TemplateType) -> (Text, Text))
-> [(FileType, TemplateType)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(FileType
ft, TemplateType
t) -> ([i|Using #{ft} template:|], TemplateRef -> Text
renderRef (TemplateRef -> Text)
-> (TemplateType -> TemplateRef) -> TemplateType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateType -> TemplateRef
forall a. Template a => a -> TemplateRef
templateRef (TemplateType -> Text) -> TemplateType -> Text
forall a b. (a -> b) -> a -> b
$ TemplateType
t))
builtInRefs :: Maybe LicenseType -> [TemplateRef]
builtInRefs = \case
Just LicenseType
lt -> (FileType -> TemplateRef) -> [FileType] -> [TemplateRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LicenseType -> FileType -> TemplateRef
BuiltInRef LicenseType
lt) ([FileType] -> [TemplateRef]) -> [FileType] -> [TemplateRef]
forall a b. (a -> b) -> a -> b
$ EnumExtra FileType => [FileType]
forall a. EnumExtra a => [a]
allValues @FileType
Maybe LicenseType
_ -> []
typeOfTemplate :: HasLogFunc env
=> FilePath
-> RIO env (Maybe FileType)
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, MonadThrow 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 >"
, Utf8Builder
forall a. IsString a => a
configFileName
, Utf8Builder
"'. 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
forall a. IsString a => a
configFileName
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]
[TemplateRef]
Maybe LicenseType
Maybe RunMode
croDryRun :: Bool
croDebug :: Bool
croVariables :: [Text]
croTemplateRefs :: [TemplateRef]
croBuiltInTemplates :: Maybe LicenseType
croExcludeIgnoredPaths :: Bool
croExcludedPaths :: [Regex]
croSourcePaths :: [FilePath]
croRunMode :: Maybe RunMode
croDryRun :: CommandRunOptions -> Bool
croVariables :: CommandRunOptions -> [Text]
croTemplateRefs :: CommandRunOptions -> [TemplateRef]
croBuiltInTemplates :: CommandRunOptions -> Maybe LicenseType
croExcludeIgnoredPaths :: CommandRunOptions -> Bool
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 ::: Bool)
-> (p ::: Maybe LicenseType)
-> [TemplateRef]
-> Variables
-> HeadersConfig p
-> PostProcessConfigs 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
, cExcludeIgnoredPaths :: 'Partial ::: Bool
cExcludeIgnoredPaths = (Bool -> Bool) -> Bool -> Last Bool
forall (f :: * -> *) a.
(Monoid (f a), Applicative f) =>
(a -> Bool) -> a -> f a
ifNot (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) Bool
croExcludeIgnoredPaths
, cBuiltInTemplates :: 'Partial ::: Maybe LicenseType
cBuiltInTemplates = Maybe LicenseType -> Last (Maybe LicenseType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LicenseType
croBuiltInTemplates
, cTemplateRefs :: [TemplateRef]
cTemplateRefs = [TemplateRef]
croTemplateRefs
, cVariables :: Variables
cVariables = Variables
variables
, cLicenseHeaders :: HeadersConfig 'Partial
cLicenseHeaders = HeadersConfig 'Partial
forall a. Monoid a => a
mempty
, cPostProcessConfigs :: PostProcessConfigs 'Partial
cPostProcessConfigs = PostProcessConfigs '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
postProcessHeader' :: forall a env
. ( Template a
, Has CtPostProcessConfigs env
, Has CurrentYear env
)
=> HeaderSyntax
-> Variables
-> Text
-> RIO env Text
HeaderSyntax
syntax Variables
vars Text
rawHeader = do
CtPostProcessConfigs
configs <- forall t (m :: * -> *).
(Has CtPostProcessConfigs t, MonadReader t m) =>
m CtPostProcessConfigs
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL @CtPostProcessConfigs
CurrentYear
year <- RIO env CurrentYear
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
ConfiguredEnv
cEnv <- CurrentYear
-> Variables -> CtPostProcessConfigs -> RIO env ConfiguredEnv
forall a (m :: * -> *).
(Template a, MonadThrow m) =>
CurrentYear -> Variables -> CtPostProcessConfigs -> m ConfiguredEnv
mkConfiguredEnv @a CurrentYear
year Variables
vars CtPostProcessConfigs
configs
Text -> RIO env Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> RIO env Text) -> (Text -> Text) -> Text -> RIO env Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderSyntax -> Text -> Text
sanitizeSyntax 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 -> RIO env Text) -> Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ Text
rawHeader