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

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

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

module Headroom.Command.Run
  ( commandRun
  )
where

import           Data.Time.Clock.POSIX          ( getPOSIXTime )
import           Headroom.Command.Utils         ( bootstrap )
import           Headroom.Configuration         ( loadConfiguration
                                                , makeConfiguration
                                                , parseConfiguration
                                                , parseVariables
                                                )
import           Headroom.Data.EnumExtra        ( EnumExtra(..) )
import           Headroom.Data.Has              ( Has(..) )
import           Headroom.Embedded              ( defaultConfig )
import           Headroom.FileSupport           ( addHeader
                                                , dropHeader
                                                , extractFileInfo
                                                , replaceHeader
                                                )
import           Headroom.FileSystem            ( excludePaths
                                                , fileExtension
                                                , findFilesByExts
                                                , findFilesByTypes
                                                , loadFile
                                                )
import           Headroom.FileType              ( configByFileType
                                                , fileTypeByExt
                                                )
import           Headroom.Meta                  ( TemplateType
                                                , productInfo
                                                )
import           Headroom.Template              ( Template(..) )
import           Headroom.Types                 ( CommandRunOptions(..)
                                                , Configuration(..)
                                                , FileInfo(..)
                                                , FileType(..)
                                                , PartialConfiguration(..)
                                                , RunAction(..)
                                                , RunMode(..)
                                                )
import           Headroom.UI                    ( Progress(..)
                                                , zipWithProgress
                                                )
import           RIO
import           RIO.FilePath                   ( takeBaseName )
import qualified RIO.List                      as L
import qualified RIO.Map                       as M
import qualified RIO.Text                      as T



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

-- | Full /RIO/ environment for the /Run/ command.
data Env = Env
  { Env -> StartupEnv
envEnv           :: !StartupEnv     -- ^ startup /RIO/ environment
  , Env -> Configuration
envConfiguration :: !Configuration  -- ^ application configuration
  }

instance Has Configuration Env where
  hasLens :: (Configuration -> f Configuration) -> Env -> f Env
hasLens = (Env -> Configuration)
-> (Env -> Configuration -> Env) -> Lens' Env Configuration
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Env -> Configuration
envConfiguration (\x :: Env
x y :: Configuration
y -> Env
x { envConfiguration :: Configuration
envConfiguration = Configuration
y })

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 = (Env -> StartupEnv)
-> (Env -> StartupEnv -> Env) -> Lens' Env StartupEnv
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Env -> StartupEnv
envEnv (\x :: Env
x y :: StartupEnv
y -> Env
x { envEnv :: StartupEnv
envEnv = StartupEnv
y })

instance HasLogFunc StartupEnv where
  logFuncL :: (LogFunc -> f LogFunc) -> StartupEnv -> f StartupEnv
logFuncL = (StartupEnv -> LogFunc)
-> (StartupEnv -> LogFunc -> StartupEnv)
-> Lens' StartupEnv LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StartupEnv -> LogFunc
envLogFunc (\x :: StartupEnv
x y :: LogFunc
y -> StartupEnv
x { envLogFunc :: LogFunc
envLogFunc = LogFunc
y })

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 = (StartupEnv -> CommandRunOptions)
-> (StartupEnv -> CommandRunOptions -> StartupEnv)
-> Lens' StartupEnv CommandRunOptions
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens StartupEnv -> CommandRunOptions
envRunOptions (\x :: StartupEnv
x y :: CommandRunOptions
y -> StartupEnv
x { envRunOptions :: CommandRunOptions
envRunOptions = CommandRunOptions
y })

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


env' :: CommandRunOptions -> LogFunc -> IO Env
env' :: CommandRunOptions -> LogFunc -> IO Env
env' opts :: CommandRunOptions
opts logFunc :: LogFunc
logFunc = do
  let startupEnv :: StartupEnv
startupEnv = $WStartupEnv :: LogFunc -> CommandRunOptions -> StartupEnv
StartupEnv { envLogFunc :: LogFunc
envLogFunc = LogFunc
logFunc, envRunOptions :: CommandRunOptions
envRunOptions = CommandRunOptions
opts }
  Configuration
merged <- StartupEnv -> RIO StartupEnv Configuration -> IO Configuration
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO StartupEnv
startupEnv RIO StartupEnv Configuration
forall env.
(HasLogFunc env, Has CommandRunOptions env) =>
RIO env Configuration
finalConfiguration
  Env -> IO Env
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> IO Env) -> Env -> IO Env
forall a b. (a -> b) -> a -> b
$ $WEnv :: StartupEnv -> Configuration -> Env
Env { envEnv :: StartupEnv
envEnv = StartupEnv
startupEnv, envConfiguration :: Configuration
envConfiguration = Configuration
merged }


-- | Handler for /Run/ command.
commandRun :: CommandRunOptions -- ^ /Run/ command options
           -> IO ()             -- ^ execution result
commandRun :: CommandRunOptions -> IO ()
commandRun opts :: 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 {..} <- RIO Env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Configuration {..}     <- RIO Env Configuration
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 ()
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
  let isCheck :: Bool
isCheck = 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 TemplateType
templates          <- RIO Env (Map FileType TemplateType)
forall env.
(Has Configuration env, HasLogFunc env) =>
RIO env (Map FileType TemplateType)
loadTemplates
  [FilePath]
sourceFiles        <- [FileType] -> RIO Env [FilePath]
forall env.
(Has Configuration env, HasLogFunc env) =>
[FileType] -> RIO env [FilePath]
findSourceFiles (Map FileType TemplateType -> [FileType]
forall k a. Map k a -> [k]
M.keys Map FileType TemplateType
templates)
  (total :: Int
total, processed :: Int
processed) <- Map FileType TemplateType -> [FilePath] -> RIO Env (Int, Int)
forall env.
(Has Configuration env, HasLogFunc env,
 Has CommandRunOptions env) =>
Map FileType TemplateType -> [FilePath] -> RIO env (Int, Int)
processSourceFiles Map FileType TemplateType
templates [FilePath]
sourceFiles
  POSIXTime
endTS              <- IO POSIXTime -> RIO Env POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "-----"
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO Env ()) -> Utf8Builder -> RIO Env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
    [ "Done: "
    , if Bool
isCheck then "outdated " else "modified "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
processed
    , if Bool
isCheck then ", up-to-date " else ", skipped "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
processed)
    , " file(s) in "
    , POSIXTime -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (POSIXTime
endTS POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
startTS)
    , " second(s)."
    ]
  RIO Env ()
forall env.
(HasLogFunc env, Has CommandRunOptions env) =>
RIO env ()
warnOnDryRun
  Bool -> RIO Env () -> RIO Env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
croDryRun Bool -> Bool -> Bool
&& Bool
isCheck Bool -> Bool -> Bool
&& Int
processed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 1)


warnOnDryRun :: (HasLogFunc env, Has CommandRunOptions env) => RIO env ()
warnOnDryRun :: RIO env ()
warnOnDryRun = do
  CommandRunOptions {..} <- 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 "[!] Running with '--dry-run', no files are changed!"


findSourceFiles :: (Has Configuration env, HasLogFunc env)
                => [FileType]
                -> RIO env [FilePath]
findSourceFiles :: [FileType] -> RIO env [FilePath]
findSourceFiles fileTypes :: [FileType]
fileTypes = do
  Configuration {..} <- RIO env Configuration
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
$ "Using source paths: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [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
<$> (FilePath -> RIO env [FilePath])
-> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HeadersConfig -> FilePath -> RIO env [FilePath]
forall (m :: * -> *).
MonadIO m =>
HeadersConfig -> FilePath -> m [FilePath]
findFiles' HeadersConfig
cLicenseHeaders) [FilePath]
cSourcePaths
  let files' :: [FilePath]
files' = [Text] -> [FilePath] -> [FilePath]
excludePaths [Text]
cExcludedPaths [FilePath]
files
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
    [ "Found "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files'
    , " source file(s) (excluded "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files Int -> Int -> Int
forall a. Num a => a -> a -> a
- [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
files'
    , " file(s))"
    ]
  [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
files'
  where findFiles' :: HeadersConfig -> FilePath -> m [FilePath]
findFiles' licenseHeaders :: HeadersConfig
licenseHeaders = HeadersConfig -> [FileType] -> FilePath -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
HeadersConfig -> [FileType] -> FilePath -> m [FilePath]
findFilesByTypes HeadersConfig
licenseHeaders [FileType]
fileTypes


processSourceFiles :: ( Has Configuration env
                      , HasLogFunc env
                      , Has CommandRunOptions env
                      )
                   => Map FileType TemplateType
                   -> [FilePath]
                   -> RIO env (Int, Int)
processSourceFiles :: Map FileType TemplateType -> [FilePath] -> RIO env (Int, Int)
processSourceFiles templates :: Map FileType TemplateType
templates paths :: [FilePath]
paths = do
  Configuration {..} <- RIO env Configuration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  let withFileType :: [(FileType, FilePath)]
withFileType = (FilePath -> Maybe (FileType, FilePath))
-> [FilePath] -> [(FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HeadersConfig -> FilePath -> Maybe (FileType, FilePath)
findFileType HeadersConfig
cLicenseHeaders) [FilePath]
paths
      withTemplate :: [(TemplateType, FileType, FilePath)]
withTemplate = ((FileType, FilePath) -> Maybe (TemplateType, FileType, FilePath))
-> [(FileType, FilePath)] -> [(TemplateType, FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((FileType -> FilePath -> Maybe (TemplateType, FileType, FilePath))
-> (FileType, FilePath) -> Maybe (TemplateType, FileType, FilePath)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FileType -> FilePath -> Maybe (TemplateType, FileType, FilePath)
forall t. FileType -> t -> Maybe (TemplateType, FileType, t)
findTemplate) [(FileType, FilePath)]
withFileType
  [Bool]
processed <- ((Progress, (TemplateType, FileType, FilePath)) -> RIO env Bool)
-> [(Progress, (TemplateType, FileType, FilePath))]
-> RIO env [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Progress, (TemplateType, FileType, FilePath)) -> RIO env Bool
forall env.
(HasLogFunc env, Has Configuration env,
 Has CommandRunOptions env) =>
(Progress, (TemplateType, FileType, FilePath)) -> RIO env Bool
process ([(TemplateType, FileType, FilePath)]
-> [(Progress, (TemplateType, FileType, FilePath))]
forall a. [a] -> [(Progress, a)]
zipWithProgress [(TemplateType, FileType, FilePath)]
withTemplate)
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug "foo"
  (Int, Int) -> RIO env (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(TemplateType, FileType, FilePath)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(TemplateType, FileType, FilePath)]
withTemplate, [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Bool] -> Int) -> ([Bool] -> [Bool]) -> [Bool] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ [Bool]
processed)
 where
  findFileType :: HeadersConfig -> FilePath -> Maybe (FileType, FilePath)
findFileType conf :: HeadersConfig
conf path :: FilePath
path =
    (FileType -> (FileType, FilePath))
-> Maybe FileType -> Maybe (FileType, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, FilePath
path) (FilePath -> Maybe Text
fileExtension FilePath
path Maybe Text -> (Text -> Maybe FileType) -> Maybe FileType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HeadersConfig -> Text -> Maybe FileType
fileTypeByExt HeadersConfig
conf)
  findTemplate :: FileType -> t -> Maybe (TemplateType, FileType, t)
findTemplate ft :: FileType
ft p :: t
p = (, FileType
ft, t
p) (TemplateType -> (TemplateType, FileType, t))
-> Maybe TemplateType -> Maybe (TemplateType, FileType, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileType -> Map FileType TemplateType -> Maybe TemplateType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileType
ft Map FileType TemplateType
templates
  process :: (Progress, (TemplateType, FileType, FilePath)) -> RIO env Bool
process (pr :: Progress
pr, (tt :: TemplateType
tt, ft :: FileType
ft, p :: FilePath
p)) = Progress -> TemplateType -> FileType -> FilePath -> RIO env Bool
forall env.
(Has Configuration env, HasLogFunc env,
 Has CommandRunOptions env) =>
Progress -> TemplateType -> FileType -> FilePath -> RIO env Bool
processSourceFile Progress
pr TemplateType
tt FileType
ft FilePath
p


processSourceFile :: ( Has Configuration env
                     , HasLogFunc env
                     , Has CommandRunOptions env
                     )
                  => Progress
                  -> TemplateType
                  -> FileType
                  -> FilePath
                  -> RIO env Bool
processSourceFile :: Progress -> TemplateType -> FileType -> FilePath -> RIO env Bool
processSourceFile progress :: Progress
progress template :: TemplateType
template fileType :: FileType
fileType path :: FilePath
path = do
  Configuration {..}     <- RIO env Configuration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  CommandRunOptions {..} <- RIO env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  Text
fileContent            <- FilePath -> RIO env Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
path
  let fileInfo :: FileInfo
fileInfo = FileType -> HeaderConfig -> Text -> FileInfo
extractFileInfo FileType
fileType
                                 (HeadersConfig -> FileType -> HeaderConfig
configByFileType HeadersConfig
cLicenseHeaders FileType
fileType)
                                 Text
fileContent
      variables :: HashMap Text Text
variables = HashMap Text Text
cVariables HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall a. Semigroup a => a -> a -> a
<> FileInfo -> HashMap Text Text
fiVariables FileInfo
fileInfo
  Text
header         <- HashMap Text Text -> TemplateType -> RIO env Text
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
HashMap Text Text -> t -> m Text
renderTemplate HashMap Text Text
variables TemplateType
template
  RunAction {..} <- FileInfo -> Text -> RIO env RunAction
forall env.
Has Configuration env =>
FileInfo -> Text -> RIO env RunAction
chooseAction FileInfo
fileInfo Text
header
  let result :: Text
result  = Text -> Text
raFunc Text
fileContent
      changed :: Bool
changed = Bool
raProcessed Bool -> Bool -> Bool
&& (Text
fileContent Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
result)
      message :: Text
message = if Bool
changed then Text
raProcessedMsg else Text
raSkippedMsg
      isCheck :: Bool
isCheck = RunMode
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
$ "File info: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FileInfo -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FileInfo
fileInfo
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Progress -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Progress
progress, " ", Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
message, FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path]
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
croDryRun Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isCheck Bool -> Bool -> Bool
&& Bool
changed) (FilePath -> Text -> RIO env ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
path Text
result)
  Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
changed


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


loadTemplates :: (Has Configuration env, HasLogFunc env)
              => RIO env (Map FileType TemplateType)
loadTemplates :: RIO env (Map FileType TemplateType)
loadTemplates = do
  Configuration {..} <- RIO env Configuration
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  [FilePath]
paths <- [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath])
-> RIO env [[FilePath]] -> RIO env [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> RIO env [FilePath])
-> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> [Text] -> RIO env [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> [Text] -> m [FilePath]
`findFilesByExts` [Text]
extensions) [FilePath]
cTemplatePaths
  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
$ "Using template paths: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
paths
  [(FileType, FilePath)]
withTypes <- [Maybe (FileType, FilePath)] -> [(FileType, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FileType, FilePath)] -> [(FileType, FilePath)])
-> RIO env [Maybe (FileType, FilePath)]
-> RIO env [(FileType, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> RIO env (Maybe (FileType, FilePath)))
-> [FilePath] -> RIO env [Maybe (FileType, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\p :: FilePath
p -> (FileType -> (FileType, FilePath))
-> Maybe FileType -> Maybe (FileType, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, FilePath
p) (Maybe FileType -> Maybe (FileType, FilePath))
-> RIO env (Maybe FileType) -> RIO env (Maybe (FileType, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RIO env (Maybe FileType)
forall env. HasLogFunc env => FilePath -> RIO env (Maybe FileType)
typeOfTemplate FilePath
p) [FilePath]
paths
  [(FileType, TemplateType)]
parsed    <- ((FileType, FilePath) -> RIO env (FileType, TemplateType))
-> [(FileType, FilePath)] -> RIO env [(FileType, TemplateType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(t :: FileType
t, p :: FilePath
p) -> (FileType
t, ) (TemplateType -> (FileType, TemplateType))
-> RIO env TemplateType -> RIO env (FileType, TemplateType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RIO env TemplateType
forall (m :: * -> *) a. (MonadIO m, Template a) => FilePath -> m a
load FilePath
p) [(FileType, FilePath)]
withTypes
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo
    (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat ["Found ", Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder) -> Int -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [(FileType, TemplateType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(FileType, TemplateType)]
parsed, " license template(s)"]
  Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FileType TemplateType -> RIO env (Map FileType TemplateType))
-> Map FileType TemplateType -> RIO env (Map FileType TemplateType)
forall a b. (a -> b) -> a -> b
$ [(FileType, TemplateType)] -> Map FileType TemplateType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FileType, TemplateType)]
parsed
 where
  extensions :: [Text]
extensions = NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Template TemplateType => NonEmpty Text
forall t. Template t => NonEmpty Text
templateExtensions @TemplateType
  load :: FilePath -> m a
load path :: FilePath
path =
    IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
loadFile FilePath
path) IO Text -> (Text -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> Text -> IO a
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
Maybe Text -> Text -> m t
parseTemplate (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
path)


typeOfTemplate :: HasLogFunc env => FilePath -> RIO env (Maybe FileType)
typeOfTemplate :: FilePath -> RIO env (Maybe FileType)
typeOfTemplate path :: 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
$ "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


finalConfiguration :: (HasLogFunc env, Has CommandRunOptions env)
                   => RIO env Configuration
finalConfiguration :: RIO env Configuration
finalConfiguration = do
  PartialConfiguration
defaultConfig' <- ByteString -> RIO env PartialConfiguration
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m PartialConfiguration
parseConfiguration ByteString
forall a. IsString a => a
defaultConfig
  PartialConfiguration
cmdLineConfig  <- RIO env PartialConfiguration
forall env.
Has CommandRunOptions env =>
RIO env PartialConfiguration
optionsToConfiguration
  PartialConfiguration
yamlConfig     <- FilePath -> RIO env PartialConfiguration
forall (m :: * -> *).
MonadIO m =>
FilePath -> m PartialConfiguration
loadConfiguration ".headroom.yaml"
  let mergedConfig :: PartialConfiguration
mergedConfig = PartialConfiguration
defaultConfig' PartialConfiguration
-> PartialConfiguration -> PartialConfiguration
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration
yamlConfig PartialConfiguration
-> PartialConfiguration -> PartialConfiguration
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration
cmdLineConfig
  Configuration
config <- PartialConfiguration -> RIO env Configuration
forall (m :: * -> *).
MonadThrow m =>
PartialConfiguration -> m Configuration
makeConfiguration PartialConfiguration
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
$ "Default config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow PartialConfiguration
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
$ "YAML config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow PartialConfiguration
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
$ "CmdLine config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow PartialConfiguration
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
$ "Merged config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> PartialConfiguration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow PartialConfiguration
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
$ "Final config: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Configuration -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Configuration
config
  Configuration -> RIO env Configuration
forall (f :: * -> *) a. Applicative f => a -> f a
pure Configuration
config


optionsToConfiguration :: (Has CommandRunOptions env)
                       => RIO env PartialConfiguration
optionsToConfiguration :: RIO env PartialConfiguration
optionsToConfiguration = do
  CommandRunOptions
runOptions <- RIO env CommandRunOptions
forall a t (m :: * -> *). (Has a t, MonadReader t m) => m a
viewL
  HashMap Text Text
variables  <- [Text] -> RIO env (HashMap Text Text)
forall (m :: * -> *).
MonadThrow m =>
[Text] -> m (HashMap Text Text)
parseVariables ([Text] -> RIO env (HashMap Text Text))
-> [Text] -> RIO env (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ CommandRunOptions -> [Text]
croVariables CommandRunOptions
runOptions
  PartialConfiguration -> RIO env PartialConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WPartialConfiguration :: Last RunMode
-> Last [FilePath]
-> Last [Text]
-> Last [FilePath]
-> Last (HashMap Text Text)
-> PartialHeadersConfig
-> PartialConfiguration
PartialConfiguration
    { pcRunMode :: Last RunMode
pcRunMode        = 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 (CommandRunOptions -> Maybe RunMode
croRunMode CommandRunOptions
runOptions)
    , pcSourcePaths :: Last [FilePath]
pcSourcePaths    = ([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 (CommandRunOptions -> [FilePath]
croSourcePaths CommandRunOptions
runOptions)
    , pcExcludedPaths :: Last [Text]
pcExcludedPaths  = ([Text] -> Bool) -> [Text] -> Last [Text]
forall (f :: * -> *) a.
(Monoid (f a), Applicative f) =>
(a -> Bool) -> a -> f a
ifNot [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CommandRunOptions -> [Text]
croExcludedPaths CommandRunOptions
runOptions)
    , pcTemplatePaths :: Last [FilePath]
pcTemplatePaths  = ([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 (CommandRunOptions -> [FilePath]
croTemplatePaths CommandRunOptions
runOptions)
    , pcVariables :: Last (HashMap Text Text)
pcVariables      = (HashMap Text Text -> Bool)
-> HashMap Text Text -> Last (HashMap Text Text)
forall (f :: * -> *) a.
(Monoid (f a), Applicative f) =>
(a -> Bool) -> a -> f a
ifNot HashMap Text Text -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
variables
    , pcLicenseHeaders :: PartialHeadersConfig
pcLicenseHeaders = PartialHeadersConfig
forall a. Monoid a => a
mempty
    }
  where ifNot :: (a -> Bool) -> a -> f a
ifNot cond :: a -> Bool
cond value :: 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