{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable, RecordWildCards #-}
module Development.Shake.Command(
command, command_, cmd, cmd_, unit, CmdArgument(..), CmdArguments(..), IsCmdArgument(..), (:->),
Stdout(..), StdoutTrim(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..), FSATrace(..),
CmdResult, CmdString, CmdOption(..),
addPath, addEnv,
) where
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Exception.Extra
import Data.Char
import Data.Either.Extra
import Data.Foldable (toList)
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty)
import qualified Data.HashSet as Set
import Data.Maybe
import Data.Data
import Data.Semigroup
import System.Directory
import qualified System.IO.Extra as IO
import System.Environment
import System.Exit
import System.IO.Extra hiding (withTempFile, withTempDir)
import System.Process
import System.Info.Extra
import System.Time.Extra
import System.IO.Unsafe (unsafeInterleaveIO)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.UTF8 as UTF8
import General.Extra
import General.Process
import Prelude
import Development.Shake.Internal.CmdOption
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Types hiding (Result)
import Development.Shake.FilePath
import Development.Shake.Internal.Options
import Development.Shake.Internal.Rules.File
import Development.Shake.Internal.Derived
addPath :: MonadIO m => [String] -> [String] -> m CmdOption
addPath :: forall (m :: * -> *).
MonadIO m =>
[String] -> [String] -> m CmdOption
addPath [String]
pre [String]
post = do
[(String, String)]
args <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
let ([(String, String)]
path,[(String, String)]
other) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== String
"PATH") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
args
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env forall a b. (a -> b) -> a -> b
$
[(String
"PATH",forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$ [String]
pre forall a. [a] -> [a] -> [a]
++ [String]
post) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
path] forall a. [a] -> [a] -> [a]
++
[(String
a,forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$ [String]
pre forall a. [a] -> [a] -> [a]
++ [String
b | String
b forall a. Eq a => a -> a -> Bool
/= String
""] forall a. [a] -> [a] -> [a]
++ [String]
post) | (String
a,String
b) <- [(String, String)]
path] forall a. [a] -> [a] -> [a]
++
[(String, String)]
other
addEnv :: MonadIO m => [(String, String)] -> m CmdOption
addEnv :: forall (m :: * -> *).
MonadIO m =>
[(String, String)] -> m CmdOption
addEnv [(String, String)]
extra = do
[(String, String)]
args <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env forall a b. (a -> b) -> a -> b
$ [(String, String)]
extra forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
a,String
_) -> String
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, String)]
extra) [(String, String)]
args
data Str = Str String | BS BS.ByteString | LBS LBS.ByteString | Unit deriving (Str -> Str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c== :: Str -> Str -> Bool
Eq,Int -> Str -> String -> String
[Str] -> String -> String
Str -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Str] -> String -> String
$cshowList :: [Str] -> String -> String
show :: Str -> String
$cshow :: Str -> String
showsPrec :: Int -> Str -> String -> String
$cshowsPrec :: Int -> Str -> String -> String
Show)
strTrim :: Str -> Str
strTrim :: Str -> Str
strTrim (Str String
x) = String -> Str
Str forall a b. (a -> b) -> a -> b
$ String -> String
trim String
x
strTrim (BS ByteString
x) = ByteString -> Str
BS forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace ByteString
x
strTrim (LBS ByteString
x) = ByteString -> Str
LBS forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
trimEnd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
LBS.dropWhile Char -> Bool
isSpace ByteString
x
where
trimEnd :: ByteString -> ByteString
trimEnd ByteString
x = case ByteString -> Maybe (Char, ByteString)
LBS.uncons ByteString
x of
Just (Char
c, ByteString
x2) | Char -> Bool
isSpace Char
c -> ByteString -> ByteString
trimEnd ByteString
x2
Maybe (Char, ByteString)
_ -> ByteString
x
strTrim Str
Unit = Str
Unit
data Result
= ResultStdout Str
| ResultStderr Str
| ResultStdouterr Str
| ResultCode ExitCode
| ResultTime Double
| ResultLine String
| ResultProcess PID
| ResultFSATrace [FSATrace FilePath]
| ResultFSATraceBS [FSATrace BS.ByteString]
deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq,Int -> Result -> String -> String
[Result] -> String -> String
Result -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result] -> String -> String
$cshowList :: [Result] -> String -> String
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> String -> String
$cshowsPrec :: Int -> Result -> String -> String
Show)
data PID = PID0 | PID ProcessHandle
instance Eq PID where PID
_ == :: PID -> PID -> Bool
== PID
_ = Bool
True
instance Show PID where show :: PID -> String
show PID
PID0 = String
"PID0"; show PID
_ = String
"PID"
data Params = Params
{Params -> String
funcName :: String
,Params -> [CmdOption]
opts :: [CmdOption]
,Params -> [Result]
results :: [Result]
,Params -> String
prog :: String
,Params -> [String]
args :: [String]
} deriving Int -> Params -> String -> String
[Params] -> String -> String
Params -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Params] -> String -> String
$cshowList :: [Params] -> String -> String
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> String -> String
$cshowsPrec :: Int -> Params -> String -> String
Show
class MonadIO m => MonadTempDir m where
runWithTempDir :: (FilePath -> m a) -> m a
runWithTempFile :: (FilePath -> m a) -> m a
instance MonadTempDir IO where
runWithTempDir :: forall a. (String -> IO a) -> IO a
runWithTempDir = forall a. (String -> IO a) -> IO a
IO.withTempDir
runWithTempFile :: forall a. (String -> IO a) -> IO a
runWithTempFile = forall a. (String -> IO a) -> IO a
IO.withTempFile
instance MonadTempDir Action where
runWithTempDir :: forall a. (String -> Action a) -> Action a
runWithTempDir = forall a. (String -> Action a) -> Action a
withTempDir
runWithTempFile :: forall a. (String -> Action a) -> Action a
runWithTempFile = forall a. (String -> Action a) -> Action a
withTempFile
removeOptionShell
:: MonadTempDir m
=> Params
-> (Params -> m a)
-> m a
removeOptionShell :: forall (m :: * -> *) a.
MonadTempDir m =>
Params -> (Params -> m a) -> m a
removeOptionShell params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} Params -> m a
call
| CmdOption
Shell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts = do
let userCmdline :: String
userCmdline = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
prog forall a. a -> [a] -> [a]
: [String]
args
Params
params <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params{opts :: [CmdOption]
opts = String -> CmdOption
UserCommand String
userCmdline forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= CmdOption
Shell) [CmdOption]
opts}
String
prog <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Params -> Bool
isFSATrace Params
params then String -> IO String
copyFSABinary String
prog else forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog
let realCmdline :: String
realCmdline = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
prog forall a. a -> [a] -> [a]
: [String]
args
if Bool -> Bool
not Bool
isWindows then
Params -> m a
call Params
params{prog :: String
prog = String
"/bin/sh", args :: [String]
args = [String
"-c",String
realCmdline]}
else
forall (m :: * -> *) a. MonadTempDir m => (String -> m a) -> m a
runWithTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
let file :: String
file = String
dir String -> String -> String
</> String
"s.bat"
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' String
file String
realCmdline
Params -> m a
call Params
params{prog :: String
prog = String
"cmd.exe", args :: [String]
args = [String
"/d/q/c",String
file]}
| Bool
otherwise = Params -> m a
call Params
params
isFSATrace :: Params -> Bool
isFSATrace :: Params -> Bool
isFSATrace Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Result -> Bool
isResultFSATrace [Result]
results Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmdOption -> Bool
isFSAOptions [CmdOption]
opts
copyFSABinary :: FilePath -> IO FilePath
copyFSABinary :: String -> IO String
copyFSABinary String
prog
| Bool -> Bool
not Bool
isMac = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog
| Bool
otherwise = do
Maybe String
progFull <- String -> IO (Maybe String)
findExecutable String
prog
case Maybe String
progFull of
Just String
x | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String
"/bin/",String
"/usr/",String
"/sbin/"] -> do
String
tmpdir <- IO String
getTemporaryDirectory
let fake :: String
fake = String
tmpdir String -> String -> String
</> String
"fsatrace-fakes" forall a. [a] -> [a] -> [a]
++ String
x
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
doesFileExist String
fake) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fake
String -> String -> IO ()
copyFile String
x String
fake
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fake
Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog
removeOptionFSATrace
:: MonadTempDir m
=> Params
-> (Params -> m [Result])
-> m [Result]
removeOptionFSATrace :: forall (m :: * -> *).
MonadTempDir m =>
Params -> (Params -> m [Result]) -> m [Result]
removeOptionFSATrace params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} Params -> m [Result]
call
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Params -> Bool
isFSATrace Params
params = Params -> m [Result]
call Params
params
| PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO String
"Asyncronous process execution combined with FSATrace is not support"
| Bool
otherwise = forall (m :: * -> *) a. MonadTempDir m => (String -> m a) -> m a
runWithTempFile forall a b. (a -> b) -> a -> b
$ \String
file -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
file String
""
Params
params <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Params -> IO Params
fsaParams String
file Params
params
[Result]
res <- Params -> m [Result]
call Params
params{opts :: [CmdOption]
opts = String -> CmdOption
UserCommand (String -> [String] -> String
showCommandForUser2 String
prog [String]
args) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdOption -> Bool
isFSAOptions) [CmdOption]
opts}
[FSATrace ByteString]
fsaResBS <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> [FSATrace ByteString]
parseFSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file
let fsaRes :: [FSATrace String]
fsaRes = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
UTF8.toString) [FSATrace ByteString]
fsaResBS
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Result]
res forall a b. (a -> b) -> a -> b
$ \case
ResultFSATrace [] -> [FSATrace String] -> Result
ResultFSATrace [FSATrace String]
fsaRes
ResultFSATraceBS [] -> [FSATrace ByteString] -> Result
ResultFSATraceBS [FSATrace ByteString]
fsaResBS
Result
x -> Result
x
where
fsaFlags :: String
fsaFlags = forall a. a -> [a] -> a
lastDef String
"rwmdqt" [String
x | FSAOptions String
x <- [CmdOption]
opts]
fsaParams :: String -> Params -> IO Params
fsaParams String
file Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = do
String
prog <- String -> IO String
copyFSABinary String
prog
forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params{prog :: String
prog = String
"fsatrace", args :: [String]
args = String
fsaFlags forall a. a -> [a] -> [a]
: String
file forall a. a -> [a] -> [a]
: String
"--" forall a. a -> [a] -> [a]
: String
prog forall a. a -> [a] -> [a]
: [String]
args }
isFSAOptions :: CmdOption -> Bool
isFSAOptions FSAOptions{} = Bool
True
isFSAOptions CmdOption
_ = Bool
False
isResultFSATrace :: Result -> Bool
isResultFSATrace ResultFSATrace{} = Bool
True
isResultFSATrace ResultFSATraceBS{} = Bool
True
isResultFSATrace Result
_ = Bool
False
addFSAOptions :: String -> [CmdOption] -> [CmdOption]
addFSAOptions :: String -> [CmdOption] -> [CmdOption]
addFSAOptions String
x [CmdOption]
opts | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmdOption -> Bool
isFSAOptions [CmdOption]
opts = forall a b. (a -> b) -> [a] -> [b]
map CmdOption -> CmdOption
f [CmdOption]
opts
where f :: CmdOption -> CmdOption
f (FSAOptions String
y) = String -> CmdOption
FSAOptions forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ String
y forall a. [a] -> [a] -> [a]
++ String
x
f CmdOption
x = CmdOption
x
addFSAOptions String
x [CmdOption]
opts = String -> CmdOption
FSAOptions String
x forall a. a -> [a] -> [a]
: [CmdOption]
opts
data FSATrace a
=
FSAWrite a
|
FSARead a
|
FSADelete a
|
FSAMove a a
|
FSAQuery a
|
FSATouch a
deriving (Int -> FSATrace a -> String -> String
forall a. Show a => Int -> FSATrace a -> String -> String
forall a. Show a => [FSATrace a] -> String -> String
forall a. Show a => FSATrace a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FSATrace a] -> String -> String
$cshowList :: forall a. Show a => [FSATrace a] -> String -> String
show :: FSATrace a -> String
$cshow :: forall a. Show a => FSATrace a -> String
showsPrec :: Int -> FSATrace a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> FSATrace a -> String -> String
Show,FSATrace a -> FSATrace a -> Bool
forall a. Eq a => FSATrace a -> FSATrace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FSATrace a -> FSATrace a -> Bool
$c/= :: forall a. Eq a => FSATrace a -> FSATrace a -> Bool
== :: FSATrace a -> FSATrace a -> Bool
$c== :: forall a. Eq a => FSATrace a -> FSATrace a -> Bool
Eq,FSATrace a -> FSATrace a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FSATrace a)
forall a. Ord a => FSATrace a -> FSATrace a -> Bool
forall a. Ord a => FSATrace a -> FSATrace a -> Ordering
forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
min :: FSATrace a -> FSATrace a -> FSATrace a
$cmin :: forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
max :: FSATrace a -> FSATrace a -> FSATrace a
$cmax :: forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
>= :: FSATrace a -> FSATrace a -> Bool
$c>= :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
> :: FSATrace a -> FSATrace a -> Bool
$c> :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
<= :: FSATrace a -> FSATrace a -> Bool
$c<= :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
< :: FSATrace a -> FSATrace a -> Bool
$c< :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
compare :: FSATrace a -> FSATrace a -> Ordering
$ccompare :: forall a. Ord a => FSATrace a -> FSATrace a -> Ordering
Ord,FSATrace a -> DataType
FSATrace a -> Constr
forall {a}. Data a => Typeable (FSATrace a)
forall a. Data a => FSATrace a -> DataType
forall a. Data a => FSATrace a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FSATrace a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FSATrace a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FSATrace a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
gmapT :: (forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
dataTypeOf :: FSATrace a -> DataType
$cdataTypeOf :: forall a. Data a => FSATrace a -> DataType
toConstr :: FSATrace a -> Constr
$ctoConstr :: forall a. Data a => FSATrace a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
Data,Typeable,forall a b. a -> FSATrace b -> FSATrace a
forall a b. (a -> b) -> FSATrace a -> FSATrace b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FSATrace b -> FSATrace a
$c<$ :: forall a b. a -> FSATrace b -> FSATrace a
fmap :: forall a b. (a -> b) -> FSATrace a -> FSATrace b
$cfmap :: forall a b. (a -> b) -> FSATrace a -> FSATrace b
Functor)
parseFSA :: BS.ByteString -> [FSATrace BS.ByteString]
parseFSA :: ByteString -> [FSATrace ByteString]
parseFSA = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString -> Maybe (FSATrace ByteString)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
where
dropR :: ByteString -> ByteString
dropR ByteString
x = case ByteString -> Maybe (ByteString, Char)
BS.unsnoc ByteString
x of
Just (ByteString
x, Char
'\r') -> ByteString
x
Maybe (ByteString, Char)
_ -> ByteString
x
f :: ByteString -> Maybe (FSATrace ByteString)
f ByteString
x
| Just (Char
k, ByteString
x) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
x
, Just (Char
'|', ByteString
x) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
x =
case Char
k of
Char
'w' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSAWrite ByteString
x
Char
'r' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSARead ByteString
x
Char
'd' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSADelete ByteString
x
Char
'm' | (ByteString
xs, ByteString
ys) <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Char
'|') ByteString
x, Just (Char
'|',ByteString
ys) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
ys ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> FSATrace a
FSAMove ByteString
xs ByteString
ys
Char
'q' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSAQuery ByteString
x
Char
't' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSATouch ByteString
x
Char
_ -> forall a. Maybe a
Nothing
| Bool
otherwise = forall a. Maybe a
Nothing
commandExplicitAction :: Partial => Params -> Action [Result]
commandExplicitAction :: Partial => Params -> Action [Result]
commandExplicitAction Params
oparams = do
ShakeOptions{[CmdOption]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeCommandOptions :: [CmdOption]
shakeCommandOptions,Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeRunCommands :: Bool
shakeRunCommands,Maybe Lint
shakeLint :: ShakeOptions -> Maybe Lint
shakeLint :: Maybe Lint
shakeLint,[String]
shakeLintInside :: ShakeOptions -> [String]
shakeLintInside :: [String]
shakeLintInside} <- Action ShakeOptions
getShakeOptions
params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..}<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Params
oparams{opts :: [CmdOption]
opts = [CmdOption]
shakeCommandOptions forall a. [a] -> [a] -> [a]
++ Params -> [CmdOption]
opts Params
oparams}
let skipper :: Action [Result] -> Action [Result]
skipper Action [Result]
act = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Result]
results Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shakeRunCommands then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else Action [Result]
act
let verboser :: Action [Result] -> Action [Result]
verboser Action [Result]
act = do
let cwd :: Maybe String
cwd = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [String
x | Cwd String
x <- [CmdOption]
opts]
String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"cd " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"; ") Maybe String
cwd forall a. [a] -> [a] -> [a]
++
forall a. [a] -> a
last (String -> [String] -> String
showCommandForUser2 String
prog [String]
args forall a. a -> [a] -> [a]
: [String
x | UserCommand String
x <- [CmdOption]
opts])
Verbosity
verb <- Action Verbosity
getVerbosity
(if Verbosity
verb forall a. Ord a => a -> a -> Bool
>= Verbosity
Verbose then forall a. Action a -> Action a
quietly else forall a. a -> a
id) Action [Result]
act
let tracer :: IO [Result] -> Action [Result]
tracer IO [Result]
act = do
let msg :: String
msg = forall a. a -> [a] -> a
lastDef (Params -> String
defaultTraced Params
oparams) [String
x | Traced String
x <- [CmdOption]
opts]
if String
msg forall a. Eq a => a -> a -> Bool
== String
"" then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Result]
act else forall a. String -> IO a -> Action a
traced String
msg IO [Result]
act
let async :: Bool
async = PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results
let tracker :: (Params -> Action [Result]) -> Action [Result]
tracker Params -> Action [Result]
act
| CmdOption
AutoDeps forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts = if Bool
async then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO String
"Can't use AutoDeps and asyncronous execution" else (Params -> Action [Result]) -> Action [Result]
autodeps Params -> Action [Result]
act
| Maybe Lint
shakeLint forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Lint
LintFSATrace Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
async = (Params -> Action [Result]) -> Action [Result]
fsalint Params -> Action [Result]
act
| Bool
otherwise = Params -> Action [Result]
act Params
params
autodeps :: (Params -> Action [Result]) -> Action [Result]
autodeps Params -> Action [Result]
act = do
ResultFSATrace [FSATrace String]
pxs : [Result]
res <- Params -> Action [Result]
act Params
params{opts :: [CmdOption]
opts = String -> [CmdOption] -> [CmdOption]
addFSAOptions String
"rwm" [CmdOption]
opts, results :: [Result]
results = [FSATrace String] -> Result
ResultFSATrace [] forall a. a -> [a] -> [a]
: [Result]
results}
let written :: HashSet String
written = forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList forall a b. (a -> b) -> a -> b
$ [String
x | FSAMove String
x String
_ <- [FSATrace String]
pxs] forall a. [a] -> [a] -> [a]
++ [String
x | FSAWrite String
x <- [FSATrace String]
pxs]
[String]
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String
x | FSARead String
x <- [FSATrace String]
pxs, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String
x forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet String
written]
String
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
[String]
temp <- String -> [String] -> Action [String]
fixPaths String
cwd [String]
xs
forall a. Action a -> Action a
unsafeAllowApply forall a b. (a -> b) -> a -> b
$ Partial => [String] -> Action ()
need [String]
temp
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Result]
res
fixPaths :: String -> [String] -> Action [String]
fixPaths String
cwd [String]
xs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[String]
xs<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> String
toStandard [String]
xs
[String]
xs<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String]
shakeLintInside) [String]
xs
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
x -> forall a. a -> Maybe a -> a
fromMaybe String
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO (Maybe String)
makeRelativeEx String
cwd String
x) [String]
xs
fsalint :: (Params -> Action [Result]) -> Action [Result]
fsalint Params -> Action [Result]
act = do
ResultFSATrace [FSATrace String]
xs : [Result]
res <- Params -> Action [Result]
act Params
params{opts :: [CmdOption]
opts = String -> [CmdOption] -> [CmdOption]
addFSAOptions String
"rwm" [CmdOption]
opts, results :: [Result]
results = [FSATrace String] -> Result
ResultFSATrace [] forall a. a -> [a] -> [a]
: [Result]
results}
let reader :: FSATrace a -> Maybe a
reader (FSARead a
x) = forall a. a -> Maybe a
Just a
x; reader FSATrace a
_ = forall a. Maybe a
Nothing
writer :: FSATrace a -> Maybe a
writer (FSAWrite a
x) = forall a. a -> Maybe a
Just a
x; writer (FSAMove a
x a
_) = forall a. a -> Maybe a
Just a
x; writer FSATrace a
_ = forall a. Maybe a
Nothing
existing :: (a -> Maybe String) -> [a] -> m [String]
existing a -> Maybe String
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe String
f
String
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
[String] -> Action ()
trackRead forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Action [String]
fixPaths String
cwd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {a}.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing forall {a}. FSATrace a -> Maybe a
reader [FSATrace String]
xs
[String] -> Action ()
trackWrite forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Action [String]
fixPaths String
cwd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {a}.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing forall {a}. FSATrace a -> Maybe a
writer [FSATrace String]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Result]
res
Action [Result] -> Action [Result]
skipper forall a b. (a -> b) -> a -> b
$ (Params -> Action [Result]) -> Action [Result]
tracker forall a b. (a -> b) -> a -> b
$ \Params
params -> Action [Result] -> Action [Result]
verboser forall a b. (a -> b) -> a -> b
$ IO [Result] -> Action [Result]
tracer forall a b. (a -> b) -> a -> b
$ Partial => Params -> IO [Result]
commandExplicitIO Params
params
defaultTraced :: Params -> String
defaultTraced :: Params -> String
defaultTraced Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = String -> String
takeBaseName forall a b. (a -> b) -> a -> b
$ if CmdOption
Shell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts then forall a b. (a, b) -> a
fst (String -> (String, String)
word1 String
prog) else String
prog
commandExplicitIO :: Partial => Params -> IO [Result]
commandExplicitIO :: Partial => Params -> IO [Result]
commandExplicitIO Params
params = forall (m :: * -> *) a.
MonadTempDir m =>
Params -> (Params -> m a) -> m a
removeOptionShell Params
params forall a b. (a -> b) -> a -> b
$ \Params
params -> forall (m :: * -> *).
MonadTempDir m =>
Params -> (Params -> m [Result]) -> m [Result]
removeOptionFSATrace Params
params forall a b. (a -> b) -> a -> b
$ \Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} -> do
let (Bool
grabStdout, Bool
grabStderr) = forall a b. (a -> b) -> (a, a) -> (b, b)
both forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Result]
results forall a b. (a -> b) -> a -> b
$ \case
ResultStdout{} -> (Bool
True, Bool
False)
ResultStderr{} -> (Bool
False, Bool
True)
ResultStdouterr{} -> (Bool
True, Bool
True)
Result
_ -> (Bool
False, Bool
False)
Maybe [(String, String)]
optEnv <- [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv [CmdOption]
opts
let optCwd :: Maybe String
optCwd = [String] -> Maybe String
mergeCwd [String
x | Cwd String
x <- [CmdOption]
opts]
let optStdin :: [Source]
optStdin = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [CmdOption]
opts forall a b. (a -> b) -> a -> b
$ \case
Stdin String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Source
SrcString String
x
StdinBS ByteString
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Source
SrcBytes ByteString
x
FileStdin String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Source
SrcFile String
x
CmdOption
InheritStdin -> forall a. a -> Maybe a
Just Source
SrcInherit
CmdOption
_ -> forall a. Maybe a
Nothing
let optBinary :: Bool
optBinary = CmdOption
BinaryPipes forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
let optAsync :: Bool
optAsync = PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results
let optTimeout :: Maybe Double
optTimeout = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Double
x | Timeout Double
x <- [CmdOption]
opts]
let optWithStdout :: Bool
optWithStdout = forall a. a -> [a] -> a
lastDef Bool
False [Bool
x | WithStdout Bool
x <- [CmdOption]
opts]
let optWithStderr :: Bool
optWithStderr = forall a. a -> [a] -> a
lastDef Bool
True [Bool
x | WithStderr Bool
x <- [CmdOption]
opts]
let optFileStdout :: [String]
optFileStdout = [String
x | FileStdout String
x <- [CmdOption]
opts]
let optFileStderr :: [String]
optFileStderr = [String
x | FileStderr String
x <- [CmdOption]
opts]
let optEchoStdout :: Bool
optEchoStdout = forall a. a -> [a] -> a
lastDef (Bool -> Bool
not Bool
grabStdout Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStdout) [Bool
x | EchoStdout Bool
x <- [CmdOption]
opts]
let optEchoStderr :: Bool
optEchoStderr = forall a. a -> [a] -> a
lastDef (Bool -> Bool
not Bool
grabStderr Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStderr) [Bool
x | EchoStderr Bool
x <- [CmdOption]
opts]
let optRealCommand :: String
optRealCommand = String -> [String] -> String
showCommandForUser2 String
prog [String]
args
let optUserCommand :: String
optUserCommand = forall a. a -> [a] -> a
lastDef String
optRealCommand [String
x | UserCommand String
x <- [CmdOption]
opts]
let optCloseFds :: Bool
optCloseFds = CmdOption
CloseFileHandles forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
let optProcessGroup :: Bool
optProcessGroup = CmdOption
NoProcessGroup forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CmdOption]
opts
let bufLBS :: (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS ByteString -> Str
f = do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf forall a b. (a -> b) -> a -> b
$ ByteString -> Str
LBS ByteString
LBS.empty; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a, (\(LBS ByteString
x) -> ByteString -> Str
f ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Str
b)
buf :: Str -> IO ([Destination], IO Str)
buf Str{} | Bool
optBinary = (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS (String -> Str
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LBS.unpack)
buf Str{} = do Buffer String
x <- forall a. IO (Buffer a)
newBuffer; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Buffer String -> Destination
DestString Buffer String
x | Bool -> Bool
not Bool
optAsync], String -> Str
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Buffer a -> IO [a]
readBuffer Buffer String
x)
buf LBS{} = do Buffer ByteString
x <- forall a. IO (Buffer a)
newBuffer; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Buffer ByteString -> Destination
DestBytes Buffer ByteString
x | Bool -> Bool
not Bool
optAsync], ByteString -> Str
LBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Buffer a -> IO [a]
readBuffer Buffer ByteString
x)
buf BS {} = (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS (ByteString -> Str
BS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks)
buf Str
Unit = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
Unit)
([[Destination]]
dStdout, [[Destination]]
dStderr, [Double -> ProcessHandle -> ExitCode -> IO Result]
resultBuild) :: ([[Destination]], [[Destination]], [Double -> ProcessHandle -> ExitCode -> IO Result]) <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Result]
results forall a b. (a -> b) -> a -> b
$ \case
ResultCode ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
ex -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExitCode -> Result
ResultCode ExitCode
ex)
ResultTime Double
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
dur ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Result
ResultTime Double
dur)
ResultLine String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Result
ResultLine String
optUserCommand)
ResultProcess PID
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
pid ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PID -> Result
ResultProcess forall a b. (a -> b) -> a -> b
$ ProcessHandle -> PID
PID ProcessHandle
pid)
ResultStdout Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a , [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdout IO Str
b)
ResultStderr Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [Destination]
a , \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStderr IO Str
b)
ResultStdouterr Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a , [Destination]
a , \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdouterr IO Str
b)
ResultFSATrace [FSATrace String]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FSATrace String] -> Result
ResultFSATrace [])
ResultFSATraceBS [FSATrace ByteString]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FSATrace ByteString] -> Result
ResultFSATraceBS [])
Buffer String
exceptionBuffer <- forall a. IO (Buffer a)
newBuffer
ProcessOpts
po <- ProcessOpts -> IO ProcessOpts
resolvePath ProcessOpts
{poCommand :: CmdSpec
poCommand = String -> [String] -> CmdSpec
RawCommand String
prog [String]
args
,poCwd :: Maybe String
poCwd = Maybe String
optCwd, poEnv :: Maybe [(String, String)]
poEnv = Maybe [(String, String)]
optEnv, poTimeout :: Maybe Double
poTimeout = Maybe Double
optTimeout
,poStdin :: [Source]
poStdin = [ByteString -> Source
SrcBytes ByteString
LBS.empty | Bool
optBinary Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Source]
optStdin)] forall a. [a] -> [a] -> [a]
++ [Source]
optStdin
,poStdout :: [Destination]
poStdout = [Destination
DestEcho | Bool
optEchoStdout] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStdout forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStdout Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStdout
,poStderr :: [Destination]
poStderr = [Destination
DestEcho | Bool
optEchoStderr] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStderr forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStderr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStderr
,poAsync :: Bool
poAsync = Bool
optAsync
,poCloseFds :: Bool
poCloseFds = Bool
optCloseFds
,poGroup :: Bool
poGroup = Bool
optProcessGroup
}
(Double
dur,(ProcessHandle
pid,ExitCode
exit)) <- forall (m :: * -> *) a. MonadIO m => m a -> m (Double, a)
duration forall a b. (a -> b) -> a -> b
$ ProcessOpts -> IO (ProcessHandle, ExitCode)
process ProcessOpts
po
if ExitCode
exit forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
|| ExitCode -> Result
ResultCode ExitCode
ExitSuccess forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results then
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Double -> ProcessHandle -> ExitCode -> IO Result
f -> Double -> ProcessHandle -> ExitCode -> IO Result
f Double
dur ProcessHandle
pid ExitCode
exit) [Double -> ProcessHandle -> ExitCode -> IO Result]
resultBuild
else do
[String]
exceptionBuffer <- forall a. Buffer a -> IO [a]
readBuffer Buffer String
exceptionBuffer
let captured :: [String]
captured = [String
"Stderr" | Bool
optWithStderr] forall a. [a] -> [a] -> [a]
++ [String
"Stdout" | Bool
optWithStdout]
String
cwd <- case Maybe String
optCwd of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
Just String
v -> do
String
v <- String -> IO String
canonicalizePath String
v forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"Current directory: " forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
"\n"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$
String
"Development.Shake." forall a. [a] -> [a] -> [a]
++ String
funcName forall a. [a] -> [a] -> [a]
++ String
", system command failed\n" forall a. [a] -> [a] -> [a]
++
String
"Command line: " forall a. [a] -> [a] -> [a]
++ String
optRealCommand forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
(if String
optRealCommand forall a. Eq a => a -> a -> Bool
/= String
optUserCommand then String
"Original command line: " forall a. [a] -> [a] -> [a]
++ String
optUserCommand forall a. [a] -> [a] -> [a]
++ String
"\n" else String
"") forall a. [a] -> [a] -> [a]
++
String
cwd forall a. [a] -> [a] -> [a]
++
String
"Exit code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (case ExitCode
exit of ExitFailure Int
i -> Int
i; ExitCode
_ -> Int
0) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
captured then String
"Stderr not captured because WithStderr False was used\n"
else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
exceptionBuffer then forall a. [a] -> [[a]] -> [a]
intercalate String
" and " [String]
captured forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
captured forall a. Eq a => a -> a -> Bool
== Int
1 then String
"was" else String
"were") forall a. [a] -> [a] -> [a]
++ String
" empty"
else forall a. [a] -> [[a]] -> [a]
intercalate String
" and " [String]
captured forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
exceptionBuffer)
mergeCwd :: [FilePath] -> Maybe FilePath
mergeCwd :: [String] -> Maybe String
mergeCwd [] = forall a. Maybe a
Nothing
mergeCwd [String]
xs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 String -> String -> String
(</>) [String]
xs
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv [CmdOption]
opts
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
addEnv, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], [String])]
addPath, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
remEnv = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [(String, b)] -> [(String, b)]
unique forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
tweakPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [(String, String)]
addEnv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [String]
remEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env then IO [(String, String)]
getEnvironment else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]]
env)
where
env :: [[(String, String)]]
env = [[(String, String)]
x | Env [(String, String)]
x <- [CmdOption]
opts]
addEnv :: [(String, String)]
addEnv = [(String
x,String
y) | AddEnv String
x String
y <- [CmdOption]
opts]
remEnv :: [String]
remEnv = [String
x | RemEnv String
x <- [CmdOption]
opts]
addPath :: [([String], [String])]
addPath = [([String]
x,[String]
y) | AddPath [String]
x [String]
y <- [CmdOption]
opts]
newPath :: String -> String
newPath String
mid = forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([String], [String])]
addPath) forall a. [a] -> [a] -> [a]
++ [String
mid | String
mid forall a. Eq a => a -> a -> Bool
/= String
""] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([String], [String])]
addPath
isPath :: String -> Bool
isPath String
x = (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) String
x forall a. Eq a => a -> a -> Bool
== String
"PATH"
tweakPath :: [(String, String)] -> [(String, String)]
tweakPath [(String, String)]
xs | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
isPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
xs = (String
"PATH", String -> String
newPath String
"") forall a. a -> [a] -> [a]
: [(String, String)]
xs
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (\(String
a,String
b) -> (String
a, if String -> Bool
isPath String
a then String -> String
newPath String
b else String
b)) [(String, String)]
xs
unique :: [(String, b)] -> [(String, b)]
unique = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (if Bool
isWindows then String -> String
upper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst else forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath ProcessOpts
po
| Just [(String, String)]
e <- ProcessOpts -> Maybe [(String, String)]
poEnv ProcessOpts
po
, Just (String
_, String
path) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) String
"PATH" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
e
, RawCommand String
prog [String]
args <- ProcessOpts -> CmdSpec
poCommand ProcessOpts
po
= do
let progExe :: String
progExe = if String
prog forall a. Eq a => a -> a -> Bool
== String
prog String -> String -> String
-<.> String
exe then String
prog else String
prog String -> String -> String
<.> String
exe
String
pathOld <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PATH"
Maybe String
old <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
prog
Maybe String
new <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
path) String
progExe
Maybe String
old2 <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
pathOld) String
progExe
Bool
switch<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case () of
()
_ | String
path forall a. Eq a => a -> a -> Bool
== String
pathOld -> Bool
False
| Maybe String
Nothing <- Maybe String
new -> Bool
False
| Maybe String
Nothing <- Maybe String
old -> Bool
True
| Just String
old <- Maybe String
old, Just String
new <- Maybe String
new, String -> String -> Bool
equalFilePath String
old String
new -> Bool
False
| Just String
old <- Maybe String
old, Just String
old2 <- Maybe String
old2, String -> String -> Bool
equalFilePath String
old String
old2 -> Bool
True
| Bool
otherwise -> Bool
False
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe String
new of
Just String
new | Bool
switch -> ProcessOpts
po{poCommand :: CmdSpec
poCommand = String -> [String] -> CmdSpec
RawCommand String
new [String]
args}
Maybe String
_ -> ProcessOpts
po
resolvePath ProcessOpts
po = forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcessOpts
po
findExecutableWith :: [FilePath] -> String -> IO (Maybe FilePath)
findExecutableWith :: [String] -> String -> IO (Maybe String)
findExecutableWith [String]
path String
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
x) [String]
path) forall a b. (a -> b) -> a -> b
$ \String
s ->
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
s) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
s) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
newtype Stdout a = Stdout {forall a. Stdout a -> a
fromStdout :: a}
newtype StdoutTrim a = StdoutTrim {forall a. StdoutTrim a -> a
fromStdoutTrim :: a}
newtype Stderr a = Stderr {forall a. Stderr a -> a
fromStderr :: a}
newtype Stdouterr a = Stdouterr {forall a. Stdouterr a -> a
fromStdouterr :: a}
newtype Exit = Exit {Exit -> ExitCode
fromExit :: ExitCode}
newtype Process = Process {Process -> ProcessHandle
fromProcess :: ProcessHandle}
newtype CmdTime = CmdTime {CmdTime -> Double
fromCmdTime :: Double}
newtype CmdLine = CmdLine {CmdLine -> String
fromCmdLine :: String}
class CmdString a where cmdString :: (Str, Str -> a)
instance CmdString () where cmdString :: (Str, Str -> ())
cmdString = (Str
Unit, \Str
Unit -> ())
instance CmdString String where cmdString :: (Str, Str -> String)
cmdString = (String -> Str
Str String
"", \(Str String
x) -> String
x)
instance CmdString BS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
BS ByteString
BS.empty, \(BS ByteString
x) -> ByteString
x)
instance CmdString LBS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
LBS ByteString
LBS.empty, \(LBS ByteString
x) -> ByteString
x)
class Unit a
instance {-# OVERLAPPING #-} Unit b => Unit (a -> b)
instance {-# OVERLAPPABLE #-} a ~ () => Unit (m a)
class CmdResult a where
cmdResult :: ([Result], [Result] -> a)
instance CmdResult Exit where
cmdResult :: ([Result], [Result] -> Exit)
cmdResult = ([ExitCode -> Result
ResultCode ExitCode
ExitSuccess], \[ResultCode ExitCode
x] -> ExitCode -> Exit
Exit ExitCode
x)
instance CmdResult ExitCode where
cmdResult :: ([Result], [Result] -> ExitCode)
cmdResult = ([ExitCode -> Result
ResultCode ExitCode
ExitSuccess], \[ResultCode ExitCode
x] -> ExitCode
x)
instance CmdResult Process where
cmdResult :: ([Result], [Result] -> Process)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID ProcessHandle
x)] -> ProcessHandle -> Process
Process ProcessHandle
x)
instance CmdResult ProcessHandle where
cmdResult :: ([Result], [Result] -> ProcessHandle)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID ProcessHandle
x)] -> ProcessHandle
x)
instance CmdResult CmdLine where
cmdResult :: ([Result], [Result] -> CmdLine)
cmdResult = ([String -> Result
ResultLine String
""], \[ResultLine String
x] -> String -> CmdLine
CmdLine String
x)
instance CmdResult CmdTime where
cmdResult :: ([Result], [Result] -> CmdTime)
cmdResult = ([Double -> Result
ResultTime Double
0], \[ResultTime Double
x] -> Double -> CmdTime
CmdTime Double
x)
instance CmdResult [FSATrace FilePath] where
cmdResult :: ([Result], [Result] -> [FSATrace String])
cmdResult = ([[FSATrace String] -> Result
ResultFSATrace []], \[ResultFSATrace [FSATrace String]
x] -> [FSATrace String]
x)
instance CmdResult [FSATrace BS.ByteString] where
cmdResult :: ([Result], [Result] -> [FSATrace ByteString])
cmdResult = ([[FSATrace ByteString] -> Result
ResultFSATraceBS []], \[ResultFSATraceBS [FSATrace ByteString]
x] -> [FSATrace ByteString]
x)
instance CmdString a => CmdResult (Stdout a) where
cmdResult :: ([Result], [Result] -> Stdout a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdout Str
a], \[ResultStdout Str
x] -> forall a. a -> Stdout a
Stdout forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)
instance CmdString a => CmdResult (StdoutTrim a) where
cmdResult :: ([Result], [Result] -> StdoutTrim a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdout Str
a], \[ResultStdout Str
x] -> forall a. a -> StdoutTrim a
StdoutTrim forall a b. (a -> b) -> a -> b
$ Str -> a
b forall a b. (a -> b) -> a -> b
$ Str -> Str
strTrim Str
x)
instance CmdString a => CmdResult (Stderr a) where
cmdResult :: ([Result], [Result] -> Stderr a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStderr Str
a], \[ResultStderr Str
x] -> forall a. a -> Stderr a
Stderr forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)
instance CmdString a => CmdResult (Stdouterr a) where
cmdResult :: ([Result], [Result] -> Stdouterr a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdouterr Str
a], \[ResultStdouterr Str
x] -> forall a. a -> Stdouterr a
Stdouterr forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)
instance CmdResult () where
cmdResult :: ([Result], [Result] -> ())
cmdResult = ([], \[] -> ())
instance (CmdResult x1, CmdResult x2) => CmdResult (x1,x2) where
cmdResult :: ([Result], [Result] -> (x1, x2))
cmdResult = ([Result]
a1forall a. [a] -> [a] -> [a]
++[Result]
a2, \[Result]
rs -> let ([Result]
r1,[Result]
r2) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Result]
a1) [Result]
rs in ([Result] -> x1
b1 [Result]
r1, [Result] -> x2
b2 [Result]
r2))
where ([Result]
a1,[Result] -> x1
b1) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
([Result]
a2,[Result] -> x2
b2) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith b -> c
f = forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
instance (CmdResult x1, CmdResult x2, CmdResult x3) => CmdResult (x1,x2,x3) where
cmdResult :: ([Result], [Result] -> (x1, x2, x3))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c)) -> (x1
a,x2
b,x3
c)
instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4) => CmdResult (x1,x2,x3,x4) where
cmdResult :: ([Result], [Result] -> (x1, x2, x3, x4))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c,x4
d)) -> (x1
a,x2
b,x3
c,x4
d)
instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4, CmdResult x5) => CmdResult (x1,x2,x3,x4,x5) where
cmdResult :: ([Result], [Result] -> (x1, x2, x3, x4, x5))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c,x4
d,x5
e)) -> (x1
a,x2
b,x3
c,x4
d,x5
e)
command :: (Partial, CmdResult r) => [CmdOption] -> String -> [String] -> Action r
command :: forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
opts String
x [String]
xs = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"command" [CmdOption]
opts [Result]
a String
x [String]
xs)
where ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
command_ :: Partial => [CmdOption] -> String -> [String] -> Action ()
command_ :: Partial => [CmdOption] -> String -> [String] -> Action ()
command_ [CmdOption]
opts String
x [String]
xs = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"command_" [CmdOption]
opts [] String
x [String]
xs)
type a :-> t = a
cmd :: (Partial, CmdArguments args) => args :-> Action r
cmd :: forall args r. (Partial, CmdArguments args) => args
cmd = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall t. (CmdArguments t, Partial) => CmdArgument -> t
cmdArguments forall a. Monoid a => a
mempty
cmd_ :: (Partial, CmdArguments args, Unit args) => args :-> Action ()
cmd_ :: forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall args r. (Partial, CmdArguments args) => args
cmd
newtype CmdArgument = CmdArgument [Either CmdOption String]
deriving (CmdArgument -> CmdArgument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdArgument -> CmdArgument -> Bool
$c/= :: CmdArgument -> CmdArgument -> Bool
== :: CmdArgument -> CmdArgument -> Bool
$c== :: CmdArgument -> CmdArgument -> Bool
Eq, NonEmpty CmdArgument -> CmdArgument
CmdArgument -> CmdArgument -> CmdArgument
forall b. Integral b => b -> CmdArgument -> CmdArgument
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CmdArgument -> CmdArgument
$cstimes :: forall b. Integral b => b -> CmdArgument -> CmdArgument
sconcat :: NonEmpty CmdArgument -> CmdArgument
$csconcat :: NonEmpty CmdArgument -> CmdArgument
<> :: CmdArgument -> CmdArgument -> CmdArgument
$c<> :: CmdArgument -> CmdArgument -> CmdArgument
Semigroup, Semigroup CmdArgument
CmdArgument
[CmdArgument] -> CmdArgument
CmdArgument -> CmdArgument -> CmdArgument
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CmdArgument] -> CmdArgument
$cmconcat :: [CmdArgument] -> CmdArgument
mappend :: CmdArgument -> CmdArgument -> CmdArgument
$cmappend :: CmdArgument -> CmdArgument -> CmdArgument
mempty :: CmdArgument
$cmempty :: CmdArgument
Monoid, Int -> CmdArgument -> String -> String
[CmdArgument] -> String -> String
CmdArgument -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CmdArgument] -> String -> String
$cshowList :: [CmdArgument] -> String -> String
show :: CmdArgument -> String
$cshow :: CmdArgument -> String
showsPrec :: Int -> CmdArgument -> String -> String
$cshowsPrec :: Int -> CmdArgument -> String -> String
Show)
class CmdArguments t where
cmdArguments :: Partial => CmdArgument -> t
instance (IsCmdArgument a, CmdArguments r) => CmdArguments (a -> r) where
cmdArguments :: Partial => CmdArgument -> a -> r
cmdArguments CmdArgument
xs a
x = forall t. (CmdArguments t, Partial) => CmdArgument -> t
cmdArguments forall a b. (a -> b) -> a -> b
$ CmdArgument
xs forall a. Monoid a => a -> a -> a
`mappend` forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument a
x
instance CmdResult r => CmdArguments (Action r) where
cmdArguments :: Partial => CmdArgument -> Action r
cmdArguments (CmdArgument [Either CmdOption String]
x) = case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
([CmdOption]
opts, String
x:[String]
xs) -> let ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"cmd" [CmdOption]
opts [Result]
a String
x [String]
xs)
([CmdOption], [String])
_ -> forall a. Partial => String -> a
error String
"Error, no executable or arguments given to Development.Shake.cmd"
instance CmdResult r => CmdArguments (IO r) where
cmdArguments :: Partial => CmdArgument -> IO r
cmdArguments (CmdArgument [Either CmdOption String]
x) = case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
([CmdOption]
opts, String
x:[String]
xs) -> let ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> IO [Result]
commandExplicitIO (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"cmd" [CmdOption]
opts [Result]
a String
x [String]
xs)
([CmdOption], [String])
_ -> forall a. Partial => String -> a
error String
"Error, no executable or arguments given to Development.Shake.cmd"
instance CmdArguments CmdArgument where
cmdArguments :: Partial => CmdArgument -> CmdArgument
cmdArguments = forall a. a -> a
id
class IsCmdArgument a where
toCmdArgument :: a -> CmdArgument
instance IsCmdArgument () where toCmdArgument :: () -> CmdArgument
toCmdArgument = forall a. Monoid a => a
mempty
instance IsCmdArgument String where toCmdArgument :: String -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
instance IsCmdArgument [String] where toCmdArgument :: [String] -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right
instance IsCmdArgument (NonEmpty String) where toCmdArgument :: NonEmpty String -> CmdArgument
toCmdArgument = forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance IsCmdArgument CmdOption where toCmdArgument :: CmdOption -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
instance IsCmdArgument [CmdOption] where toCmdArgument :: [CmdOption] -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left
instance IsCmdArgument CmdArgument where toCmdArgument :: CmdArgument -> CmdArgument
toCmdArgument = forall a. a -> a
id
instance IsCmdArgument a => IsCmdArgument (Maybe a) where toCmdArgument :: Maybe a -> CmdArgument
toCmdArgument = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument
showCommandForUser2 :: FilePath -> [String] -> String
showCommandForUser2 :: String -> [String] -> String
showCommandForUser2 String
cmd [String]
args = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> if String -> Bool
safe String
x then String
x else String -> [String] -> String
showCommandForUser String
x []) forall a b. (a -> b) -> a -> b
$ String
cmd forall a. a -> [a] -> [a]
: [String]
args
where
safe :: String -> Bool
safe String
xs = String
xs forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
bad String
xs)
bad :: Char -> Bool
bad Char
x = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| (Char
x forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWindows) Bool -> Bool -> Bool
|| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\"\'" :: String)