module Restyler.Restyler.Run
    ( runRestylers
    , runRestylers_

    -- * Exported for testing only
    , runRestyler
    , runRestyler_
    , withFilteredPaths
    , findFiles
    )
where

import Restyler.Prelude

import Data.List (nub)
import Restyler.App.Class
import Restyler.App.Error
import Restyler.Config
import Restyler.Config.ChangedPaths
import Restyler.Config.Glob (match)
import Restyler.Config.Include
import Restyler.Config.Interpreter
import Restyler.Delimited
import Restyler.Git
import Restyler.Options
import Restyler.Restyler
import Restyler.RestylerResult
import RIO.FilePath ((</>))

-- | Runs the configured @'Restyler'@s for the files and reports results
runRestylers
    :: ( HasLogFunc env
       , HasOptions env
       , HasSystem env
       , HasProcess env
       , HasGit env
       )
    => Config
    -> [FilePath]
    -> RIO env [RestylerResult]
runRestylers :: Config -> [FilePath] -> RIO env [RestylerResult]
runRestylers = (Restyler -> [FilePath] -> RIO env RestylerResult)
-> Config -> [FilePath] -> RIO env [RestylerResult]
forall env a.
(HasSystem env, HasLogFunc env) =>
(Restyler -> [FilePath] -> RIO env a)
-> Config -> [FilePath] -> RIO env [a]
runRestylersWith Restyler -> [FilePath] -> RIO env RestylerResult
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env,
 HasGit env) =>
Restyler -> [FilePath] -> RIO env RestylerResult
runRestyler

-- | @'runRestylers'@, but without committing or reporting results
runRestylers_
    :: (HasLogFunc env, HasOptions env, HasSystem env, HasProcess env)
    => Config
    -> [FilePath]
    -> RIO env ()
runRestylers_ :: Config -> [FilePath] -> RIO env ()
runRestylers_ config :: Config
config = RIO env [()] -> RIO env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO env [()] -> RIO env ())
-> ([FilePath] -> RIO env [()]) -> [FilePath] -> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Restyler -> [FilePath] -> RIO env ())
-> Config -> [FilePath] -> RIO env [()]
forall env a.
(HasSystem env, HasLogFunc env) =>
(Restyler -> [FilePath] -> RIO env a)
-> Config -> [FilePath] -> RIO env [a]
runRestylersWith Restyler -> [FilePath] -> RIO env ()
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
runRestyler_ Config
config

runRestylersWith
    :: (HasSystem env, HasLogFunc env)
    => (Restyler -> [FilePath] -> RIO env a)
    -> Config
    -> [FilePath]
    -> RIO env [a]
runRestylersWith :: (Restyler -> [FilePath] -> RIO env a)
-> Config -> [FilePath] -> RIO env [a]
runRestylersWith run :: Restyler -> [FilePath] -> RIO env a
run Config {..} allPaths :: [FilePath]
allPaths = do
    [FilePath]
paths <- [FilePath] -> RIO env [FilePath]
forall env. HasSystem env => [FilePath] -> RIO env [FilePath]
findFiles ([FilePath] -> RIO env [FilePath])
-> [FilePath] -> RIO env [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
included [FilePath]
allPaths

    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
$ "Restylers: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ((Restyler -> FilePath) -> [Restyler] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Restyler -> FilePath
rName [Restyler]
restylers)
    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
$ "Paths: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
paths

    let lenPaths :: Natural
lenPaths = [FilePath] -> Natural
forall i a. Num i => [a] -> i
genericLength [FilePath]
paths
        maxPaths :: Natural
maxPaths = ChangedPathsConfig -> Natural
cpcMaximum ChangedPathsConfig
cChangedPaths
        maxPathsLogMessage :: Utf8Builder
maxPathsLogMessage =
            "Number of changed paths ("
                Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Natural
lenPaths
                Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ") is greater than configured maximum ("
                Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Natural
maxPaths
                Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ")"

    if Natural
lenPaths Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxPaths
        then case ChangedPathsConfig -> MaximumChangedPathsOutcome
cpcOutcome ChangedPathsConfig
cChangedPaths of
            MaximumChangedPathsOutcomeSkip -> [] [a] -> RIO env () -> RIO env [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
maxPathsLogMessage
            MaximumChangedPathsOutcomeError ->
                AppError -> RIO env [a]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (AppError -> RIO env [a]) -> AppError -> RIO env [a]
forall a b. (a -> b) -> a -> b
$ Text -> AppError
RestyleError (Text -> AppError) -> Text -> AppError
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Text
utf8BuilderToText Utf8Builder
maxPathsLogMessage
        else [Restyler]
-> [FilePath]
-> (Restyler -> [FilePath] -> RIO env a)
-> RIO env [a]
forall env a.
HasSystem env =>
[Restyler]
-> [FilePath]
-> (Restyler -> [FilePath] -> RIO env a)
-> RIO env [a]
withFilteredPaths [Restyler]
restylers [FilePath]
paths Restyler -> [FilePath] -> RIO env a
run
  where
    included :: FilePath -> Bool
included path :: FilePath
path = (Glob -> Bool) -> [Glob] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
none (Glob -> FilePath -> Bool
`match` FilePath
path) [Glob]
cExclude
    restylers :: [Restyler]
restylers = (Restyler -> Bool) -> [Restyler] -> [Restyler]
forall a. (a -> Bool) -> [a] -> [a]
filter Restyler -> Bool
rEnabled [Restyler]
cRestylers

-- | Run each @'Restyler'@ with appropriate paths out of the given set
--
-- Input is expected to be files (not directories), filtered for existence, and
-- processed through global @exclude@ already. This is extracted for specific
-- testing of Restyler @include@ and @intepreter@ configuration handling.
--
withFilteredPaths
    :: HasSystem env
    => [Restyler]
    -> [FilePath]
    -> (Restyler -> [FilePath] -> RIO env a)
    -> RIO env [a]
withFilteredPaths :: [Restyler]
-> [FilePath]
-> (Restyler -> [FilePath] -> RIO env a)
-> RIO env [a]
withFilteredPaths restylers :: [Restyler]
restylers paths :: [FilePath]
paths run :: Restyler -> [FilePath] -> RIO env a
run = do
    [(FilePath, Maybe Interpreter)]
withInterpreters <- (FilePath -> RIO env (FilePath, Maybe Interpreter))
-> [FilePath] -> RIO env [(FilePath, Maybe Interpreter)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> RIO env (FilePath, Maybe Interpreter)
forall env.
HasSystem env =>
FilePath -> RIO env (FilePath, Maybe Interpreter)
addExecutableInterpreter [FilePath]
paths
    [Restyler] -> (Restyler -> RIO env a) -> RIO env [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Restyler]
restylers ((Restyler -> RIO env a) -> RIO env [a])
-> (Restyler -> RIO env a) -> RIO env [a]
forall a b. (a -> b) -> a -> b
$ \r :: Restyler
r ->
        Restyler -> [FilePath] -> RIO env a
run Restyler
r ([FilePath] -> RIO env a) -> [FilePath] -> RIO env a
forall a b. (a -> b) -> a -> b
$ ((FilePath, Maybe Interpreter) -> FilePath)
-> [(FilePath, Maybe Interpreter)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Maybe Interpreter) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, Maybe Interpreter)] -> [FilePath])
-> [(FilePath, Maybe Interpreter)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, Maybe Interpreter) -> Bool)
-> [(FilePath, Maybe Interpreter)]
-> [(FilePath, Maybe Interpreter)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Restyler
r Restyler -> (FilePath, Maybe Interpreter) -> Bool
`shouldRestyle`) [(FilePath, Maybe Interpreter)]
withInterpreters

addExecutableInterpreter
    :: HasSystem env => FilePath -> RIO env (FilePath, Maybe Interpreter)
addExecutableInterpreter :: FilePath -> RIO env (FilePath, Maybe Interpreter)
addExecutableInterpreter path :: FilePath
path = (SomeException -> RIO env (FilePath, Maybe Interpreter))
-> RIO env (FilePath, Maybe Interpreter)
-> RIO env (FilePath, Maybe Interpreter)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny (RIO env (FilePath, Maybe Interpreter)
-> SomeException -> RIO env (FilePath, Maybe Interpreter)
forall a b. a -> b -> a
const (RIO env (FilePath, Maybe Interpreter)
 -> SomeException -> RIO env (FilePath, Maybe Interpreter))
-> RIO env (FilePath, Maybe Interpreter)
-> SomeException
-> RIO env (FilePath, Maybe Interpreter)
forall a b. (a -> b) -> a -> b
$ (FilePath, Maybe Interpreter)
-> RIO env (FilePath, Maybe Interpreter)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
path, Maybe Interpreter
forall a. Maybe a
Nothing)) (RIO env (FilePath, Maybe Interpreter)
 -> RIO env (FilePath, Maybe Interpreter))
-> RIO env (FilePath, Maybe Interpreter)
-> RIO env (FilePath, Maybe Interpreter)
forall a b. (a -> b) -> a -> b
$ do
    Bool
isExec <- FilePath -> RIO env Bool
forall env. HasSystem env => FilePath -> RIO env Bool
isFileExecutable FilePath
path

    (FilePath
path, ) (Maybe Interpreter -> (FilePath, Maybe Interpreter))
-> RIO env (Maybe Interpreter)
-> RIO env (FilePath, Maybe Interpreter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
isExec
        then Text -> Maybe Interpreter
readInterpreter (Text -> Maybe Interpreter)
-> RIO env Text -> RIO env (Maybe Interpreter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RIO env Text
forall env. HasSystem env => FilePath -> RIO env Text
readFile FilePath
path
        else Maybe Interpreter -> RIO env (Maybe Interpreter)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Interpreter
forall a. Maybe a
Nothing

shouldRestyle :: Restyler -> (FilePath, Maybe Interpreter) -> Bool
Restyler {..} shouldRestyle :: Restyler -> (FilePath, Maybe Interpreter) -> Bool
`shouldRestyle` (path :: FilePath
path, mInterpreter :: Maybe Interpreter
mInterpreter)
    | Bool
matchesInterpreter = [Include] -> FilePath -> Bool
includePath (FilePath -> Include
explicit FilePath
path Include -> [Include] -> [Include]
forall a. a -> [a] -> [a]
: [Include]
rInclude) FilePath
path
    | Bool
otherwise = [Include] -> FilePath -> Bool
includePath [Include]
rInclude FilePath
path
  where
    matchesInterpreter :: Bool
matchesInterpreter = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        Interpreter
interpreter <- Maybe Interpreter
mInterpreter
        Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Interpreter
interpreter Interpreter -> [Interpreter] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Interpreter]
rInterpreters

-- | Run a @'Restyler'@ and get the result (i.e. commit changes)
runRestyler
    :: ( HasLogFunc env
       , HasOptions env
       , HasSystem env
       , HasProcess env
       , HasGit env
       )
    => Restyler
    -> [FilePath]
    -> RIO env RestylerResult
runRestyler :: Restyler -> [FilePath] -> RIO env RestylerResult
runRestyler r :: Restyler
r [] = RestylerResult -> RIO env RestylerResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RestylerResult -> RIO env RestylerResult)
-> RestylerResult -> RIO env RestylerResult
forall a b. (a -> b) -> a -> b
$ Restyler -> RestylerResult
noPathsRestylerResult Restyler
r
runRestyler r :: Restyler
r paths :: [FilePath]
paths = do
    Restyler -> [FilePath] -> RIO env ()
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
runRestyler_ Restyler
r [FilePath]
paths
    Restyler -> RIO env RestylerResult
forall env. HasGit env => Restyler -> RIO env RestylerResult
getRestylerResult Restyler
r

-- | Run a @'Restyler'@ (don't commit anything)
runRestyler_
    :: (HasLogFunc env, HasOptions env, HasSystem env, HasProcess env)
    => Restyler
    -> [FilePath]
    -> RIO env ()
runRestyler_ :: Restyler -> [FilePath] -> RIO env ()
runRestyler_ _ [] = () -> RIO env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runRestyler_ r :: Restyler
r paths :: [FilePath]
paths = case Restyler -> Maybe Delimiters
rDelimiters Restyler
r of
    Nothing -> Restyler -> [FilePath] -> RIO env ()
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
runRestyler' Restyler
r [FilePath]
paths
    Just ds :: Delimiters
ds -> Delimiters
-> ([FilePath] -> RIO env ()) -> [FilePath] -> RIO env ()
forall env result.
HasSystem env =>
Delimiters
-> ([FilePath] -> RIO env result) -> [FilePath] -> RIO env result
restyleDelimited Delimiters
ds (Restyler -> [FilePath] -> RIO env ()
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
runRestyler' Restyler
r) [FilePath]
paths

runRestyler'
    :: (HasLogFunc env, HasOptions env, HasSystem env, HasProcess env)
    => Restyler
    -> [FilePath]
    -> RIO env ()
runRestyler' :: Restyler -> [FilePath] -> RIO env ()
runRestyler' r :: Restyler
r@Restyler {..} paths :: [FilePath]
paths = if Bool
rSupportsMultiplePaths
    then 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
$ "Restyling "
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
paths
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " via "
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
rName
        Restyler -> [FilePath] -> RIO env ()
forall env.
(HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
dockerRunRestyler Restyler
r [FilePath]
paths
    else [FilePath] -> (FilePath -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FilePath]
paths ((FilePath -> RIO env ()) -> RIO env ())
-> (FilePath -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \path :: FilePath
path -> 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
$ "Restyling "
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
path
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " via "
            Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow FilePath
rName
        Restyler -> [FilePath] -> RIO env ()
forall env.
(HasOptions env, HasSystem env, HasProcess env) =>
Restyler -> [FilePath] -> RIO env ()
dockerRunRestyler Restyler
r [FilePath
path]

dockerRunRestyler
    :: (HasOptions env, HasSystem env, HasProcess env)
    => Restyler
    -> [FilePath]
    -> RIO env ()
dockerRunRestyler :: Restyler -> [FilePath] -> RIO env ()
dockerRunRestyler r :: Restyler
r@Restyler {..} paths :: [FilePath]
paths = do
    FilePath
cwd <- RIO env FilePath
forall env. (HasOptions env, HasSystem env) => RIO env FilePath
getHostDirectory
    Bool
unrestricted <- Options -> Bool
oUnrestricted (Options -> Bool) -> RIO env Options -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Options env Options -> RIO env Options
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Options env Options
forall env. HasOptions env => Lens' env Options
optionsL
    ExitCode
ec <-
        FilePath -> [FilePath] -> RIO env ExitCode
forall env.
HasProcess env =>
FilePath -> [FilePath] -> RIO env ExitCode
callProcessExitCode "docker"
        ([FilePath] -> RIO env ExitCode) -> [FilePath] -> RIO env ExitCode
forall a b. (a -> b) -> a -> b
$ ["run", "--rm", "--net", "none"]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> [FilePath] -> Bool -> [FilePath]
forall a. a -> a -> Bool -> a
bool [FilePath]
restrictions [] Bool
unrestricted
        [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> ["--volume", FilePath
cwd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ":/code", FilePath
rImage]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath]
rCommand [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
rArguments)
        [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [ "--" | Bool
rSupportsArgSep ]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ("./" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) [FilePath]
paths

    case ExitCode
ec of
        ExitSuccess -> () -> RIO env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        ExitFailure s :: Int
s -> AppError -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (AppError -> RIO env ()) -> AppError -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Restyler -> Int -> [FilePath] -> AppError
RestylerExitFailure Restyler
r Int
s [FilePath]
paths

restrictions :: [String]
restrictions :: [FilePath]
restrictions = ["--cap-drop", "all", "--cpu-shares", "128", "--memory", "512m"]

getHostDirectory :: (HasOptions env, HasSystem env) => RIO env FilePath
getHostDirectory :: RIO env FilePath
getHostDirectory = do
    Maybe FilePath
mHostDirectory <- Options -> Maybe FilePath
oHostDirectory (Options -> Maybe FilePath)
-> RIO env Options -> RIO env (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Options env Options -> RIO env Options
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Options env Options
forall env. HasOptions env => Lens' env Options
optionsL
    RIO env FilePath
-> (FilePath -> RIO env FilePath)
-> Maybe FilePath
-> RIO env FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RIO env FilePath
forall env. HasSystem env => RIO env FilePath
getCurrentDirectory FilePath -> RIO env FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
mHostDirectory

-- | Expand directory arguments and filter to only existing paths
--
-- The existence filtering is important for normal Restyling, where we may get
-- path arguments of removed files in the PR. The expansion is important for
-- @restyle-path@, where we may be given directories as arguments.
--
findFiles :: HasSystem env => [FilePath] -> RIO env [FilePath]
findFiles :: [FilePath] -> RIO env [FilePath]
findFiles = ([[FilePath]] -> [FilePath])
-> RIO env [[FilePath]] -> RIO env [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 (RIO env [[FilePath]] -> RIO env [FilePath])
-> ([FilePath] -> RIO env [[FilePath]])
-> [FilePath]
-> RIO env [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> RIO env [FilePath])
-> [FilePath] -> RIO env [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> RIO env [FilePath]
forall env. HasSystem env => FilePath -> RIO env [FilePath]
go
  where
    go :: FilePath -> RIO env [FilePath]
go parent :: FilePath
parent = do
        Bool
isDirectory <- FilePath -> RIO env Bool
forall env. HasSystem env => FilePath -> RIO env Bool
doesDirectoryExist FilePath
parent

        if Bool
isDirectory
            then do
                [FilePath]
files <- FilePath -> RIO env [FilePath]
forall env. HasSystem env => FilePath -> RIO env [FilePath]
listDirectory FilePath
parent
                [FilePath] -> RIO env [FilePath]
forall env. HasSystem env => [FilePath] -> RIO env [FilePath]
findFiles ([FilePath] -> RIO env [FilePath])
-> [FilePath] -> RIO env [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
parent FilePath -> FilePath -> FilePath
</>) [FilePath]
files
            else do
                Bool
isFile <- FilePath -> RIO env Bool
forall env. HasSystem env => FilePath -> RIO env Bool
doesFileExist FilePath
parent
                [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ FilePath
parent | Bool
isFile ] -- too clever?