{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif
module Development.Shake.Command(
command, command_, cmd, cmd_, unit, CmdArgument(..), CmdArguments(..), IsCmdArgument(..), (:->),
Stdout(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..),
CmdResult, CmdString, CmdOption(..),
addPath, addEnv,
) where
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.IO.Class
import Data.Char
import Data.Either.Extra
import Data.List.Extra
import Data.Maybe
import Data.Semigroup (Semigroup)
import Data.Monoid
import System.Directory
import System.Environment.Extra
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 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import General.Extra
import General.Process
import Control.Applicative
import Prelude
import Development.Shake.Internal.CmdOption
import Development.Shake.Internal.Core.Run
import Development.Shake.FilePath
import Development.Shake.Internal.FilePattern
import Development.Shake.Internal.Options
import Development.Shake.Internal.Rules.File
import Development.Shake.Internal.Derived
addPath :: MonadIO m => [String] -> [String] -> m CmdOption
addPath :: [String] -> [String] -> m CmdOption
addPath pre :: [String]
pre post :: [String]
post = do
[(String, String)]
args <- IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
let (path :: [(String, String)]
path,other :: [(String, String)]
other) = ((String, String) -> Bool)
-> [(String, String)] -> ([(String, String)], [(String, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "PATH") (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else String -> String
forall a. a -> a
id) (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
args
CmdOption -> m CmdOption
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdOption -> m CmdOption) -> CmdOption -> m CmdOption
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env ([(String, String)] -> CmdOption)
-> [(String, String)] -> CmdOption
forall a b. (a -> b) -> a -> b
$
[("PATH",String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
pre [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
post) | [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
path] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
[(String
a,String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
pre [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
b | String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= ""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
post) | (a :: String
a,b :: String
b) <- [(String, String)]
path] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
[(String, String)]
other
addEnv :: MonadIO m => [(String, String)] -> m CmdOption
addEnv :: [(String, String)] -> m CmdOption
addEnv extra :: [(String, String)]
extra = do
[(String, String)]
args <- IO [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
CmdOption -> m CmdOption
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdOption -> m CmdOption) -> CmdOption -> m CmdOption
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env ([(String, String)] -> CmdOption)
-> [(String, String)] -> CmdOption
forall a b. (a -> b) -> a -> b
$ [(String, String)]
extra [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a :: String
a,_) -> String
a String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
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
(Str -> Str -> Bool) -> (Str -> Str -> Bool) -> Eq Str
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
data Result
= ResultStdout Str
| ResultStderr Str
| ResultStdouterr Str
| ResultCode ExitCode
| ResultTime Double
| ResultLine String
| ResultProcess PID
deriving Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
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
data PID = PID0 | PID ProcessHandle
instance Eq PID where _ == :: PID -> PID -> Bool
== _ = Bool
True
commandExplicit :: String -> [CmdOption] -> [Result] -> String -> [String] -> Action [Result]
commandExplicit :: String
-> [CmdOption] -> [Result] -> String -> [String] -> Action [Result]
commandExplicit funcName :: String
funcName oopts :: [CmdOption]
oopts results :: [Result]
results exe :: String
exe args :: [String]
args = 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,[String]
shakeLintIgnore :: ShakeOptions -> [String]
shakeLintIgnore :: [String]
shakeLintIgnore} <- Action ShakeOptions
getShakeOptions
let fopts :: [CmdOption]
fopts = [CmdOption]
shakeCommandOptions [CmdOption] -> [CmdOption] -> [CmdOption]
forall a. [a] -> [a] -> [a]
++ [CmdOption]
oopts
let useShell :: Bool
useShell = CmdOption
Shell CmdOption -> [CmdOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
fopts
let useLint :: Bool
useLint = Maybe Lint
shakeLint Maybe Lint -> Maybe Lint -> Bool
forall a. Eq a => a -> a -> Bool
== Lint -> Maybe Lint
forall a. a -> Maybe a
Just Lint
LintFSATrace
let useAutoDeps :: Bool
useAutoDeps = CmdOption
AutoDeps CmdOption -> [CmdOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
fopts
let opts :: [CmdOption]
opts = (CmdOption -> Bool) -> [CmdOption] -> [CmdOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (CmdOption -> CmdOption -> Bool
forall a. Eq a => a -> a -> Bool
/= CmdOption
Shell) [CmdOption]
fopts
let skipper :: Action [Result] -> Action [Result]
skipper act :: Action [Result]
act = if [Result] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Result]
results Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shakeRunCommands then [Result] -> Action [Result]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else Action [Result]
act
let verboser :: Action [Result] -> Action [Result]
verboser act :: Action [Result]
act = do
let cwd :: Maybe String
cwd = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String
x | Cwd x :: String
x <- [CmdOption]
opts]
String -> Action ()
putLoud (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$
String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\x :: String
x -> "cd " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "; ") Maybe String
cwd String -> String -> String
forall a. [a] -> [a] -> [a]
++
if Bool
useShell then [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
exe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args else String -> [String] -> String
showCommandForUser2 String
exe [String]
args
Verbosity
verb <- Action Verbosity
getVerbosity
(if Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Loud then Action [Result] -> Action [Result]
forall a. Action a -> Action a
quietly else Action [Result] -> Action [Result]
forall a. a -> a
id) Action [Result]
act
let tracer :: IO [Result] -> Action [Result]
tracer = case [String] -> [String]
forall a. [a] -> [a]
reverse [String
x | Traced x :: String
x <- [CmdOption]
opts] of
"":_ -> IO [Result] -> Action [Result]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
msg :: String
msg:_ -> String -> IO [Result] -> Action [Result]
forall a. String -> IO a -> Action a
traced String
msg
_ | Bool
useShell -> String -> IO [Result] -> Action [Result]
forall a. String -> IO a -> Action a
traced (String -> IO [Result] -> Action [Result])
-> String -> IO [Result] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
word1 String
exe
[] -> String -> IO [Result] -> Action [Result]
forall a. String -> IO a -> Action a
traced (String -> IO [Result] -> Action [Result])
-> String -> IO [Result] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
exe
let tracker :: (String -> [String] -> Action [Result]) -> Action [Result]
tracker act :: String -> [String] -> Action [Result]
act
| Bool
useLint = (String -> [String] -> Action [Result]) -> Action [Result]
fsatrace String -> [String] -> Action [Result]
act
| Bool
useAutoDeps = (String -> [String] -> Action [Result]) -> Action [Result]
autodeps String -> [String] -> Action [Result]
act
| Bool
useShell = (String -> [String] -> Action [Result]) -> Action [Result]
shelled String -> [String] -> Action [Result]
act
| Bool
otherwise = String -> [String] -> Action [Result]
act String
exe [String]
args
shelled :: (String -> [String] -> Action [Result]) -> Action [Result]
shelled = String
-> (String -> [String] -> Action [Result]) -> Action [Result]
forall a. String -> (String -> [String] -> Action a) -> Action a
runShell ([String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
exe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
ignore :: [String -> Bool]
ignore = (String -> String -> Bool) -> [String] -> [String -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map String -> String -> Bool
(?==) [String]
shakeLintIgnore
ham :: String -> [String] -> [String]
ham cwd :: String
cwd xs :: [String]
xs = [String -> String -> String
makeRelative String
cwd String
x | String
x <- (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toStandard [String]
xs
, (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String]
shakeLintInside
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((String -> Bool) -> Bool) -> [String -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
x) [String -> Bool]
ignore]
fsaCmd :: (String -> [String] -> Action [Result])
-> String -> String -> Action [Result]
fsaCmd act :: String -> [String] -> Action [Result]
act opts :: String
opts file :: String
file
| Bool
isMac = (String -> [String] -> Action [Result])
-> String -> String -> Action [Result]
fsaCmdMac String -> [String] -> Action [Result]
act String
opts String
file
| Bool
useShell = String
-> (String -> [String] -> Action [Result]) -> Action [Result]
forall a. String -> (String -> [String] -> Action a) -> Action a
runShell ([String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
exe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args) ((String -> [String] -> Action [Result]) -> Action [Result])
-> (String -> [String] -> Action [Result]) -> Action [Result]
forall a b. (a -> b) -> a -> b
$ \exe :: String
exe args :: [String]
args -> String -> [String] -> Action [Result]
act "fsatrace" ([String] -> Action [Result]) -> [String] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String
opts String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "--" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
exe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
| Bool
otherwise = String -> [String] -> Action [Result]
act "fsatrace" ([String] -> Action [Result]) -> [String] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String
opts String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "--" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
exe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
fsaCmdMac :: (String -> [String] -> Action [Result])
-> String -> String -> Action [Result]
fsaCmdMac act :: String -> [String] -> Action [Result]
act opts :: String
opts file :: String
file = do
let fakeExe :: String -> m String
fakeExe e :: String
e = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
Maybe String
me <- String -> IO (Maybe String)
findExecutable String
e
case Maybe String
me of
Just re :: String
re -> do
let isSystem :: Bool
isSystem = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
re) [ "/bin"
, "/usr"
, "/sbin"
]
if Bool
isSystem
then do
String
tmpdir <- IO String
getTemporaryDirectory
let fake :: String
fake = String
tmpdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "fsatrace-fakes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
re
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
doesFileExist String
fake) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
createDirectoryRecursive (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fake
String -> String -> IO ()
copyFile String
re String
fake
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fake
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
re
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
e
String
fexe <- String -> Action String
forall (m :: * -> *). MonadIO m => String -> m String
fakeExe String
exe
if Bool
useShell
then do
String
fsh <- String -> Action String
forall (m :: * -> *). MonadIO m => String -> m String
fakeExe "/bin/sh"
String -> [String] -> Action [Result]
act "fsatrace" ([String] -> Action [Result]) -> [String] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String
opts String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "--" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
fsh String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "-c" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
fexe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args]
else String -> [String] -> Action [Result]
act "fsatrace" ([String] -> Action [Result]) -> [String] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String
opts String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: "--" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
fexe String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
fsatrace :: (String -> [String] -> Action [Result]) -> Action [Result]
fsatrace act :: String -> [String] -> Action [Result]
act = (String -> Action [Result]) -> Action [Result]
forall a. (String -> Action a) -> Action a
withTempFile ((String -> Action [Result]) -> Action [Result])
-> (String -> Action [Result]) -> Action [Result]
forall a b. (a -> b) -> a -> b
$ \file :: String
file -> do
[Result]
res <- (String -> [String] -> Action [Result])
-> String -> String -> Action [Result]
fsaCmd String -> [String] -> Action [Result]
act "rwm" String
file
[FSAT]
xs <- IO [FSAT] -> Action [FSAT]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FSAT] -> Action [FSAT]) -> IO [FSAT] -> Action [FSAT]
forall a b. (a -> b) -> a -> b
$ String -> [FSAT]
parseFSAT (String -> [FSAT]) -> IO String -> IO [FSAT]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFileUTF8' String
file
String
cwd <- IO String -> Action String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
let reader :: FSAT -> Maybe String
reader (FSATRead x :: String
x) = String -> Maybe String
forall a. a -> Maybe a
Just String
x; reader _ = Maybe String
forall a. Maybe a
Nothing
writer :: FSAT -> Maybe String
writer (FSATWrite x :: String
x) = String -> Maybe String
forall a. a -> Maybe a
Just String
x; writer (FSATMove x :: String
x _) = String -> Maybe String
forall a. a -> Maybe a
Just String
x; writer _ = Maybe String
forall a. Maybe a
Nothing
existing :: (a -> Maybe String) -> [a] -> m [String]
existing f :: a -> Maybe String
f = IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String])
-> ([a] -> IO [String]) -> [a] -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String] -> IO [String])
-> ([a] -> [String]) -> [a] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> ([a] -> [String]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe String) -> [a] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe String
f
[String]
rs <- (FSAT -> Maybe String) -> [FSAT] -> Action [String]
forall (m :: * -> *) a.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing FSAT -> Maybe String
reader [FSAT]
xs
[String]
ws <- (FSAT -> Maybe String) -> [FSAT] -> Action [String]
forall (m :: * -> *) a.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing FSAT -> Maybe String
writer [FSAT]
xs
let reads :: [String]
reads = String -> [String] -> [String]
ham String
cwd [String]
rs
writes :: [String]
writes = String -> [String] -> [String]
ham String
cwd [String]
ws
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useAutoDeps (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
Action () -> Action ()
forall a. Action a -> Action a
unsafeAllowApply (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ [String] -> Action ()
needed [String]
reads
[String] -> Action ()
trackRead [String]
reads
[String] -> Action ()
trackWrite [String]
writes
[Result] -> Action [Result]
forall (m :: * -> *) a. Monad m => a -> m a
return [Result]
res
autodeps :: (String -> [String] -> Action [Result]) -> Action [Result]
autodeps act :: String -> [String] -> Action [Result]
act = (String -> Action [Result]) -> Action [Result]
forall a. (String -> Action a) -> Action a
withTempFile ((String -> Action [Result]) -> Action [Result])
-> (String -> Action [Result]) -> Action [Result]
forall a b. (a -> b) -> a -> b
$ \file :: String
file -> do
[Result]
res <- (String -> [String] -> Action [Result])
-> String -> String -> Action [Result]
fsaCmd String -> [String] -> Action [Result]
act "r" String
file
[FSAT]
pxs <- IO [FSAT] -> Action [FSAT]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FSAT] -> Action [FSAT]) -> IO [FSAT] -> Action [FSAT]
forall a b. (a -> b) -> a -> b
$ String -> [FSAT]
parseFSAT (String -> [FSAT]) -> IO String -> IO [FSAT]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFileUTF8' String
file
[String]
xs <- IO [String] -> Action [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Action [String]) -> IO [String] -> Action [String]
forall a b. (a -> b) -> a -> b
$ (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String
x | FSATRead x :: String
x <- [FSAT]
pxs]
String
cwd <- IO String -> Action String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
Action () -> Action ()
forall a. Action a -> Action a
unsafeAllowApply (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ [String] -> Action ()
need ([String] -> Action ()) -> [String] -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
ham String
cwd [String]
xs
[Result] -> Action [Result]
forall (m :: * -> *) a. Monad m => a -> m a
return [Result]
res
Action [Result] -> Action [Result]
skipper (Action [Result] -> Action [Result])
-> Action [Result] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> Action [Result]) -> Action [Result]
tracker ((String -> [String] -> Action [Result]) -> Action [Result])
-> (String -> [String] -> Action [Result]) -> Action [Result]
forall a b. (a -> b) -> a -> b
$ \exe :: String
exe args :: [String]
args -> Action [Result] -> Action [Result]
verboser (Action [Result] -> Action [Result])
-> Action [Result] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ IO [Result] -> Action [Result]
tracer (IO [Result] -> Action [Result]) -> IO [Result] -> Action [Result]
forall a b. (a -> b) -> a -> b
$ String
-> [CmdOption] -> [Result] -> String -> [String] -> IO [Result]
commandExplicitIO String
funcName [CmdOption]
opts [Result]
results String
exe [String]
args
runShell :: String -> (String -> [String] -> Action a) -> Action a
runShell :: String -> (String -> [String] -> Action a) -> Action a
runShell x :: String
x act :: String -> [String] -> Action a
act | Bool -> Bool
not Bool
isWindows = String -> [String] -> Action a
act "/bin/sh" ["-c",String
x]
runShell x :: String
x act :: String -> [String] -> Action a
act = (String -> Action a) -> Action a
forall a. (String -> Action a) -> Action a
withTempDir ((String -> Action a) -> Action a)
-> (String -> Action a) -> Action a
forall a b. (a -> b) -> a -> b
$ \dir :: String
dir -> do
let file :: String
file = String
dir String -> String -> String
</> "s.bat"
String -> String -> Action ()
forall (m :: * -> *). MonadIO m => String -> String -> m ()
writeFile' String
file String
x
String -> [String] -> Action a
act "cmd.exe" ["/d/q/c",String
file]
data FSAT
= FSATWrite FilePath
| FSATRead FilePath
| FSATDelete FilePath
| FSATMove FilePath FilePath
parseFSAT :: String -> [FSAT]
parseFSAT :: String -> [FSAT]
parseFSAT = (String -> Maybe FSAT) -> [String] -> [FSAT]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe FSAT
f ([String] -> [FSAT]) -> (String -> [String]) -> String -> [FSAT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where f :: String -> Maybe FSAT
f ('w':'|':xs :: String
xs) = FSAT -> Maybe FSAT
forall a. a -> Maybe a
Just (FSAT -> Maybe FSAT) -> FSAT -> Maybe FSAT
forall a b. (a -> b) -> a -> b
$ String -> FSAT
FSATWrite String
xs
f ('r':'|':xs :: String
xs) = FSAT -> Maybe FSAT
forall a. a -> Maybe a
Just (FSAT -> Maybe FSAT) -> FSAT -> Maybe FSAT
forall a b. (a -> b) -> a -> b
$ String -> FSAT
FSATRead String
xs
f ('d':'|':xs :: String
xs) = FSAT -> Maybe FSAT
forall a. a -> Maybe a
Just (FSAT -> Maybe FSAT) -> FSAT -> Maybe FSAT
forall a b. (a -> b) -> a -> b
$ String -> FSAT
FSATDelete String
xs
f ('m':'|':xs :: String
xs) | (xs :: String
xs,'|':ys :: String
ys) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|') String
xs = FSAT -> Maybe FSAT
forall a. a -> Maybe a
Just (FSAT -> Maybe FSAT) -> FSAT -> Maybe FSAT
forall a b. (a -> b) -> a -> b
$ String -> String -> FSAT
FSATMove String
xs String
ys
f _ = Maybe FSAT
forall a. Maybe a
Nothing
commandExplicitIO :: String -> [CmdOption] -> [Result] -> String -> [String] -> IO [Result]
commandExplicitIO :: String
-> [CmdOption] -> [Result] -> String -> [String] -> IO [Result]
commandExplicitIO funcName :: String
funcName opts :: [CmdOption]
opts results :: [Result]
results exe :: String
exe args :: [String]
args = do
let (grabStdout :: Bool
grabStdout, grabStderr :: Bool
grabStderr) = ([Bool] -> Bool) -> ([Bool], [Bool]) -> (Bool, Bool)
forall a b. (a -> b) -> (a, a) -> (b, b)
both [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (([Bool], [Bool]) -> (Bool, Bool))
-> ([Bool], [Bool]) -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ [(Bool, Bool)] -> ([Bool], [Bool])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Bool, Bool)] -> ([Bool], [Bool]))
-> [(Bool, Bool)] -> ([Bool], [Bool])
forall a b. (a -> b) -> a -> b
$ [Result] -> (Result -> (Bool, Bool)) -> [(Bool, Bool)]
forall a b. [a] -> (a -> b) -> [b]
for [Result]
results ((Result -> (Bool, Bool)) -> [(Bool, Bool)])
-> (Result -> (Bool, Bool)) -> [(Bool, Bool)]
forall a b. (a -> b) -> a -> b
$ \r :: Result
r -> case Result
r of
ResultStdout{} -> (Bool
True, Bool
False)
ResultStderr{} -> (Bool
False, Bool
True)
ResultStdouterr{} -> (Bool
True, Bool
True)
_ -> (Bool
False, Bool
False)
Maybe [(String, String)]
optEnv <- [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv [CmdOption]
opts
let optCwd :: Maybe String
optCwd = let x :: String
x = [String] -> String
forall a. [a] -> a
last ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ "" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
x | Cwd x :: String
x <- [CmdOption]
opts] in if String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
x
let optStdin :: [Source]
optStdin = ((CmdOption -> Maybe Source) -> [CmdOption] -> [Source])
-> [CmdOption] -> (CmdOption -> Maybe Source) -> [Source]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CmdOption -> Maybe Source) -> [CmdOption] -> [Source]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [CmdOption]
opts ((CmdOption -> Maybe Source) -> [Source])
-> (CmdOption -> Maybe Source) -> [Source]
forall a b. (a -> b) -> a -> b
$ \x :: CmdOption
x -> case CmdOption
x of
Stdin x :: String
x -> Source -> Maybe Source
forall a. a -> Maybe a
Just (Source -> Maybe Source) -> Source -> Maybe Source
forall a b. (a -> b) -> a -> b
$ String -> Source
SrcString String
x
StdinBS x :: ByteString
x -> Source -> Maybe Source
forall a. a -> Maybe a
Just (Source -> Maybe Source) -> Source -> Maybe Source
forall a b. (a -> b) -> a -> b
$ ByteString -> Source
SrcBytes ByteString
x
FileStdin x :: String
x -> Source -> Maybe Source
forall a. a -> Maybe a
Just (Source -> Maybe Source) -> Source -> Maybe Source
forall a b. (a -> b) -> a -> b
$ String -> Source
SrcFile String
x
_ -> Maybe Source
forall a. Maybe a
Nothing
let optShell :: Bool
optShell = CmdOption
Shell CmdOption -> [CmdOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
let optBinary :: Bool
optBinary = CmdOption
BinaryPipes CmdOption -> [CmdOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
let optAsync :: Bool
optAsync = PID -> Result
ResultProcess PID
PID0 Result -> [Result] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results
let optTimeout :: Maybe Double
optTimeout = [Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe ([Double] -> Maybe Double) -> [Double] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. [a] -> [a]
reverse [Double
x | Timeout x :: Double
x <- [CmdOption]
opts]
let optWithStdout :: Bool
optWithStdout = [Bool] -> Bool
forall a. [a] -> a
last ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool
x | WithStdout x :: Bool
x <- [CmdOption]
opts]
let optWithStderr :: Bool
optWithStderr = [Bool] -> Bool
forall a. [a] -> a
last ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool
x | WithStderr x :: Bool
x <- [CmdOption]
opts]
let optFileStdout :: [String]
optFileStdout = [String
x | FileStdout x :: String
x <- [CmdOption]
opts]
let optFileStderr :: [String]
optFileStderr = [String
x | FileStderr x :: String
x <- [CmdOption]
opts]
let optEchoStdout :: Bool
optEchoStdout = [Bool] -> Bool
forall a. [a] -> a
last ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool
not Bool
grabStdout Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStdout) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool
x | EchoStdout x :: Bool
x <- [CmdOption]
opts]
let optEchoStderr :: Bool
optEchoStderr = [Bool] -> Bool
forall a. [a] -> a
last ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool
not Bool
grabStderr Bool -> Bool -> Bool
&& [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStderr) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool
x | EchoStderr x :: Bool
x <- [CmdOption]
opts]
let cmdline :: String
cmdline = String -> [String] -> String
showCommandForUser2 String
exe [String]
args
let bufLBS :: (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS f :: ByteString -> Str
f = do (a :: [Destination]
a,b :: IO Str
b) <- Str -> IO ([Destination], IO Str)
buf (Str -> IO ([Destination], IO Str))
-> Str -> IO ([Destination], IO Str)
forall a b. (a -> b) -> a -> b
$ ByteString -> Str
LBS ByteString
LBS.empty; ([Destination], IO Str) -> IO ([Destination], IO Str)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Destination]
a, (\(LBS x :: ByteString
x) -> ByteString -> Str
f ByteString
x) (Str -> Str) -> IO Str -> IO Str
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 (String -> Str) -> (ByteString -> String) -> ByteString -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LBS.unpack)
buf Str{} = do Buffer String
x <- IO (Buffer String)
forall a. IO (Buffer a)
newBuffer; ([Destination], IO Str) -> IO ([Destination], IO Str)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Buffer String -> Destination
DestString Buffer String
x | Bool -> Bool
not Bool
optAsync], String -> Str
Str (String -> Str) -> ([String] -> String) -> [String] -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> Str) -> IO [String] -> IO Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer String -> IO [String]
forall a. Buffer a -> IO [a]
readBuffer Buffer String
x)
buf LBS{} = do Buffer ByteString
x <- IO (Buffer ByteString)
forall a. IO (Buffer a)
newBuffer; ([Destination], IO Str) -> IO ([Destination], IO Str)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Buffer ByteString -> Destination
DestBytes Buffer ByteString
x | Bool -> Bool
not Bool
optAsync], ByteString -> Str
LBS (ByteString -> Str)
-> ([ByteString] -> ByteString) -> [ByteString] -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> Str) -> IO [ByteString] -> IO Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer ByteString -> IO [ByteString]
forall a. Buffer a -> IO [a]
readBuffer Buffer ByteString
x)
buf BS {} = (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS (ByteString -> Str
BS (ByteString -> Str)
-> (ByteString -> ByteString) -> ByteString -> Str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks)
buf Unit = ([Destination], IO Str) -> IO ([Destination], IO Str)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Str -> IO Str
forall (m :: * -> *) a. Monad m => a -> m a
return Str
Unit)
(dStdout :: [[Destination]]
dStdout, dStderr :: [[Destination]]
dStderr, resultBuild :: [Double -> ProcessHandle -> ExitCode -> IO Result]
resultBuild) :: ([[Destination]], [[Destination]], [Double -> ProcessHandle -> ExitCode -> IO Result]) <-
([([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
-> ([[Destination]], [[Destination]],
[Double -> ProcessHandle -> ExitCode -> IO Result]))
-> IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
-> IO
([[Destination]], [[Destination]],
[Double -> ProcessHandle -> ExitCode -> IO Result])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
-> ([[Destination]], [[Destination]],
[Double -> ProcessHandle -> ExitCode -> IO Result])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
-> IO
([[Destination]], [[Destination]],
[Double -> ProcessHandle -> ExitCode -> IO Result]))
-> IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
-> IO
([[Destination]], [[Destination]],
[Double -> ProcessHandle -> ExitCode -> IO Result])
forall a b. (a -> b) -> a -> b
$ [Result]
-> (Result
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result))
-> IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Result]
results ((Result
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result))
-> IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)])
-> (Result
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result))
-> IO
[([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)]
forall a b. (a -> b) -> a -> b
$ \r :: Result
r -> case Result
r of
ResultCode _ -> ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], \_ _ ex :: ExitCode
ex -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ ExitCode -> Result
ResultCode ExitCode
ex)
ResultTime _ -> ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], \dur :: Double
dur _ _ -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ Double -> Result
ResultTime Double
dur)
ResultLine _ -> ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], \_ _ _ -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> Result
ResultLine String
cmdline)
ResultProcess _ -> ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [], \_ pid :: ProcessHandle
pid _ -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ PID -> Result
ResultProcess (PID -> Result) -> PID -> Result
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> PID
PID ProcessHandle
pid)
ResultStdout s :: Str
s -> do (a :: [Destination]
a,b :: IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Destination]
a , [], \_ _ _ -> (Str -> Result) -> IO Str -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdout IO Str
b)
ResultStderr s :: Str
s -> do (a :: [Destination]
a,b :: IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Destination]
a , \_ _ _ -> (Str -> Result) -> IO Str -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStderr IO Str
b)
ResultStdouterr s :: Str
s -> do (a :: [Destination]
a,b :: IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; ([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
-> IO
([Destination], [Destination],
Double -> ProcessHandle -> ExitCode -> IO Result)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Destination]
a , [Destination]
a , \_ _ _ -> (Str -> Result) -> IO Str -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdouterr IO Str
b)
Buffer String
exceptionBuffer <- IO (Buffer String)
forall a. IO (Buffer a)
newBuffer
ProcessOpts
po <- ProcessOpts -> IO ProcessOpts
resolvePath ProcessOpts :: CmdSpec
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Double
-> [Source]
-> [Destination]
-> [Destination]
-> Bool
-> ProcessOpts
ProcessOpts
{poCommand :: CmdSpec
poCommand = if Bool
optShell then String -> CmdSpec
ShellCommand (String -> CmdSpec) -> String -> CmdSpec
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
exeString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args else String -> [String] -> CmdSpec
RawCommand String
exe [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 ([Source] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Source]
optStdin)] [Source] -> [Source] -> [Source]
forall a. [a] -> [a] -> [a]
++ [Source]
optStdin
,poStdout :: [Destination]
poStdout = [Destination
DestEcho | Bool
optEchoStdout] [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ (String -> Destination) -> [String] -> [Destination]
forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStdout [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStdout Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ [[Destination]] -> [Destination]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStdout
,poStderr :: [Destination]
poStderr = [Destination
DestEcho | Bool
optEchoStderr] [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ (String -> Destination) -> [String] -> [Destination]
forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStderr [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStderr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] [Destination] -> [Destination] -> [Destination]
forall a. [a] -> [a] -> [a]
++ [[Destination]] -> [Destination]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStderr
,poAsync :: Bool
poAsync = Bool
optAsync
}
(dur :: Double
dur,(pid :: ProcessHandle
pid,exit :: ExitCode
exit)) <- IO (ProcessHandle, ExitCode)
-> IO (Double, (ProcessHandle, ExitCode))
forall a. IO a -> IO (Double, a)
duration (IO (ProcessHandle, ExitCode)
-> IO (Double, (ProcessHandle, ExitCode)))
-> IO (ProcessHandle, ExitCode)
-> IO (Double, (ProcessHandle, ExitCode))
forall a b. (a -> b) -> a -> b
$ ProcessOpts -> IO (ProcessHandle, ExitCode)
process ProcessOpts
po
if ExitCode
exit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
|| ExitCode -> Result
ResultCode ExitCode
ExitSuccess Result -> [Result] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results then
((Double -> ProcessHandle -> ExitCode -> IO Result) -> IO Result)
-> [Double -> ProcessHandle -> ExitCode -> IO Result]
-> IO [Result]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\f :: 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 <- Buffer String -> IO [String]
forall a. Buffer a -> IO [a]
readBuffer Buffer String
exceptionBuffer
let captured :: [String]
captured = ["Stderr" | Bool
optWithStderr] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["Stdout" | Bool
optWithStdout]
String
cwd <- case Maybe String
optCwd of
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
Just v :: String
v -> do
String
v <- String -> IO String
canonicalizePath String
v IO String -> (IOException -> IO String) -> IO String
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IO String -> IOException -> IO String
forall a b. a -> b -> a
const (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
v)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ "Current directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
String -> IO [Result]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO [Result]) -> String -> IO [Result]
forall a b. (a -> b) -> a -> b
$
"Development.Shake." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", system command failed\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Command: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdline String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
cwd String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Exit code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (case ExitCode
exit of ExitFailure i :: Int
i -> Int
i; _ -> 0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
captured then "Stderr not captured because WithStderr False was used\n"
else if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
exceptionBuffer then String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " and " [String]
captured String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
captured Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "was" else "were") String -> String -> String
forall a. [a] -> [a] -> [a]
++ " empty"
else String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " and " [String]
captured String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
exceptionBuffer)
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv opts :: [CmdOption]
opts
| [[(String, String)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env, [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
addEnv, [([String], [String])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], [String])]
addPath, [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
remEnv = Maybe [(String, String)] -> IO (Maybe [(String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, String)]
forall a. Maybe a
Nothing
| Bool
otherwise = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> Maybe [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
forall b. [(String, b)] -> [(String, b)]
unique ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
tweakPath ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
addEnv) ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [String]
remEnv (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> Maybe [(String, String)])
-> IO [(String, String)] -> IO (Maybe [(String, String)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
if [[(String, String)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env then IO [(String, String)]
getEnvironment else [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]]
env)
where
env :: [[(String, String)]]
env = [[(String, String)]
x | Env x :: [(String, String)]
x <- [CmdOption]
opts]
addEnv :: [(String, String)]
addEnv = [(String
x,String
y) | AddEnv x :: String
x y :: String
y <- [CmdOption]
opts]
remEnv :: [String]
remEnv = [String
x | RemEnv x :: String
x <- [CmdOption]
opts]
addPath :: [([String], [String])]
addPath = [([String]
x,[String]
y) | AddPath x :: [String]
x y :: [String]
y <- [CmdOption]
opts]
newPath :: String -> String
newPath mid :: String
mid = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (([String], [String]) -> [String])
-> [([String], [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst [([String], [String])]
addPath) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
mid | String
mid String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= ""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (([String], [String]) -> [String])
-> [([String], [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd [([String], [String])]
addPath
isPath :: String -> Bool
isPath x :: String
x = (if Bool
isWindows then String -> String
upper else String -> String
forall a. a -> a
id) String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "PATH"
tweakPath :: [(String, String)] -> [(String, String)]
tweakPath xs :: [(String, String)]
xs | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Bool) -> [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
isPath (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
xs = ("PATH", String -> String
newPath "") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
xs
| Bool
otherwise = ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: String
a,b :: 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 = [(String, b)] -> [(String, b)]
forall a. [a] -> [a]
reverse ([(String, b)] -> [(String, b)])
-> ([(String, b)] -> [(String, b)])
-> [(String, b)]
-> [(String, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, b) -> String) -> [(String, b)] -> [(String, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (if Bool
isWindows then String -> String
upper (String -> String)
-> ((String, b) -> String) -> (String, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, b) -> String
forall a b. (a, b) -> a
fst else (String, b) -> String
forall a b. (a, b) -> a
fst) ([(String, b)] -> [(String, b)])
-> ([(String, b)] -> [(String, b)])
-> [(String, b)]
-> [(String, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, b)] -> [(String, b)]
forall a. [a] -> [a]
reverse
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath po :: ProcessOpts
po
| Just e :: [(String, String)]
e <- ProcessOpts -> Maybe [(String, String)]
poEnv ProcessOpts
po
, Just (_, path :: String
path) <- ((String, String) -> Bool)
-> [(String, String)] -> Maybe (String, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) "PATH" (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else String -> String
forall a. a -> a
id) (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
e
, RawCommand prog :: String
prog args :: [String]
args <- ProcessOpts -> CmdSpec
poCommand ProcessOpts
po
= do
let progExe :: String
progExe = if String
prog String -> String -> Bool
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 <- IO String -> IO String
forall a. IO a -> IO a
unsafeInterleaveIO (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv "PATH"
Maybe String
old <- IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
prog
Maybe String
new <- IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
path) String
progExe
Maybe String
old2 <- IO (Maybe String) -> IO (Maybe String)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe String) -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
pathOld) String
progExe
Bool
switch <- Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case () of
_ | String
path String -> String -> Bool
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 old :: String
old <- Maybe String
old, Just new :: String
new <- Maybe String
new, String -> String -> Bool
equalFilePath String
old String
new -> Bool
False
| Just old :: String
old <- Maybe String
old, Just old2 :: String
old2 <- Maybe String
old2, String -> String -> Bool
equalFilePath String
old String
old2 -> Bool
True
| Bool
otherwise -> Bool
False
ProcessOpts -> IO ProcessOpts
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessOpts -> IO ProcessOpts) -> ProcessOpts -> IO ProcessOpts
forall a b. (a -> b) -> a -> b
$ case Maybe String
new of
Just new :: String
new | Bool
switch -> ProcessOpts
po{poCommand :: CmdSpec
poCommand = String -> [String] -> CmdSpec
RawCommand String
new [String]
args}
_ -> ProcessOpts
po
resolvePath po :: ProcessOpts
po = ProcessOpts -> IO ProcessOpts
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessOpts
po
findExecutableWith :: [FilePath] -> String -> IO (Maybe FilePath)
findExecutableWith :: [String] -> String -> IO (Maybe String)
findExecutableWith path :: [String]
path x :: String
x = ((String -> IO (Maybe String)) -> [String] -> IO (Maybe String))
-> [String] -> (String -> IO (Maybe String)) -> IO (Maybe String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> IO (Maybe String)) -> [String] -> IO (Maybe String)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
x) [String]
path) ((String -> IO (Maybe String)) -> IO (Maybe String))
-> (String -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \s :: String
s ->
IO Bool
-> IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
s) (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
s) (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing)
newtype Stdout a = Stdout {Stdout a -> a
fromStdout :: a}
newtype Stderr a = Stderr {Stderr a -> a
fromStderr :: a}
newtype Stdouterr a = Stdouterr {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, \Unit -> ())
instance CmdString String where cmdString :: (Str, Str -> String)
cmdString = (String -> Str
Str "", \(Str x :: String
x) -> String
x)
instance CmdString BS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
BS ByteString
BS.empty, \(BS x :: ByteString
x) -> ByteString
x)
instance CmdString LBS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
LBS ByteString
LBS.empty, \(LBS x :: ByteString
x) -> ByteString
x)
#if __GLASGOW_HASKELL__ >= 710
class Unit a
instance {-# OVERLAPPING #-} Unit b => Unit (a -> b)
instance {-# OVERLAPPABLE #-} a ~ () => Unit (m a)
#else
class Unit a
instance Unit b => Unit (a -> b)
instance a ~ () => Unit (m a)
#endif
class CmdResult a where
cmdResult :: ([Result], [Result] -> a)
instance CmdResult Exit where
cmdResult :: ([Result], [Result] -> Exit)
cmdResult = ([ExitCode -> Result
ResultCode ExitCode
ExitSuccess], \[ResultCode x :: ExitCode
x] -> ExitCode -> Exit
Exit ExitCode
x)
instance CmdResult ExitCode where
cmdResult :: ([Result], [Result] -> ExitCode)
cmdResult = ([ExitCode -> Result
ResultCode ExitCode
ExitSuccess], \[ResultCode x :: ExitCode
x] -> ExitCode
x)
instance CmdResult Process where
cmdResult :: ([Result], [Result] -> Process)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID x :: ProcessHandle
x)] -> ProcessHandle -> Process
Process ProcessHandle
x)
instance CmdResult ProcessHandle where
cmdResult :: ([Result], [Result] -> ProcessHandle)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID x :: ProcessHandle
x)] -> ProcessHandle
x)
instance CmdResult CmdLine where
cmdResult :: ([Result], [Result] -> CmdLine)
cmdResult = ([String -> Result
ResultLine ""], \[ResultLine x :: String
x] -> String -> CmdLine
CmdLine String
x)
instance CmdResult CmdTime where
cmdResult :: ([Result], [Result] -> CmdTime)
cmdResult = ([Double -> Result
ResultTime 0], \[ResultTime x :: Double
x] -> Double -> CmdTime
CmdTime Double
x)
instance CmdString a => CmdResult (Stdout a) where
cmdResult :: ([Result], [Result] -> Stdout a)
cmdResult = let (a :: Str
a,b :: Str -> a
b) = (Str, Str -> a)
forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdout Str
a], \[ResultStdout x :: Str
x] -> a -> Stdout a
forall a. a -> Stdout a
Stdout (a -> Stdout a) -> a -> Stdout a
forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)
instance CmdString a => CmdResult (Stderr a) where
cmdResult :: ([Result], [Result] -> Stderr a)
cmdResult = let (a :: Str
a,b :: Str -> a
b) = (Str, Str -> a)
forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStderr Str
a], \[ResultStderr x :: Str
x] -> a -> Stderr a
forall a. a -> Stderr a
Stderr (a -> Stderr a) -> a -> Stderr a
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 (a :: Str
a,b :: Str -> a
b) = (Str, Str -> a)
forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdouterr Str
a], \[ResultStdouterr x :: Str
x] -> a -> Stdouterr a
forall a. a -> Stdouterr a
Stdouterr (a -> Stdouterr a) -> a -> Stdouterr a
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]
a1[Result] -> [Result] -> [Result]
forall a. [a] -> [a] -> [a]
++[Result]
a2, \rs :: [Result]
rs -> let (r1 :: [Result]
r1,r2 :: [Result]
r2) = Int -> [Result] -> ([Result], [Result])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Result] -> Int
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 (a1 :: [Result]
a1,b1 :: [Result] -> x1
b1) = ([Result], [Result] -> x1)
forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
(a2 :: [Result]
a2,b2 :: [Result] -> x2
b2) = ([Result], [Result] -> x2)
forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith :: (b -> c) -> ([Result], [Result] -> c)
cmdResultWith f :: b -> c
f = (([Result] -> b) -> [Result] -> c)
-> ([Result], [Result] -> b) -> ([Result], [Result] -> c)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (b -> c
f (b -> c) -> ([Result] -> b) -> [Result] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ([Result], [Result] -> b)
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 = ((x1, (x2, x3)) -> (x1, x2, x3))
-> ([Result], [Result] -> (x1, x2, x3))
forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith (((x1, (x2, x3)) -> (x1, x2, x3))
-> ([Result], [Result] -> (x1, x2, x3)))
-> ((x1, (x2, x3)) -> (x1, x2, x3))
-> ([Result], [Result] -> (x1, x2, x3))
forall a b. (a -> b) -> a -> b
$ \(a :: x1
a,(b :: x2
b,c :: 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 = ((x1, (x2, x3, x4)) -> (x1, x2, x3, x4))
-> ([Result], [Result] -> (x1, x2, x3, x4))
forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith (((x1, (x2, x3, x4)) -> (x1, x2, x3, x4))
-> ([Result], [Result] -> (x1, x2, x3, x4)))
-> ((x1, (x2, x3, x4)) -> (x1, x2, x3, x4))
-> ([Result], [Result] -> (x1, x2, x3, x4))
forall a b. (a -> b) -> a -> b
$ \(a :: x1
a,(b :: x2
b,c :: x3
c,d :: 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 = ((x1, (x2, x3, x4, x5)) -> (x1, x2, x3, x4, x5))
-> ([Result], [Result] -> (x1, x2, x3, x4, x5))
forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith (((x1, (x2, x3, x4, x5)) -> (x1, x2, x3, x4, x5))
-> ([Result], [Result] -> (x1, x2, x3, x4, x5)))
-> ((x1, (x2, x3, x4, x5)) -> (x1, x2, x3, x4, x5))
-> ([Result], [Result] -> (x1, x2, x3, x4, x5))
forall a b. (a -> b) -> a -> b
$ \(a :: x1
a,(b :: x2
b,c :: x3
c,d :: x4
d,e :: x5
e)) -> (x1
a,x2
b,x3
c,x4
d,x5
e)
command :: CmdResult r => [CmdOption] -> String -> [String] -> Action r
command :: [CmdOption] -> String -> [String] -> Action r
command opts :: [CmdOption]
opts x :: String
x xs :: [String]
xs = [Result] -> r
b ([Result] -> r) -> Action [Result] -> Action r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [CmdOption] -> [Result] -> String -> [String] -> Action [Result]
commandExplicit "command" [CmdOption]
opts [Result]
a String
x [String]
xs
where (a :: [Result]
a,b :: [Result] -> r
b) = ([Result], [Result] -> r)
forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
command_ :: [CmdOption] -> String -> [String] -> Action ()
command_ :: [CmdOption] -> String -> [String] -> Action ()
command_ opts :: [CmdOption]
opts x :: String
x xs :: [String]
xs = Action [Result] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [Result] -> Action ()) -> Action [Result] -> Action ()
forall a b. (a -> b) -> a -> b
$ String
-> [CmdOption] -> [Result] -> String -> [String] -> Action [Result]
commandExplicit "command_" [CmdOption]
opts [] String
x [String]
xs
type a :-> t = a
cmd :: CmdArguments args => args :-> Action r
cmd :: args :-> Action r
cmd = CmdArgument -> args :-> Action r
forall t. CmdArguments t => CmdArgument -> t
cmdArguments CmdArgument
forall a. Monoid a => a
mempty
cmd_ :: (CmdArguments args, Unit args) => args :-> Action ()
cmd_ :: args :-> Action ()
cmd_ = args :-> Action ()
forall args r. CmdArguments args => args
cmd
newtype CmdArgument = CmdArgument [Either CmdOption String]
deriving (CmdArgument -> CmdArgument -> Bool
(CmdArgument -> CmdArgument -> Bool)
-> (CmdArgument -> CmdArgument -> Bool) -> Eq CmdArgument
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, b -> CmdArgument -> CmdArgument
NonEmpty CmdArgument -> CmdArgument
CmdArgument -> CmdArgument -> CmdArgument
(CmdArgument -> CmdArgument -> CmdArgument)
-> (NonEmpty CmdArgument -> CmdArgument)
-> (forall b. Integral b => b -> CmdArgument -> CmdArgument)
-> Semigroup 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 :: 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
Semigroup CmdArgument =>
CmdArgument
-> (CmdArgument -> CmdArgument -> CmdArgument)
-> ([CmdArgument] -> CmdArgument)
-> Monoid 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
$cp1Monoid :: Semigroup CmdArgument
Monoid, Int -> CmdArgument -> String -> String
[CmdArgument] -> String -> String
CmdArgument -> String
(Int -> CmdArgument -> String -> String)
-> (CmdArgument -> String)
-> ([CmdArgument] -> String -> String)
-> Show CmdArgument
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 :: CmdArgument -> t
instance (IsCmdArgument a, CmdArguments r) => CmdArguments (a -> r) where
cmdArguments :: CmdArgument -> a -> r
cmdArguments xs :: CmdArgument
xs x :: a
x = CmdArgument -> r
forall t. CmdArguments t => CmdArgument -> t
cmdArguments (CmdArgument -> r) -> CmdArgument -> r
forall a b. (a -> b) -> a -> b
$ CmdArgument
xs CmdArgument -> CmdArgument -> CmdArgument
forall a. Monoid a => a -> a -> a
`mappend` a -> CmdArgument
forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument a
x
instance CmdResult r => CmdArguments (Action r) where
cmdArguments :: CmdArgument -> Action r
cmdArguments (CmdArgument x :: [Either CmdOption String]
x) = case [Either CmdOption String] -> ([CmdOption], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
(opts :: [CmdOption]
opts, x :: String
x:xs :: [String]
xs) -> let (a :: [Result]
a,b :: [Result] -> r
b) = ([Result], [Result] -> r)
forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b ([Result] -> r) -> Action [Result] -> Action r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [CmdOption] -> [Result] -> String -> [String] -> Action [Result]
commandExplicit "cmd" [CmdOption]
opts [Result]
a String
x [String]
xs
_ -> String -> Action r
forall a. HasCallStack => String -> a
error "Error, no executable or arguments given to Development.Shake.cmd"
instance CmdResult r => CmdArguments (IO r) where
cmdArguments :: CmdArgument -> IO r
cmdArguments (CmdArgument x :: [Either CmdOption String]
x) = case [Either CmdOption String] -> ([CmdOption], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
(opts :: [CmdOption]
opts, x :: String
x:xs :: [String]
xs) -> let (a :: [Result]
a,b :: [Result] -> r
b) = ([Result], [Result] -> r)
forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b ([Result] -> r) -> IO [Result] -> IO r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [CmdOption] -> [Result] -> String -> [String] -> IO [Result]
commandExplicitIO "cmd" [CmdOption]
opts [Result]
a String
x [String]
xs
_ -> String -> IO r
forall a. HasCallStack => String -> a
error "Error, no executable or arguments given to Development.Shake.cmd"
instance CmdArguments CmdArgument where
cmdArguments :: CmdArgument -> CmdArgument
cmdArguments = CmdArgument -> CmdArgument
forall a. a -> a
id
class IsCmdArgument a where
toCmdArgument :: a -> CmdArgument
instance IsCmdArgument String where toCmdArgument :: String -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument ([Either CmdOption String] -> CmdArgument)
-> (String -> [Either CmdOption String]) -> String -> CmdArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either CmdOption String)
-> [String] -> [Either CmdOption String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either CmdOption String
forall a b. b -> Either a b
Right ([String] -> [Either CmdOption String])
-> (String -> [String]) -> String -> [Either CmdOption String]
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 ([Either CmdOption String] -> CmdArgument)
-> ([String] -> [Either CmdOption String])
-> [String]
-> CmdArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either CmdOption String)
-> [String] -> [Either CmdOption String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either CmdOption String
forall a b. b -> Either a b
Right
instance IsCmdArgument CmdOption where toCmdArgument :: CmdOption -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument ([Either CmdOption String] -> CmdArgument)
-> (CmdOption -> [Either CmdOption String])
-> CmdOption
-> CmdArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CmdOption String -> [Either CmdOption String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CmdOption String -> [Either CmdOption String])
-> (CmdOption -> Either CmdOption String)
-> CmdOption
-> [Either CmdOption String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdOption -> Either CmdOption String
forall a b. a -> Either a b
Left
instance IsCmdArgument [CmdOption] where toCmdArgument :: [CmdOption] -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument ([Either CmdOption String] -> CmdArgument)
-> ([CmdOption] -> [Either CmdOption String])
-> [CmdOption]
-> CmdArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CmdOption -> Either CmdOption String)
-> [CmdOption] -> [Either CmdOption String]
forall a b. (a -> b) -> [a] -> [b]
map CmdOption -> Either CmdOption String
forall a b. a -> Either a b
Left
instance IsCmdArgument a => IsCmdArgument (Maybe a) where toCmdArgument :: Maybe a -> CmdArgument
toCmdArgument = CmdArgument -> (a -> CmdArgument) -> Maybe a -> CmdArgument
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CmdArgument
forall a. Monoid a => a
mempty a -> CmdArgument
forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument
showCommandForUser2 :: FilePath -> [String] -> String
showCommandForUser2 :: String -> [String] -> String
showCommandForUser2 cmd :: String
cmd args :: [String]
args = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: String
x -> if String -> Bool
forall (t :: * -> *). Foldable t => t Char -> Bool
safe String
x then String
x else String -> [String] -> String
showCommandForUser String
x []) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
where
safe :: t Char -> Bool
safe xs :: t Char
xs = Bool -> Bool
not (t Char -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
xs) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
bad t Char
xs)
bad :: Char -> Bool
bad x :: Char
x = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\\' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWindows) Bool -> Bool -> Bool
|| Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "\"\'"