{-# 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
Description : Handler for the @run@ command.
Copyright   : (c) 2019-2021 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
  , loadTemplateRefs
  , typeOfTemplate
    -- * License Header Post-processing
  , 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


-- | Action to be performed based on the selected 'RunMode'.
data RunAction = RunAction
  { RunAction -> Bool
raProcessed    :: Bool -- ^ whether the given file was processed
  , RunAction -> SourceCode -> SourceCode
raFunc         :: SourceCode -> SourceCode -- ^ 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 -> Network (RIO Env)
envNetwork       :: Network (RIO Env)    -- ^ network operations
  , 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 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
.. }


-- | 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]
[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
' '


-- | Loads templates using given template references. If multiple sources define
-- template for the same 'FileType', then the preferred one (based on ordering
-- of 'TemplateRef' is selected).
loadTemplateRefs :: forall a env
                  . ( Template a
                    , Has (Network (RIO env)) env
                    , Has (FileSystem (RIO env)) env
                    , HasLogFunc env
                    )
                 => [TemplateRef]            -- ^ template references
                 -> RIO env (Map FileType a) -- ^ map of templates
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
_       -> []


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


-- | Performs post-processing on rendered /license header/, based on given
-- configuration. Currently the main points are to:
--
--  1. sanitize possibly corrupted comment syntax ('sanitizeSyntax')
--  2. apply /post-processors/ ('postProcessHeader')
postProcessHeader' :: forall a env
                    . ( Template a
                      , Has CtPostProcessConfigs env
                      , Has CurrentYear env
                      )
                   => HeaderSyntax -- ^ syntax of the license header comments
                   -> Variables    -- ^ template variables
                   -> Text         -- ^ /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
  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