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

Logic for the @run@ command, used to add or replace license headers in source
code files.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
module Headroom.Command.Run
  ( commandRun
  )
where

import           Data.Time.Clock.POSIX          ( getPOSIXTime )
import           Headroom.AppConfig             ( AppConfig(..)
                                                , loadAppConfig
                                                , validateAppConfig
                                                )
import           Headroom.Command.Run.Env
import           Headroom.Command.Shared        ( bootstrap )
import           Headroom.FileSystem            ( fileExtension
                                                , findFilesByExts
                                                , findFilesByTypes
                                                )
import           Headroom.FileType              ( FileType
                                                , fileTypeByExt
                                                , fileTypeByName
                                                )
import           Headroom.Global                ( TemplateType )
import           Headroom.Header                ( Header(..)
                                                , addHeader
                                                , containsHeader
                                                , dropHeader
                                                , replaceHeader
                                                )
import           Headroom.Template              ( Template(..)
                                                , loadTemplate
                                                )
import           Headroom.Types                 ( RunMode(..) )
import           Headroom.UI.Progress           ( Progress(..) )
import           RIO                     hiding ( second )
import           RIO.Directory
import           RIO.FilePath                   ( takeBaseName
                                                , (</>)
                                                )
import qualified RIO.List                      as L
import qualified RIO.Map                       as M
import qualified RIO.Text                      as T


env' :: RunOptions -> LogFunc -> IO Env
env' :: RunOptions -> LogFunc -> IO Env
env' opts :: RunOptions
opts logFunc :: LogFunc
logFunc = do
  let startupEnv :: StartupEnv
startupEnv = $WStartupEnv :: LogFunc -> RunOptions -> StartupEnv
StartupEnv { envLogFunc :: LogFunc
envLogFunc = LogFunc
logFunc, envRunOptions :: RunOptions
envRunOptions = RunOptions
opts }
  AppConfig
merged <- StartupEnv -> RIO StartupEnv AppConfig -> IO AppConfig
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO StartupEnv
startupEnv RIO StartupEnv AppConfig
forall env.
(HasRunOptions env, HasLogFunc env) =>
RIO env AppConfig
mergedAppConfig
  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 -> AppConfig -> Env
Env { envEnv :: StartupEnv
envEnv = StartupEnv
startupEnv, envAppConfig :: AppConfig
envAppConfig = AppConfig
merged }

-- | Handler for /Run/ command.
commandRun :: RunOptions -- ^ /Run/ command options
           -> IO ()      -- ^ execution result
commandRun :: RunOptions -> IO ()
commandRun opts :: RunOptions
opts = (LogFunc -> IO Env) -> Bool -> RIO Env () -> IO ()
forall env a. (LogFunc -> IO env) -> Bool -> RIO env a -> IO a
bootstrap (RunOptions -> LogFunc -> IO Env
env' RunOptions
opts) (RunOptions -> Bool
roDebug RunOptions
opts) (RIO Env () -> IO ()) -> RIO Env () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  POSIXTime
startTS <- 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 "Loading source code header templates..."
  Map FileType Text
templates <- RIO Env (Map FileType Text)
forall env.
(HasAppConfig env, HasLogFunc env) =>
RIO env (Map FileType Text)
loadTemplates
  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
$ "Done, found " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Map FileType Text -> Int
forall k a. Map k a -> Int
M.size Map FileType Text
templates) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " template(s)"
  Utf8Builder -> RIO Env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "Searching for source code files..."
  [FilePath]
sourceFiles <- [FileType] -> RIO Env [FilePath]
forall env. HasAppConfig env => [FileType] -> RIO env [FilePath]
findSourceFiles (Map FileType Text -> [FileType]
forall k a. Map k a -> [k]
M.keys Map FileType Text
templates)
  let sourceFilesNum :: Utf8Builder
sourceFilesNum = Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int -> Utf8Builder)
-> ([FilePath] -> Int) -> [FilePath] -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([FilePath] -> Utf8Builder) -> [FilePath] -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ [FilePath]
sourceFiles
  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, found ", Utf8Builder
sourceFilesNum, " sources code files(s) to process"]
  (total :: Int
total, skipped :: Int
skipped) <- Map FileType Text -> [FilePath] -> RIO Env (Int, Int)
forall env.
(HasLogFunc env, HasRunOptions env) =>
Map FileType Text -> [FilePath] -> RIO env (Int, Int)
processHeaders Map FileType Text
templates [FilePath]
sourceFiles
  POSIXTime
endTS            <- IO POSIXTime -> RIO Env POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  let (elapsedSeconds :: Integer
elapsedSeconds, _) = POSIXTime -> (Integer, POSIXTime)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (POSIXTime
endTS POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
startTS)
  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: modified "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
skipped)
    , ", skipped "
    , Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Int
skipped
    , " files in "
    , Integer -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Integer
elapsedSeconds :: Integer)
    , " second(s)."
    ]

mergedAppConfig :: (HasRunOptions env, HasLogFunc env) => RIO env AppConfig
mergedAppConfig :: RIO env AppConfig
mergedAppConfig = do
  RunOptions
runOptions <- Getting RunOptions env RunOptions -> RIO env RunOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RunOptions env RunOptions
forall env. HasRunOptions env => Lens' env RunOptions
runOptionsL
  FilePath
configDir  <- XdgDirectory -> FilePath -> RIO env FilePath
forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> FilePath -> m FilePath
getXdgDirectory XdgDirectory
XdgConfig "headroom"
  FilePath
currDir    <- RIO env FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getCurrentDirectory
  let locations :: [FilePath]
locations = [FilePath
currDir FilePath -> FilePath -> FilePath
</> ".headroom.yaml", FilePath
configDir FilePath -> FilePath -> FilePath
</> "headroom.yaml"]
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "Loading configuration file(s)..."
  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
$ "Configuration files locations: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
locations
  [AppConfig]
appConfigs        <- ([Maybe AppConfig] -> [AppConfig])
-> RIO env [Maybe AppConfig] -> RIO env [AppConfig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe AppConfig] -> [AppConfig]
forall a. [Maybe a] -> [a]
catMaybes ((FilePath -> RIO env (Maybe AppConfig))
-> [FilePath] -> RIO env [Maybe AppConfig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO env (Maybe AppConfig)
forall env (m :: * -> *).
(MonadReader env m, MonadUnliftIO m, HasLogFunc env) =>
FilePath -> m (Maybe AppConfig)
loadAppConfigSafe [FilePath]
locations)
  AppConfig
appConfigFromOpts <- RunOptions -> RIO env AppConfig
forall (m :: * -> *). MonadThrow m => RunOptions -> m AppConfig
toAppConfig RunOptions
runOptions
  AppConfig
merged            <- [AppConfig] -> RIO env AppConfig
forall env (m :: * -> *) b.
(MonadReader env m, MonadIO m, HasLogFunc env, Show b, Monoid b) =>
[b] -> m b
mergeAppConfigs ([AppConfig] -> RIO env AppConfig)
-> [AppConfig] -> RIO env AppConfig
forall a b. (a -> b) -> a -> b
$ AppConfig
appConfigFromOpts AppConfig -> [AppConfig] -> [AppConfig]
forall a. a -> [a] -> [a]
: [AppConfig]
appConfigs
  AppConfig -> RIO env AppConfig
forall (m :: * -> *). MonadThrow m => AppConfig -> m AppConfig
validateAppConfig AppConfig
merged
 where
  loadAppConfigSafe :: FilePath -> m (Maybe AppConfig)
loadAppConfigSafe path :: FilePath
path = m (Maybe AppConfig)
-> (IOException -> m (Maybe AppConfig)) -> m (Maybe AppConfig)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
    ((AppConfig -> Maybe AppConfig)
-> m AppConfig -> m (Maybe AppConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AppConfig -> Maybe AppConfig
forall a. a -> Maybe a
Just (FilePath -> m AppConfig
forall (m :: * -> *). MonadIO m => FilePath -> m AppConfig
loadAppConfig FilePath
path))
    (\ex :: IOException
ex -> 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
ex :: IOException)
      Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ "Skipping missing configuration file: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path
      Maybe AppConfig -> m (Maybe AppConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AppConfig
forall a. Maybe a
Nothing
    )
  mergeAppConfigs :: [b] -> m b
mergeAppConfigs appConfigs :: [b]
appConfigs = do
    let merged :: b
merged = [b] -> b
forall a. Monoid a => [a] -> a
mconcat [b]
appConfigs
    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
$ "Source AppConfig instances: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [b] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [b]
appConfigs
    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
$ "Merged AppConfig: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> b -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow b
merged
    b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
merged

loadTemplates :: (HasAppConfig env, HasLogFunc env)
              => RIO env (M.Map FileType Text)
loadTemplates :: RIO env (Map FileType Text)
loadTemplates = do
  AppConfig
appConfig <- Getting AppConfig env AppConfig -> RIO env AppConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AppConfig env AppConfig
forall env. HasAppConfig env => Lens' env AppConfig
appConfigL
  [FilePath]
paths     <- IO [FilePath] -> RIO env [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
findPaths (AppConfig -> [FilePath]
acTemplatePaths AppConfig
appConfig))
  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
$ "Found template files: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
paths
  [(Maybe FileType, FilePath)]
withTypes <- (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 (\path :: FilePath
path -> (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
fmap (, FilePath
path) (FilePath -> RIO env (Maybe FileType)
forall env. HasLogFunc env => FilePath -> RIO env (Maybe FileType)
extractTemplateType FilePath
path)) [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) -> (TemplateType -> (FileType, TemplateType))
-> RIO env TemplateType -> RIO env (FileType, TemplateType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileType
t, ) (FilePath -> RIO env TemplateType
forall (m :: * -> *) t. (MonadIO m, Template t) => FilePath -> m t
loadTemplate FilePath
p))
                    (((Maybe FileType, FilePath) -> Maybe (FileType, FilePath))
-> [(Maybe FileType, FilePath)] -> [(FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe FileType, FilePath) -> Maybe (FileType, FilePath)
forall a b. (Maybe a, b) -> Maybe (a, b)
filterTemplate [(Maybe FileType, FilePath)]
withTypes)
  [(FileType, Text)]
rendered <- ((FileType, TemplateType) -> RIO env (FileType, Text))
-> [(FileType, TemplateType)] -> RIO env [(FileType, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
    (\(t :: FileType
t, p :: TemplateType
p) ->
      (Text -> (FileType, Text))
-> RIO env Text -> RIO env (FileType, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileType
t, ) (HashMap Text Text -> TemplateType -> RIO env Text
forall t (m :: * -> *).
(Template t, MonadThrow m) =>
HashMap Text Text -> t -> m Text
renderTemplate (AppConfig -> HashMap Text Text
acVariables AppConfig
appConfig) (TemplateType
p :: TemplateType))
    )
    [(FileType, TemplateType)]
parsed
  Map FileType Text -> RIO env (Map FileType Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map FileType Text -> RIO env (Map FileType Text))
-> Map FileType Text -> RIO env (Map FileType Text)
forall a b. (a -> b) -> a -> b
$ [(FileType, Text)] -> Map FileType Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FileType, Text)]
rendered
 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
$ Proxy TemplateType -> NonEmpty Text
forall t (proxy :: * -> *). Template t => proxy t -> NonEmpty Text
templateExtensions (Proxy TemplateType
forall k (t :: k). Proxy t
Proxy :: Proxy TemplateType)
  findPaths :: FilePath -> m [FilePath]
findPaths path :: FilePath
path = FilePath -> [Text] -> m [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> [Text] -> m [FilePath]
findFilesByExts FilePath
path [Text]
extensions
  filterTemplate :: (Maybe a, b) -> Maybe (a, b)
filterTemplate (fileType :: Maybe a
fileType, path :: b
path) = (\ft :: a
ft -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
ft, b
path)) (a -> Maybe (a, b)) -> Maybe a -> Maybe (a, b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe a
fileType

extractTemplateType :: HasLogFunc env => FilePath -> RIO env (Maybe FileType)
extractTemplateType :: FilePath -> RIO env (Maybe FileType)
extractTemplateType path :: FilePath
path = do
  let fileType :: Maybe FileType
fileType = Text -> Maybe FileType
fileTypeByName (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

findSourceFiles :: HasAppConfig env => [FileType] -> RIO env [FilePath]
findSourceFiles :: [FileType] -> RIO env [FilePath]
findSourceFiles fileTypes :: [FileType]
fileTypes = do
  AppConfig
appConfig <- Getting AppConfig env AppConfig -> RIO env AppConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AppConfig env AppConfig
forall env. HasAppConfig env => Lens' env AppConfig
appConfigL
  let paths :: [FilePath]
paths = AppConfig -> [FilePath]
acSourcePaths AppConfig
appConfig
  IO [FilePath] -> RIO env [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> RIO env [FilePath])
-> IO [FilePath] -> RIO env [FilePath]
forall a b. (a -> b) -> a -> b
$ ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> [FileType] -> IO [FilePath]
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FileType] -> m [FilePath]
`findFilesByTypes` [FileType]
fileTypes) [FilePath]
paths)

processHeaders :: (HasLogFunc env, HasRunOptions env)
               => M.Map FileType Text
               -> [FilePath]
               -> RIO env (Int, Int)
processHeaders :: Map FileType Text -> [FilePath] -> RIO env (Int, Int)
processHeaders templates :: Map FileType Text
templates paths :: [FilePath]
paths = do
  let filesToProcess :: [(Header, FilePath)]
filesToProcess = ((FileType, FilePath) -> Maybe (Header, FilePath))
-> [(FileType, FilePath)] -> [(Header, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FileType, FilePath) -> Maybe (Header, FilePath)
forall b. (FileType, b) -> Maybe (Header, b)
withTemplate ((FilePath -> Maybe (FileType, FilePath))
-> [FilePath] -> [(FileType, FilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (FileType, FilePath)
processPath [FilePath]
paths)
      zipped :: [(Int, (Header, FilePath))]
zipped         = [Int] -> [(Header, FilePath)] -> [(Int, (Header, FilePath))]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [1 ..] [(Header, FilePath)]
filesToProcess
      withProgress :: [(Progress, Header, FilePath)]
withProgress   = ((Int, (Header, FilePath)) -> (Progress, Header, FilePath))
-> [(Int, (Header, FilePath))] -> [(Progress, Header, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(i :: Int
i, (h :: Header
h, p :: FilePath
p)) -> (Int -> Progress
progress Int
i, Header
h, FilePath
p)) [(Int, (Header, FilePath))]
zipped
      progress :: Int -> Progress
progress curr :: Int
curr = Int -> Int -> Progress
Progress Int
curr ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
paths)
  [Bool]
processed <- ((Progress, Header, FilePath) -> RIO env Bool)
-> [(Progress, Header, FilePath)] -> RIO env [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(i :: Progress
i, h :: Header
h, p :: FilePath
p) -> Progress -> Header -> FilePath -> RIO env Bool
forall env.
(HasLogFunc env, HasRunOptions env) =>
Progress -> Header -> FilePath -> RIO env Bool
processHeader Progress
i Header
h FilePath
p) [(Progress, Header, FilePath)]
withProgress
  (Int, Int) -> RIO env (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Progress, Header, FilePath)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(Progress, Header, FilePath)]
withProgress, [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
  withTemplate :: (FileType, b) -> Maybe (Header, b)
withTemplate (fileType :: FileType
fileType, path :: b
path) =
    (Text -> (Header, b)) -> Maybe Text -> Maybe (Header, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :: Text
t -> (FileType -> Text -> Header
Header FileType
fileType Text
t, b
path)) (FileType -> Map FileType Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FileType
fileType Map FileType Text
templates)
  processPath :: FilePath -> Maybe (FileType, FilePath)
processPath 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
>>= Text -> Maybe FileType
fileTypeByExt)

processHeader :: (HasLogFunc env, HasRunOptions env)
              => Progress
              -> Header
              -> FilePath
              -> RIO env Bool
processHeader :: Progress -> Header -> FilePath -> RIO env Bool
processHeader progress :: Progress
progress header :: Header
header path :: FilePath
path = do
  RunOptions
runOptions  <- Getting RunOptions env RunOptions -> RIO env RunOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RunOptions env RunOptions
forall env. HasRunOptions env => Lens' env RunOptions
runOptionsL
  Text
fileContent <- FilePath -> RIO env Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
path
  let hasHeader :: Bool
hasHeader              = FileType -> Text -> Bool
containsHeader (Header -> FileType
hFileType Header
header) Text
fileContent
      (skipped :: Bool
skipped, action :: Header -> Text -> Text
action, msg :: Utf8Builder
msg) = RunMode -> Bool -> (Bool, Header -> Text -> Text, Utf8Builder)
forall c.
IsString c =>
RunMode -> Bool -> (Bool, Header -> Text -> Text, c)
chooseAction (RunOptions -> RunMode
roRunMode RunOptions
runOptions) Bool
hasHeader
      msg' :: Utf8Builder
msg'                   = if Bool
skipped then "Skipping file" else Utf8Builder
msg
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
log' (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
msg' Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
path
  FilePath -> Text -> RIO env ()
forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
path (Header -> Text -> Text
action Header
header Text
fileContent)
  Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
skipped
 where
  log' :: Utf8Builder -> m ()
log' msg :: Utf8Builder
msg = 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
$ Progress -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Progress
progress Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
msg
  chooseAction :: RunMode -> Bool -> (Bool, Header -> Text -> Text, c)
chooseAction runMode :: RunMode
runMode hasHeader :: Bool
hasHeader = case RunMode
runMode of
    Add     -> (Bool
hasHeader, Header -> Text -> Text
addHeader, "Adding header to")
    Drop    -> (Bool -> Bool
not Bool
hasHeader, FileType -> Text -> Text
dropHeader (FileType -> Text -> Text)
-> (Header -> FileType) -> Header -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> FileType
hFileType, "Dropping header from")
    Replace -> if Bool
hasHeader
      then (Bool
False, Header -> Text -> Text
replaceHeader, "Replacing header in")
      else RunMode -> Bool -> (Bool, Header -> Text -> Text, c)
chooseAction RunMode
Add Bool
hasHeader