{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}

#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif


-- | This module provides functions for calling command line programs, primarily
--   'command' and 'cmd'. As a simple example:
--
-- @
-- 'command' [] \"gcc\" [\"-c\",myfile]
-- @
--
--   The functions from this module are now available directly from "Development.Shake".
--   You should only need to import this module if you are using the 'cmd' function in the 'IO' monad.
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

---------------------------------------------------------------------
-- ACTUAL EXECUTION

-- | /Deprecated:/ Use 'AddPath'. This function will be removed in a future version.
--
--   Add a prefix and suffix to the @$PATH@ environment variable. For example:
--
-- @
-- opt <- 'addPath' [\"\/usr\/special\"] []
-- 'cmd' opt \"userbinary --version\"
-- @
--
--   Would prepend @\/usr\/special@ to the current @$PATH@, and the command would pick
--   @\/usr\/special\/userbinary@, if it exists. To add other variables see 'addEnv'.
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

-- | /Deprecated:/ Use 'AddEnv'. This function will be removed in a future version.
--
--   Add a single variable to the environment. For example:
--
-- @
-- opt <- 'addEnv' [(\"CFLAGS\",\"-O2\")]
-- 'cmd' opt \"gcc -c main.c\"
-- @
--
--   Would add the environment variable @$CFLAGS@ with value @-O2@. If the variable @$CFLAGS@
--   was already defined it would be overwritten. If you wish to modify @$PATH@ see 'addPath'.
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


---------------------------------------------------------------------
-- ACTION EXPLICIT OPERATION

-- | Given explicit operations, apply the advance ones, like skip/trace/track/autodep
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
            -- run quietly to supress the tracer (don't want to print twice)
            (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


-- | Given a shell command, call the continuation with the sanitised exec-style arguments
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] -- do exactly what Haskell does
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]


-- | Parse the FSATrace structure
data FSAT
    = FSATWrite FilePath
    | FSATRead FilePath
    | FSATDelete FilePath
    | FSATMove FilePath FilePath

-- | Parse the 'FSAT' entries, ignoring anything you don't understand.
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

---------------------------------------------------------------------
-- IO EXPLICIT OPERATION

-- | Given a very explicit set of CmdOption, translate them to a General.Process structure
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)


-- | Apply all environment operations, to produce a new environment to use.
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


-- | If the user specifies a custom $PATH, and not Shell, then try and resolve their exe ourselves.
--   Tricky, because on Windows it doesn't look in the $PATH first.
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
    -- use unsafeInterleaveIO to allow laziness to skip the queries we don't use
    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 -- The state I can see hasn't changed
          | Maybe String
Nothing <- Maybe String
new -> Bool
False -- I have nothing to offer
          | Maybe String
Nothing <- Maybe String
old -> Bool
True -- I failed last time, so this must be an improvement
          | Just old :: String
old <- Maybe String
old, Just new :: String
new <- Maybe String
new, String -> String -> Bool
equalFilePath String
old String
new -> Bool
False -- no different
          | Just old :: String
old <- Maybe String
old, Just old2 :: String
old2 <- Maybe String
old2, String -> String -> Bool
equalFilePath String
old String
old2 -> Bool
True -- I could predict last time
          | 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


-- | Given a list of directories, and a file name, return the complete path if you can find it.
--   Like findExecutable, but with a custom PATH.
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)


---------------------------------------------------------------------
-- FIXED ARGUMENT WRAPPER

-- | Collect the @stdout@ of the process.
--   If used, the @stdout@ will not be echoed to the terminal, unless you include 'EchoStdout'.
--   The value type may be either 'String', or either lazy or strict 'ByteString'.
newtype Stdout a = Stdout {Stdout a -> a
fromStdout :: a}

-- | Collect the @stderr@ of the process.
--   If used, the @stderr@ will not be echoed to the terminal, unless you include 'EchoStderr'.
--   The value type may be either 'String', or either lazy or strict 'ByteString'.
newtype Stderr a = Stderr {Stderr a -> a
fromStderr :: a}

-- | Collect the @stdout@ and @stderr@ of the process.
--   If used, the @stderr@ and @stdout@ will not be echoed to the terminal, unless you include 'EchoStdout' and 'EchoStderr'.
--   The value type may be either 'String', or either lazy or strict 'ByteString'.
newtype Stdouterr a = Stdouterr {Stdouterr a -> a
fromStdouterr :: a}

-- | Collect the 'ExitCode' of the process.
--   If you do not collect the exit code, any 'ExitFailure' will cause an exception.
newtype Exit = Exit {Exit -> ExitCode
fromExit :: ExitCode}

-- | Collect the 'ProcessHandle' of the process.
--   If you do collect the process handle, the command will run asyncronously and the call to 'cmd' \/ 'command'
--   will return as soon as the process is spawned. Any 'Stdout' \/ 'Stderr' captures will return empty strings.
newtype Process = Process {Process -> ProcessHandle
fromProcess :: ProcessHandle}

-- | Collect the time taken to execute the process. Can be used in conjunction with 'CmdLine' to
--   write helper functions that print out the time of a result.
--
-- @
-- timer :: ('CmdResult' r, MonadIO m) => (forall r . 'CmdResult' r => m r) -> m r
-- timer act = do
--     ('CmdTime' t, 'CmdLine' x, r) <- act
--     liftIO $ putStrLn $ \"Command \" ++ x ++ \" took \" ++ show t ++ \" seconds\"
--     return r
--
-- run :: IO ()
-- run = timer $ 'cmd' \"ghc --version\"
-- @
newtype CmdTime = CmdTime {CmdTime -> Double
fromCmdTime :: Double}

-- | Collect the command line used for the process. This command line will be approximate -
--   suitable for user diagnostics, but not for direct execution.
newtype CmdLine = CmdLine {CmdLine -> String
fromCmdLine :: String}

-- | The allowable 'String'-like values that can be captured.
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


-- | A class for specifying what results you want to collect from a process.
--   Values are formed of 'Stdout', 'Stderr', 'Exit' and tuples of those.
class CmdResult a where
    -- Return a list of results (with the right type but dummy data)
    -- and a function to transform a populated set of results into a value
    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)


-- | Execute a system command. Before running 'command' make sure you 'Development.Shake.need' any files
--   that are used by the command.
--
--   This function takes a list of options (often just @[]@, see 'CmdOption' for the available
--   options), the name of the executable (either a full name, or a program on the @$PATH@) and
--   a list of arguments. The result is often @()@, but can be a tuple containg any of 'Stdout',
--   'Stderr' and 'Exit'. Some examples:
--
-- @
-- 'command_' [] \"gcc\" [\"-c\",\"myfile.c\"]                          -- compile a file, throwing an exception on failure
-- 'Exit' c <- 'command' [] \"gcc\" [\"-c\",myfile]                     -- run a command, recording the exit code
-- ('Exit' c, 'Stderr' err) <- 'command' [] \"gcc\" [\"-c\",\"myfile.c\"]   -- run a command, recording the exit code and error output
-- 'Stdout' out <- 'command' [] \"gcc\" [\"-MM\",\"myfile.c\"]            -- run a command, recording the output
-- 'command_' ['Cwd' \"generated\"] \"gcc\" [\"-c\",myfile]               -- run a command in a directory
-- @
--
--   Unless you retrieve the 'ExitCode' using 'Exit', any 'ExitFailure' will throw an error, including
--   the 'Stderr' in the exception message. If you capture the 'Stdout' or 'Stderr', that stream will not be echoed to the console,
--   unless you use the option 'EchoStdout' or 'EchoStderr'.
--
--   If you use 'command' inside a @do@ block and do not use the result, you may get a compile-time error about being
--   unable to deduce 'CmdResult'. To avoid this error, use 'command_'.
--
--   By default the @stderr@ stream will be captured for use in error messages, and also echoed. To only echo
--   pass @'WithStderr' 'False'@, which causes no streams to be captured by Shake, and certain programs (e.g. @gcc@)
--   to detect they are running in a terminal.
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

-- | A version of 'command' where you do not require any results, used to avoid errors about being unable
--   to deduce '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


---------------------------------------------------------------------
-- VARIABLE ARGUMENT WRAPPER

-- | A type annotation, equivalent to the first argument, but in variable argument contexts,
--   gives a clue as to what return type is expected (not actually enforced).
type a :-> t = a


-- | Execute a system command. Before running 'cmd' make sure you 'Development.Shake.need' any files
--   that are used by the command.
--
-- * @String@ arguments are treated as whitespace separated arguments.
--
-- * @[String]@ arguments are treated as literal arguments.
--
-- * 'CmdOption' arguments are used as options.
--
--   As some examples, here are some calls, and the resulting command string:
--
-- @
-- 'cmd_' \"git log --pretty=\" \"oneline\"           -- git log --pretty= oneline
-- 'cmd_' \"git log --pretty=\" [\"oneline\"]         -- git log --pretty= oneline
-- 'cmd_' \"git log\" (\"--pretty=\" ++ \"oneline\")    -- git log --pretty=oneline
-- 'cmd_' \"git log\" (\"--pretty=\" ++ \"one line\")   -- git log --pretty=one line
-- 'cmd_' \"git log\" [\"--pretty=\" ++ \"one line\"]   -- git log "--pretty=one line"
-- @
--
--   More examples, including return values, see this translation of the examples given for the 'command' function:
--
-- @
-- 'cmd_' \"gcc -c myfile.c\"                                         -- compile a file, throwing an exception on failure
-- 'Exit' c <- 'cmd' \"gcc -c\" [myfile]                              -- run a command, recording the exit code
-- ('Exit' c, 'Stderr' err) <- 'cmd' \"gcc -c myfile.c\"                -- run a command, recording the exit code and error output
-- 'Stdout' out <- 'cmd' \"gcc -MM myfile.c\"                         -- run a command, recording the output
-- 'cmd' ('Cwd' \"generated\") \"gcc -c\" [myfile] :: 'Action' ()         -- run a command in a directory
-- @
--
--   When passing file arguments we use @[myfile]@ so that if the @myfile@ variable contains spaces they are properly escaped.
--
--   If you use 'cmd' inside a @do@ block and do not use the result, you may get a compile-time error about being
--   unable to deduce 'CmdResult'. To avoid this error, use 'cmd_'.
--
--   The 'cmd' function can also be run in the 'IO' monad, but then 'Traced' is ignored and command lines are not echoed.
--   As an example:
--
-- @
-- 'cmd' ('Cwd' \"generated\") 'Shell' \"gcc -c myfile.c\" :: IO ()
-- @
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

-- | See 'cmd'. Same as 'cmd' except with a unit result.
-- 'cmd' is to 'cmd_' as 'command' is to 'command_'.
cmd_ :: (CmdArguments args, Unit args) => args :-> Action ()
cmd_ :: args :-> Action ()
cmd_ = args :-> Action ()
forall args r. CmdArguments args => args
cmd

-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.
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)

-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.
class CmdArguments t where
    -- | Arguments to cmd
    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 to convert an a  to a CmdArgument
class IsCmdArgument a where
    -- | Conversion to a CmdArgument
    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


---------------------------------------------------------------------
-- UTILITIES

-- A better version of showCommandForUser, which doesn't escape so much on Windows
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` "\"\'"