{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable, RecordWildCards #-}


-- | 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(..), StdoutTrim(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..), FSATrace(..),
    CmdResult, CmdString, CmdOption(..),
    addPath, addEnv,
    ) where

import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Exception.Extra
import Data.Char
import Data.Either.Extra
import Data.Foldable (toList)
import Data.List.Extra
import Data.List.NonEmpty (NonEmpty)
import qualified Data.HashSet as Set
import Data.Maybe
import Data.Data
import Data.Semigroup
import System.Directory
import qualified System.IO.Extra as IO
import System.Environment
import System.Exit
import System.IO.Extra hiding (withTempFile, withTempDir)
import System.Process
import System.Info.Extra
import System.Time.Extra
import System.IO.Unsafe (unsafeInterleaveIO)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.UTF8 as UTF8
import General.Extra
import General.Process
import Prelude

import Development.Shake.Internal.CmdOption
import Development.Shake.Internal.Core.Action
import Development.Shake.Internal.Core.Types hiding (Result)
import Development.Shake.FilePath
import Development.Shake.Internal.Options
import Development.Shake.Internal.Rules.File
import Development.Shake.Internal.Derived

---------------------------------------------------------------------
-- 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 :: forall (m :: * -> *).
MonadIO m =>
[String] -> [String] -> m CmdOption
addPath [String]
pre [String]
post = do
    [(String, String)]
args <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
    let ([(String, String)]
path,[(String, String)]
other) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== String
"PATH") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
args
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env forall a b. (a -> b) -> a -> b
$
        [(String
"PATH",forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$ [String]
pre forall a. [a] -> [a] -> [a]
++ [String]
post) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
path] forall a. [a] -> [a] -> [a]
++
        [(String
a,forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$ [String]
pre forall a. [a] -> [a] -> [a]
++ [String
b | String
b forall a. Eq a => a -> a -> Bool
/= String
""] forall a. [a] -> [a] -> [a]
++ [String]
post) | (String
a,String
b) <- [(String, String)]
path] forall a. [a] -> [a] -> [a]
++
        [(String, String)]
other

-- | /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 :: forall (m :: * -> *).
MonadIO m =>
[(String, String)] -> m CmdOption
addEnv [(String, String)]
extra = do
    [(String, String)]
args <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(String, String)] -> CmdOption
Env forall a b. (a -> b) -> a -> b
$ [(String, String)]
extra forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
a,String
_) -> String
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, String)]
extra) [(String, String)]
args


data Str = Str String | BS BS.ByteString | LBS LBS.ByteString | Unit deriving (Str -> Str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Str -> Str -> Bool
$c/= :: Str -> Str -> Bool
== :: Str -> Str -> Bool
$c== :: Str -> Str -> Bool
Eq,Int -> Str -> String -> String
[Str] -> String -> String
Str -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Str] -> String -> String
$cshowList :: [Str] -> String -> String
show :: Str -> String
$cshow :: Str -> String
showsPrec :: Int -> Str -> String -> String
$cshowsPrec :: Int -> Str -> String -> String
Show)

strTrim :: Str -> Str
strTrim :: Str -> Str
strTrim (Str String
x) = String -> Str
Str forall a b. (a -> b) -> a -> b
$ String -> String
trim String
x
strTrim (BS ByteString
x) = ByteString -> Str
BS forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace ByteString
x
strTrim (LBS ByteString
x) = ByteString -> Str
LBS forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
trimEnd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
LBS.dropWhile Char -> Bool
isSpace ByteString
x
    where
        trimEnd :: ByteString -> ByteString
trimEnd ByteString
x = case ByteString -> Maybe (Char, ByteString)
LBS.uncons ByteString
x of
            Just (Char
c, ByteString
x2) | Char -> Bool
isSpace Char
c -> ByteString -> ByteString
trimEnd ByteString
x2
            Maybe (Char, ByteString)
_ -> ByteString
x
strTrim Str
Unit = Str
Unit


data Result
    = ResultStdout Str
    | ResultStderr Str
    | ResultStdouterr Str
    | ResultCode ExitCode
    | ResultTime Double
    | ResultLine String
    | ResultProcess PID
    | ResultFSATrace [FSATrace FilePath]
    | ResultFSATraceBS [FSATrace BS.ByteString]
      deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq,Int -> Result -> String -> String
[Result] -> String -> String
Result -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result] -> String -> String
$cshowList :: [Result] -> String -> String
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> String -> String
$cshowsPrec :: Int -> Result -> String -> String
Show)

data PID = PID0 | PID ProcessHandle
instance Eq PID where PID
_ == :: PID -> PID -> Bool
== PID
_ = Bool
True
instance Show PID where show :: PID -> String
show PID
PID0 = String
"PID0"; show PID
_ = String
"PID"

data Params = Params
    {Params -> String
funcName :: String
    ,Params -> [CmdOption]
opts :: [CmdOption]
    ,Params -> [Result]
results :: [Result]
    ,Params -> String
prog :: String
    ,Params -> [String]
args :: [String]
    } deriving Int -> Params -> String -> String
[Params] -> String -> String
Params -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Params] -> String -> String
$cshowList :: [Params] -> String -> String
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> String -> String
$cshowsPrec :: Int -> Params -> String -> String
Show

class MonadIO m => MonadTempDir m where
    runWithTempDir :: (FilePath -> m a) -> m a
    runWithTempFile :: (FilePath -> m a) -> m a
instance MonadTempDir IO where
    runWithTempDir :: forall a. (String -> IO a) -> IO a
runWithTempDir = forall a. (String -> IO a) -> IO a
IO.withTempDir
    runWithTempFile :: forall a. (String -> IO a) -> IO a
runWithTempFile = forall a. (String -> IO a) -> IO a
IO.withTempFile
instance MonadTempDir Action where
    runWithTempDir :: forall a. (String -> Action a) -> Action a
runWithTempDir = forall a. (String -> Action a) -> Action a
withTempDir
    runWithTempFile :: forall a. (String -> Action a) -> Action a
runWithTempFile = forall a. (String -> Action a) -> Action a
withTempFile

---------------------------------------------------------------------
-- DEAL WITH Shell

removeOptionShell
    :: MonadTempDir m
    => Params -- ^ Given the parameter
    -> (Params -> m a) -- ^ Call with the revised params, program name and command line
    -> m a
removeOptionShell :: forall (m :: * -> *) a.
MonadTempDir m =>
Params -> (Params -> m a) -> m a
removeOptionShell params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} Params -> m a
call
    | CmdOption
Shell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts = do
        -- put our UserCommand first, as the last one wins, and ours is lowest priority
        let userCmdline :: String
userCmdline = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
prog forall a. a -> [a] -> [a]
: [String]
args
        Params
params <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params{opts :: [CmdOption]
opts = String -> CmdOption
UserCommand String
userCmdline forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= CmdOption
Shell) [CmdOption]
opts}

        String
prog <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Params -> Bool
isFSATrace Params
params then String -> IO String
copyFSABinary String
prog else forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog
        let realCmdline :: String
realCmdline = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
prog forall a. a -> [a] -> [a]
: [String]
args
        if Bool -> Bool
not Bool
isWindows then
            Params -> m a
call Params
params{prog :: String
prog = String
"/bin/sh", args :: [String]
args = [String
"-c",String
realCmdline]}
        else
            -- On Windows the Haskell behaviour isn't that clean and is very fragile, so we try and do better.
            forall (m :: * -> *) a. MonadTempDir m => (String -> m a) -> m a
runWithTempDir forall a b. (a -> b) -> a -> b
$ \String
dir -> do
                let file :: String
file = String
dir String -> String -> String
</> String
"s.bat"
                forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' String
file String
realCmdline
                Params -> m a
call Params
params{prog :: String
prog = String
"cmd.exe", args :: [String]
args = [String
"/d/q/c",String
file]}
    | Bool
otherwise = Params -> m a
call Params
params


---------------------------------------------------------------------
-- DEAL WITH FSATrace

isFSATrace :: Params -> Bool
isFSATrace :: Params -> Bool
isFSATrace Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Result -> Bool
isResultFSATrace  [Result]
results Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmdOption -> Bool
isFSAOptions [CmdOption]
opts

-- Mac disables tracing on system binaries, so we copy them over, yurk
copyFSABinary :: FilePath -> IO FilePath
copyFSABinary :: String -> IO String
copyFSABinary String
prog
    | Bool -> Bool
not Bool
isMac = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog
    | Bool
otherwise = do
        Maybe String
progFull <- String -> IO (Maybe String)
findExecutable String
prog
        case Maybe String
progFull of
            Just String
x | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String
"/bin/",String
"/usr/",String
"/sbin/"] -> do
                -- The file is one of the ones we can't trace, so we make a copy of it in $TMP and run that
                -- We deliberately don't clean up this directory, since otherwise we spend all our time copying binaries over
                String
tmpdir <- IO String
getTemporaryDirectory
                let fake :: String
fake = String
tmpdir String -> String -> String
</> String
"fsatrace-fakes" forall a. [a] -> [a] -> [a]
++ String
x -- x is absolute, so must use ++
                forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
doesFileExist String
fake) forall a b. (a -> b) -> a -> b
$ do
                    String -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fake
                    String -> String -> IO ()
copyFile String
x String
fake
                forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fake
            Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
prog

removeOptionFSATrace
    :: MonadTempDir m
    => Params -- ^ Given the parameter
    -> (Params -> m [Result]) -- ^ Call with the revised params, program name and command line
    -> m [Result]
removeOptionFSATrace :: forall (m :: * -> *).
MonadTempDir m =>
Params -> (Params -> m [Result]) -> m [Result]
removeOptionFSATrace params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} Params -> m [Result]
call
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Params -> Bool
isFSATrace Params
params = Params -> m [Result]
call Params
params
    | PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results =
        -- This is a bad state to get into, you could technically just ignore the tracing, but that's a bit dangerous
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO String
"Asyncronous process execution combined with FSATrace is not support"
    | Bool
otherwise = forall (m :: * -> *) a. MonadTempDir m => (String -> m a) -> m a
runWithTempFile forall a b. (a -> b) -> a -> b
$ \String
file -> do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
file String
"" -- ensures even if we fail before fsatrace opens the file, we can still read it
        Params
params <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Params -> IO Params
fsaParams String
file Params
params
        [Result]
res <- Params -> m [Result]
call Params
params{opts :: [CmdOption]
opts = String -> CmdOption
UserCommand (String -> [String] -> String
showCommandForUser2 String
prog [String]
args) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdOption -> Bool
isFSAOptions) [CmdOption]
opts}
        [FSATrace ByteString]
fsaResBS <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> [FSATrace ByteString]
parseFSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
file
        let fsaRes :: [FSATrace String]
fsaRes = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
UTF8.toString) [FSATrace ByteString]
fsaResBS
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Result]
res forall a b. (a -> b) -> a -> b
$ \case
            ResultFSATrace [] -> [FSATrace String] -> Result
ResultFSATrace [FSATrace String]
fsaRes
            ResultFSATraceBS [] -> [FSATrace ByteString] -> Result
ResultFSATraceBS [FSATrace ByteString]
fsaResBS
            Result
x -> Result
x
    where
        fsaFlags :: String
fsaFlags = forall a. a -> [a] -> a
lastDef String
"rwmdqt" [String
x | FSAOptions String
x <- [CmdOption]
opts]

        fsaParams :: String -> Params -> IO Params
fsaParams String
file Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = do
            String
prog <- String -> IO String
copyFSABinary String
prog
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params{prog :: String
prog = String
"fsatrace", args :: [String]
args = String
fsaFlags forall a. a -> [a] -> [a]
: String
file forall a. a -> [a] -> [a]
: String
"--" forall a. a -> [a] -> [a]
: String
prog forall a. a -> [a] -> [a]
: [String]
args }


isFSAOptions :: CmdOption -> Bool
isFSAOptions FSAOptions{} = Bool
True
isFSAOptions CmdOption
_ = Bool
False

isResultFSATrace :: Result -> Bool
isResultFSATrace ResultFSATrace{} = Bool
True
isResultFSATrace ResultFSATraceBS{} = Bool
True
isResultFSATrace Result
_ = Bool
False

addFSAOptions :: String -> [CmdOption] -> [CmdOption]
addFSAOptions :: String -> [CmdOption] -> [CmdOption]
addFSAOptions String
x [CmdOption]
opts | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmdOption -> Bool
isFSAOptions [CmdOption]
opts = forall a b. (a -> b) -> [a] -> [b]
map CmdOption -> CmdOption
f [CmdOption]
opts
    where f :: CmdOption -> CmdOption
f (FSAOptions String
y) = String -> CmdOption
FSAOptions forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ String
y forall a. [a] -> [a] -> [a]
++ String
x
          f CmdOption
x = CmdOption
x
addFSAOptions String
x [CmdOption]
opts = String -> CmdOption
FSAOptions String
x forall a. a -> [a] -> [a]
: [CmdOption]
opts


-- | The results produced by @fsatrace@. All files will be absolute paths.
--   You can get the results for a 'cmd' by requesting a value of type
--   @['FSATrace']@.
data FSATrace a
    = -- | Writing to a file
      FSAWrite a
    | -- | Reading from a file
      FSARead a
    | -- | Deleting a file
      FSADelete a
    | -- | Moving, arguments destination, then source
      FSAMove a a
    | -- | Querying\/stat on a file
      FSAQuery a
    | -- | Touching a file
      FSATouch a
      deriving (Int -> FSATrace a -> String -> String
forall a. Show a => Int -> FSATrace a -> String -> String
forall a. Show a => [FSATrace a] -> String -> String
forall a. Show a => FSATrace a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FSATrace a] -> String -> String
$cshowList :: forall a. Show a => [FSATrace a] -> String -> String
show :: FSATrace a -> String
$cshow :: forall a. Show a => FSATrace a -> String
showsPrec :: Int -> FSATrace a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> FSATrace a -> String -> String
Show,FSATrace a -> FSATrace a -> Bool
forall a. Eq a => FSATrace a -> FSATrace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FSATrace a -> FSATrace a -> Bool
$c/= :: forall a. Eq a => FSATrace a -> FSATrace a -> Bool
== :: FSATrace a -> FSATrace a -> Bool
$c== :: forall a. Eq a => FSATrace a -> FSATrace a -> Bool
Eq,FSATrace a -> FSATrace a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FSATrace a)
forall a. Ord a => FSATrace a -> FSATrace a -> Bool
forall a. Ord a => FSATrace a -> FSATrace a -> Ordering
forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
min :: FSATrace a -> FSATrace a -> FSATrace a
$cmin :: forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
max :: FSATrace a -> FSATrace a -> FSATrace a
$cmax :: forall a. Ord a => FSATrace a -> FSATrace a -> FSATrace a
>= :: FSATrace a -> FSATrace a -> Bool
$c>= :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
> :: FSATrace a -> FSATrace a -> Bool
$c> :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
<= :: FSATrace a -> FSATrace a -> Bool
$c<= :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
< :: FSATrace a -> FSATrace a -> Bool
$c< :: forall a. Ord a => FSATrace a -> FSATrace a -> Bool
compare :: FSATrace a -> FSATrace a -> Ordering
$ccompare :: forall a. Ord a => FSATrace a -> FSATrace a -> Ordering
Ord,FSATrace a -> DataType
FSATrace a -> Constr
forall {a}. Data a => Typeable (FSATrace a)
forall a. Data a => FSATrace a -> DataType
forall a. Data a => FSATrace a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FSATrace a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FSATrace a -> m (FSATrace a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FSATrace a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FSATrace a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FSATrace a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FSATrace a -> r
gmapT :: (forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> FSATrace a -> FSATrace a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FSATrace a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FSATrace a))
dataTypeOf :: FSATrace a -> DataType
$cdataTypeOf :: forall a. Data a => FSATrace a -> DataType
toConstr :: FSATrace a -> Constr
$ctoConstr :: forall a. Data a => FSATrace a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FSATrace a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FSATrace a -> c (FSATrace a)
Data,Typeable,forall a b. a -> FSATrace b -> FSATrace a
forall a b. (a -> b) -> FSATrace a -> FSATrace b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FSATrace b -> FSATrace a
$c<$ :: forall a b. a -> FSATrace b -> FSATrace a
fmap :: forall a b. (a -> b) -> FSATrace a -> FSATrace b
$cfmap :: forall a b. (a -> b) -> FSATrace a -> FSATrace b
Functor)


-- | Parse the 'FSATrace' entries, ignoring anything you don't understand.
parseFSA :: BS.ByteString -> [FSATrace BS.ByteString]
parseFSA :: ByteString -> [FSATrace ByteString]
parseFSA = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString -> Maybe (FSATrace ByteString)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropR) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
    where
        -- deal with CRLF on Windows
        dropR :: ByteString -> ByteString
dropR ByteString
x = case ByteString -> Maybe (ByteString, Char)
BS.unsnoc ByteString
x of
            Just (ByteString
x, Char
'\r') -> ByteString
x
            Maybe (ByteString, Char)
_ -> ByteString
x

        f :: ByteString -> Maybe (FSATrace ByteString)
f ByteString
x
            | Just (Char
k, ByteString
x) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
x
            , Just (Char
'|', ByteString
x) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
x =
                case Char
k of
                    Char
'w' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSAWrite ByteString
x
                    Char
'r' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSARead  ByteString
x
                    Char
'd' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSADelete ByteString
x
                    Char
'm' | (ByteString
xs, ByteString
ys) <- (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Char
'|') ByteString
x, Just (Char
'|',ByteString
ys) <- ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
ys ->
                        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> FSATrace a
FSAMove ByteString
xs ByteString
ys
                    Char
'q' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSAQuery ByteString
x
                    Char
't' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FSATrace a
FSATouch ByteString
x
                    Char
_ -> forall a. Maybe a
Nothing
            | Bool
otherwise = forall a. Maybe a
Nothing


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

-- | Given explicit operations, apply the Action ones, like skip/trace/track/autodep
commandExplicitAction :: Partial => Params -> Action [Result]
commandExplicitAction :: Partial => Params -> Action [Result]
commandExplicitAction Params
oparams = do
    ShakeOptions{[CmdOption]
shakeCommandOptions :: ShakeOptions -> [CmdOption]
shakeCommandOptions :: [CmdOption]
shakeCommandOptions,Bool
shakeRunCommands :: ShakeOptions -> Bool
shakeRunCommands :: Bool
shakeRunCommands,Maybe Lint
shakeLint :: ShakeOptions -> Maybe Lint
shakeLint :: Maybe Lint
shakeLint,[String]
shakeLintInside :: ShakeOptions -> [String]
shakeLintInside :: [String]
shakeLintInside} <- Action ShakeOptions
getShakeOptions
    params :: Params
params@Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..}<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Params
oparams{opts :: [CmdOption]
opts = [CmdOption]
shakeCommandOptions forall a. [a] -> [a] -> [a]
++ Params -> [CmdOption]
opts Params
oparams}

    let skipper :: Action [Result] -> Action [Result]
skipper Action [Result]
act = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Result]
results Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shakeRunCommands then forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else Action [Result]
act

    let verboser :: Action [Result] -> Action [Result]
verboser Action [Result]
act = do
            let cwd :: Maybe String
cwd = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [String
x | Cwd String
x <- [CmdOption]
opts]
            String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"cd " forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"; ") Maybe String
cwd forall a. [a] -> [a] -> [a]
++
                forall a. [a] -> a
last (String -> [String] -> String
showCommandForUser2 String
prog [String]
args forall a. a -> [a] -> [a]
: [String
x | UserCommand String
x <- [CmdOption]
opts])
            Verbosity
verb <- Action Verbosity
getVerbosity
            -- run quietly to suppress the tracer (don't want to print twice)
            (if Verbosity
verb forall a. Ord a => a -> a -> Bool
>= Verbosity
Verbose then forall a. Action a -> Action a
quietly else forall a. a -> a
id) Action [Result]
act

    let tracer :: IO [Result] -> Action [Result]
tracer IO [Result]
act = do
            -- note: use the oparams - find a good tracing before munging it for shell stuff
            let msg :: String
msg = forall a. a -> [a] -> a
lastDef (Params -> String
defaultTraced Params
oparams) [String
x | Traced String
x <- [CmdOption]
opts]
            if String
msg forall a. Eq a => a -> a -> Bool
== String
"" then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Result]
act else forall a. String -> IO a -> Action a
traced String
msg IO [Result]
act

    let async :: Bool
async = PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results
    let tracker :: (Params -> Action [Result]) -> Action [Result]
tracker Params -> Action [Result]
act
            | CmdOption
AutoDeps forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts = if Bool
async then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO String
"Can't use AutoDeps and asyncronous execution" else (Params -> Action [Result]) -> Action [Result]
autodeps Params -> Action [Result]
act
            | Maybe Lint
shakeLint forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Lint
LintFSATrace Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
async = (Params -> Action [Result]) -> Action [Result]
fsalint Params -> Action [Result]
act
            | Bool
otherwise = Params -> Action [Result]
act Params
params

        autodeps :: (Params -> Action [Result]) -> Action [Result]
autodeps Params -> Action [Result]
act = do
            ResultFSATrace [FSATrace String]
pxs : [Result]
res <- Params -> Action [Result]
act Params
params{opts :: [CmdOption]
opts = String -> [CmdOption] -> [CmdOption]
addFSAOptions String
"rwm" [CmdOption]
opts, results :: [Result]
results = [FSATrace String] -> Result
ResultFSATrace [] forall a. a -> [a] -> [a]
: [Result]
results}
            let written :: HashSet String
written = forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList forall a b. (a -> b) -> a -> b
$ [String
x | FSAMove String
x String
_ <- [FSATrace String]
pxs] forall a. [a] -> [a] -> [a]
++ [String
x | FSAWrite String
x <- [FSATrace String]
pxs]
            -- If something both reads and writes to a file, it isn't eligible to be an autodeps
            [String]
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String
x | FSARead String
x <- [FSATrace String]
pxs, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String
x forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet String
written]
            String
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
            [String]
temp <- String -> [String] -> Action [String]
fixPaths String
cwd [String]
xs
            forall a. Action a -> Action a
unsafeAllowApply forall a b. (a -> b) -> a -> b
$ Partial => [String] -> Action ()
need [String]
temp
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [Result]
res

        fixPaths :: String -> [String] -> Action [String]
fixPaths String
cwd [String]
xs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            [String]
xs<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> String
toStandard [String]
xs
            [String]
xs<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String]
shakeLintInside) [String]
xs
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
x -> forall a. a -> Maybe a -> a
fromMaybe String
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO (Maybe String)
makeRelativeEx String
cwd String
x) [String]
xs

        fsalint :: (Params -> Action [Result]) -> Action [Result]
fsalint Params -> Action [Result]
act = do
            ResultFSATrace [FSATrace String]
xs : [Result]
res <- Params -> Action [Result]
act Params
params{opts :: [CmdOption]
opts = String -> [CmdOption] -> [CmdOption]
addFSAOptions String
"rwm" [CmdOption]
opts, results :: [Result]
results = [FSATrace String] -> Result
ResultFSATrace [] forall a. a -> [a] -> [a]
: [Result]
results}
            let reader :: FSATrace a -> Maybe a
reader (FSARead a
x) = forall a. a -> Maybe a
Just a
x; reader FSATrace a
_ = forall a. Maybe a
Nothing
                writer :: FSATrace a -> Maybe a
writer (FSAWrite a
x) = forall a. a -> Maybe a
Just a
x; writer (FSAMove a
x a
_) = forall a. a -> Maybe a
Just a
x; writer FSATrace a
_ = forall a. Maybe a
Nothing
                existing :: (a -> Maybe String) -> [a] -> m [String]
existing a -> Maybe String
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe String
f
            String
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getCurrentDirectory
            [String] -> Action ()
trackRead  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Action [String]
fixPaths String
cwd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {a}.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing forall {a}. FSATrace a -> Maybe a
reader [FSATrace String]
xs
            [String] -> Action ()
trackWrite forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> Action [String]
fixPaths String
cwd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {a}.
MonadIO m =>
(a -> Maybe String) -> [a] -> m [String]
existing forall {a}. FSATrace a -> Maybe a
writer [FSATrace String]
xs
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [Result]
res

    Action [Result] -> Action [Result]
skipper forall a b. (a -> b) -> a -> b
$ (Params -> Action [Result]) -> Action [Result]
tracker forall a b. (a -> b) -> a -> b
$ \Params
params -> Action [Result] -> Action [Result]
verboser forall a b. (a -> b) -> a -> b
$ IO [Result] -> Action [Result]
tracer forall a b. (a -> b) -> a -> b
$ Partial => Params -> IO [Result]
commandExplicitIO Params
params


defaultTraced :: Params -> String
defaultTraced :: Params -> String
defaultTraced Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} = String -> String
takeBaseName forall a b. (a -> b) -> a -> b
$ if CmdOption
Shell forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts then forall a b. (a, b) -> a
fst (String -> (String, String)
word1 String
prog) else String
prog


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

-- | Given a very explicit set of CmdOption, translate them to a General.Process structure
commandExplicitIO :: Partial => Params -> IO [Result]
commandExplicitIO :: Partial => Params -> IO [Result]
commandExplicitIO Params
params = forall (m :: * -> *) a.
MonadTempDir m =>
Params -> (Params -> m a) -> m a
removeOptionShell Params
params forall a b. (a -> b) -> a -> b
$ \Params
params -> forall (m :: * -> *).
MonadTempDir m =>
Params -> (Params -> m [Result]) -> m [Result]
removeOptionFSATrace Params
params forall a b. (a -> b) -> a -> b
$ \Params{String
[String]
[CmdOption]
[Result]
args :: [String]
prog :: String
results :: [Result]
opts :: [CmdOption]
funcName :: String
args :: Params -> [String]
prog :: Params -> String
results :: Params -> [Result]
opts :: Params -> [CmdOption]
funcName :: Params -> String
..} -> do
    let (Bool
grabStdout, Bool
grabStderr) = forall a b. (a -> b) -> (a, a) -> (b, b)
both forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Result]
results forall a b. (a -> b) -> a -> b
$ \case
            ResultStdout{} -> (Bool
True, Bool
False)
            ResultStderr{} -> (Bool
False, Bool
True)
            ResultStdouterr{} -> (Bool
True, Bool
True)
            Result
_ -> (Bool
False, Bool
False)

    Maybe [(String, String)]
optEnv <- [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv [CmdOption]
opts
    let optCwd :: Maybe String
optCwd = [String] -> Maybe String
mergeCwd [String
x | Cwd String
x <- [CmdOption]
opts]
    let optStdin :: [Source]
optStdin = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [CmdOption]
opts forall a b. (a -> b) -> a -> b
$ \case
            Stdin String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Source
SrcString String
x
            StdinBS ByteString
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Source
SrcBytes ByteString
x
            FileStdin String
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Source
SrcFile String
x
            CmdOption
InheritStdin -> forall a. a -> Maybe a
Just Source
SrcInherit
            CmdOption
_ -> forall a. Maybe a
Nothing
    let optBinary :: Bool
optBinary = CmdOption
BinaryPipes forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
    let optAsync :: Bool
optAsync = PID -> Result
ResultProcess PID
PID0 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results
    let optTimeout :: Maybe Double
optTimeout = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Double
x | Timeout Double
x <- [CmdOption]
opts]
    let optWithStdout :: Bool
optWithStdout = forall a. a -> [a] -> a
lastDef Bool
False [Bool
x | WithStdout Bool
x <- [CmdOption]
opts]
    let optWithStderr :: Bool
optWithStderr = forall a. a -> [a] -> a
lastDef Bool
True [Bool
x | WithStderr Bool
x <- [CmdOption]
opts]
    let optFileStdout :: [String]
optFileStdout = [String
x | FileStdout String
x <- [CmdOption]
opts]
    let optFileStderr :: [String]
optFileStderr = [String
x | FileStderr String
x <- [CmdOption]
opts]
    let optEchoStdout :: Bool
optEchoStdout = forall a. a -> [a] -> a
lastDef (Bool -> Bool
not Bool
grabStdout Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStdout) [Bool
x | EchoStdout Bool
x <- [CmdOption]
opts]
    let optEchoStderr :: Bool
optEchoStderr = forall a. a -> [a] -> a
lastDef (Bool -> Bool
not Bool
grabStderr Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optFileStderr) [Bool
x | EchoStderr Bool
x <- [CmdOption]
opts]
    let optRealCommand :: String
optRealCommand = String -> [String] -> String
showCommandForUser2 String
prog [String]
args
    let optUserCommand :: String
optUserCommand = forall a. a -> [a] -> a
lastDef String
optRealCommand [String
x | UserCommand String
x <- [CmdOption]
opts]
    let optCloseFds :: Bool
optCloseFds = CmdOption
CloseFileHandles forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdOption]
opts
    let optProcessGroup :: Bool
optProcessGroup = CmdOption
NoProcessGroup forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CmdOption]
opts

    let bufLBS :: (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS ByteString -> Str
f = do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf forall a b. (a -> b) -> a -> b
$ ByteString -> Str
LBS ByteString
LBS.empty; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a, (\(LBS ByteString
x) -> ByteString -> Str
f ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Str
b)
        buf :: Str -> IO ([Destination], IO Str)
buf Str{} | Bool
optBinary = (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS (String -> Str
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LBS.unpack)
        buf Str{} = do Buffer String
x <- forall a. IO (Buffer a)
newBuffer; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Buffer String -> Destination
DestString Buffer String
x | Bool -> Bool
not Bool
optAsync], String -> Str
Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Buffer a -> IO [a]
readBuffer Buffer String
x)
        buf LBS{} = do Buffer ByteString
x <- forall a. IO (Buffer a)
newBuffer; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Buffer ByteString -> Destination
DestBytes Buffer ByteString
x | Bool -> Bool
not Bool
optAsync], ByteString -> Str
LBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Buffer a -> IO [a]
readBuffer Buffer ByteString
x)
        buf BS {} = (ByteString -> Str) -> IO ([Destination], IO Str)
bufLBS (ByteString -> Str
BS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks)
        buf Str
Unit  = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
Unit)
    ([[Destination]]
dStdout, [[Destination]]
dStderr, [Double -> ProcessHandle -> ExitCode -> IO Result]
resultBuild) :: ([[Destination]], [[Destination]], [Double -> ProcessHandle -> ExitCode -> IO Result]) <-
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Result]
results forall a b. (a -> b) -> a -> b
$ \case
            ResultCode ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
ex -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExitCode -> Result
ResultCode ExitCode
ex)
            ResultTime Double
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
dur ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Result
ResultTime Double
dur)
            ResultLine String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Result
ResultLine String
optUserCommand)
            ResultProcess PID
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
pid ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PID -> Result
ResultProcess forall a b. (a -> b) -> a -> b
$ ProcessHandle -> PID
PID ProcessHandle
pid)
            ResultStdout    Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a , [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdout IO Str
b)
            ResultStderr    Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [Destination]
a , \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStderr IO Str
b)
            ResultStdouterr Str
s -> do ([Destination]
a,IO Str
b) <- Str -> IO ([Destination], IO Str)
buf Str
s; forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Destination]
a , [Destination]
a , \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> Result
ResultStdouterr IO Str
b)
            ResultFSATrace [FSATrace String]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FSATrace String] -> Result
ResultFSATrace []) -- filled in elsewhere
            ResultFSATraceBS [FSATrace ByteString]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], \Double
_ ProcessHandle
_ ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FSATrace ByteString] -> Result
ResultFSATraceBS []) -- filled in elsewhere

    Buffer String
exceptionBuffer <- forall a. IO (Buffer a)
newBuffer
    ProcessOpts
po <- ProcessOpts -> IO ProcessOpts
resolvePath ProcessOpts
        {poCommand :: CmdSpec
poCommand = String -> [String] -> CmdSpec
RawCommand String
prog [String]
args
        ,poCwd :: Maybe String
poCwd = Maybe String
optCwd, poEnv :: Maybe [(String, String)]
poEnv = Maybe [(String, String)]
optEnv, poTimeout :: Maybe Double
poTimeout = Maybe Double
optTimeout
        ,poStdin :: [Source]
poStdin = [ByteString -> Source
SrcBytes ByteString
LBS.empty | Bool
optBinary Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Source]
optStdin)] forall a. [a] -> [a] -> [a]
++ [Source]
optStdin
        ,poStdout :: [Destination]
poStdout = [Destination
DestEcho | Bool
optEchoStdout] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStdout forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStdout Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStdout
        ,poStderr :: [Destination]
poStderr = [Destination
DestEcho | Bool
optEchoStderr] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map String -> Destination
DestFile [String]
optFileStderr forall a. [a] -> [a] -> [a]
++ [Buffer String -> Destination
DestString Buffer String
exceptionBuffer | Bool
optWithStderr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
optAsync] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Destination]]
dStderr
        ,poAsync :: Bool
poAsync = Bool
optAsync
        ,poCloseFds :: Bool
poCloseFds = Bool
optCloseFds
        ,poGroup :: Bool
poGroup = Bool
optProcessGroup
        }
    (Double
dur,(ProcessHandle
pid,ExitCode
exit)) <- forall (m :: * -> *) a. MonadIO m => m a -> m (Double, a)
duration forall a b. (a -> b) -> a -> b
$ ProcessOpts -> IO (ProcessHandle, ExitCode)
process ProcessOpts
po
    if ExitCode
exit forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
|| ExitCode -> Result
ResultCode ExitCode
ExitSuccess forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Result]
results then
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Double -> ProcessHandle -> ExitCode -> IO Result
f -> Double -> ProcessHandle -> ExitCode -> IO Result
f Double
dur ProcessHandle
pid ExitCode
exit) [Double -> ProcessHandle -> ExitCode -> IO Result]
resultBuild
     else do
        [String]
exceptionBuffer <- forall a. Buffer a -> IO [a]
readBuffer Buffer String
exceptionBuffer
        let captured :: [String]
captured = [String
"Stderr" | Bool
optWithStderr] forall a. [a] -> [a] -> [a]
++ [String
"Stdout" | Bool
optWithStdout]
        String
cwd <- case Maybe String
optCwd of
            Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
            Just String
v -> do
                String
v <- String -> IO String
canonicalizePath String
v forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
v)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"Current directory: " forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
"\n"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Partial => String -> IO a
errorIO forall a b. (a -> b) -> a -> b
$
            String
"Development.Shake." forall a. [a] -> [a] -> [a]
++ String
funcName forall a. [a] -> [a] -> [a]
++ String
", system command failed\n" forall a. [a] -> [a] -> [a]
++
            String
"Command line: " forall a. [a] -> [a] -> [a]
++ String
optRealCommand forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
            (if String
optRealCommand forall a. Eq a => a -> a -> Bool
/= String
optUserCommand then String
"Original command line: " forall a. [a] -> [a] -> [a]
++ String
optUserCommand forall a. [a] -> [a] -> [a]
++ String
"\n" else String
"") forall a. [a] -> [a] -> [a]
++
            String
cwd forall a. [a] -> [a] -> [a]
++
            String
"Exit code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (case ExitCode
exit of ExitFailure Int
i -> Int
i; ExitCode
_ -> Int
0) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
captured then String
"Stderr not captured because WithStderr False was used\n"
            else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
exceptionBuffer then forall a. [a] -> [[a]] -> [a]
intercalate String
" and " [String]
captured forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
captured forall a. Eq a => a -> a -> Bool
== Int
1 then String
"was" else String
"were") forall a. [a] -> [a] -> [a]
++ String
" empty"
            else forall a. [a] -> [[a]] -> [a]
intercalate String
" and " [String]
captured forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
exceptionBuffer)


mergeCwd :: [FilePath] -> Maybe FilePath
mergeCwd :: [String] -> Maybe String
mergeCwd [] = forall a. Maybe a
Nothing
mergeCwd [String]
xs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 String -> String -> String
(</>) [String]
xs

-- | Apply all environment operations, to produce a new environment to use.
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])
resolveEnv [CmdOption]
opts
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
addEnv, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([String], [String])]
addPath, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
remEnv = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [(String, b)] -> [(String, b)]
unique forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
tweakPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [(String, String)]
addEnv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [String]
remEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(String, String)]]
env then IO [(String, String)]
getEnvironment else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]]
env)
    where
        env :: [[(String, String)]]
env = [[(String, String)]
x | Env [(String, String)]
x <- [CmdOption]
opts]
        addEnv :: [(String, String)]
addEnv = [(String
x,String
y) | AddEnv String
x String
y <- [CmdOption]
opts]
        remEnv :: [String]
remEnv = [String
x | RemEnv String
x <- [CmdOption]
opts]
        addPath :: [([String], [String])]
addPath = [([String]
x,[String]
y) | AddPath [String]
x [String]
y <- [CmdOption]
opts]

        newPath :: String -> String
newPath String
mid = forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([String], [String])]
addPath) forall a. [a] -> [a] -> [a]
++ [String
mid | String
mid forall a. Eq a => a -> a -> Bool
/= String
""] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([String], [String])]
addPath
        isPath :: String -> Bool
isPath String
x = (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) String
x forall a. Eq a => a -> a -> Bool
== String
"PATH"
        tweakPath :: [(String, String)] -> [(String, String)]
tweakPath [(String, String)]
xs | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
isPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
xs = (String
"PATH", String -> String
newPath String
"") forall a. a -> [a] -> [a]
: [(String, String)]
xs
                     | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (\(String
a,String
b) -> (String
a, if String -> Bool
isPath String
a then String -> String
newPath String
b else String
b)) [(String, String)]
xs

        unique :: [(String, b)] -> [(String, b)]
unique = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (if Bool
isWindows then String -> String
upper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst else forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse


-- | If the user specifies a custom $PATH, and not Shell, then try and resolve their prog ourselves.
--   Tricky, because on Windows it doesn't look in the $PATH first.
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath :: ProcessOpts -> IO ProcessOpts
resolvePath ProcessOpts
po
    | Just [(String, String)]
e <- ProcessOpts -> Maybe [(String, String)]
poEnv ProcessOpts
po
    , Just (String
_, String
path) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) String
"PATH" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isWindows then String -> String
upper else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
e
    , RawCommand String
prog [String]
args <- ProcessOpts -> CmdSpec
poCommand ProcessOpts
po
    = do
    let progExe :: String
progExe = if String
prog forall a. Eq a => a -> a -> Bool
== String
prog String -> String -> String
-<.> String
exe then String
prog else String
prog String -> String -> String
<.> String
exe
    -- use unsafeInterleaveIO to allow laziness to skip the queries we don't use
    String
pathOld <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PATH"
    Maybe String
old <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
prog
    Maybe String
new <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
path) String
progExe
    Maybe String
old2 <- forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO (Maybe String)
findExecutableWith (String -> [String]
splitSearchPath String
pathOld) String
progExe

    Bool
switch<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case () of
        ()
_ | String
path forall a. Eq a => a -> a -> Bool
== String
pathOld -> Bool
False -- 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 String
old <- Maybe String
old, Just String
new <- Maybe String
new, String -> String -> Bool
equalFilePath String
old String
new -> Bool
False -- no different
          | Just String
old <- Maybe String
old, Just String
old2 <- Maybe String
old2, String -> String -> Bool
equalFilePath String
old String
old2 -> Bool
True -- I could predict last time
          | Bool
otherwise -> Bool
False
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe String
new of
        Just String
new | Bool
switch -> ProcessOpts
po{poCommand :: CmdSpec
poCommand = String -> [String] -> CmdSpec
RawCommand String
new [String]
args}
        Maybe String
_ -> ProcessOpts
po
resolvePath ProcessOpts
po = forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcessOpts
po


-- | 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 [String]
path String
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
x) [String]
path) forall a b. (a -> b) -> a -> b
$ \String
s ->
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
s) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
s) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)


---------------------------------------------------------------------
-- 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'.
--
--   Note that most programs end their output with a trailing newline, so calling
--   @ghc --numeric-version@ will result in 'Stdout' of @\"6.8.3\\n\"@. If you want to automatically
--   trim the resulting string, see 'StdoutTrim'.
newtype Stdout a = Stdout {forall a. Stdout a -> a
fromStdout :: a}

-- | Like 'Stdout' but remove all leading and trailing whitespaces.
newtype StdoutTrim a = StdoutTrim {forall a. StdoutTrim a -> a
fromStdoutTrim :: 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 {forall a. 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 {forall a. 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\"
--     pure 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, \Str
Unit -> ())
instance CmdString String where cmdString :: (Str, Str -> String)
cmdString = (String -> Str
Str String
"", \(Str String
x) -> String
x)
instance CmdString BS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
BS ByteString
BS.empty, \(BS ByteString
x) -> ByteString
x)
instance CmdString LBS.ByteString where cmdString :: (Str, Str -> ByteString)
cmdString = (ByteString -> Str
LBS ByteString
LBS.empty, \(LBS ByteString
x) -> ByteString
x)


class Unit a
instance {-# OVERLAPPING #-} Unit b => Unit (a -> b)
instance {-# OVERLAPPABLE #-} a ~ () => Unit (m a)


-- | 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 ExitCode
x] -> ExitCode -> Exit
Exit ExitCode
x)

instance CmdResult ExitCode where
    cmdResult :: ([Result], [Result] -> ExitCode)
cmdResult = ([ExitCode -> Result
ResultCode ExitCode
ExitSuccess], \[ResultCode ExitCode
x] -> ExitCode
x)

instance CmdResult Process where
    cmdResult :: ([Result], [Result] -> Process)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID ProcessHandle
x)] -> ProcessHandle -> Process
Process ProcessHandle
x)

instance CmdResult ProcessHandle where
    cmdResult :: ([Result], [Result] -> ProcessHandle)
cmdResult = ([PID -> Result
ResultProcess PID
PID0], \[ResultProcess (PID ProcessHandle
x)] -> ProcessHandle
x)

instance CmdResult CmdLine where
    cmdResult :: ([Result], [Result] -> CmdLine)
cmdResult = ([String -> Result
ResultLine String
""], \[ResultLine String
x] -> String -> CmdLine
CmdLine String
x)

instance CmdResult CmdTime where
    cmdResult :: ([Result], [Result] -> CmdTime)
cmdResult = ([Double -> Result
ResultTime Double
0], \[ResultTime Double
x] -> Double -> CmdTime
CmdTime Double
x)

instance CmdResult [FSATrace FilePath] where
    cmdResult :: ([Result], [Result] -> [FSATrace String])
cmdResult = ([[FSATrace String] -> Result
ResultFSATrace []], \[ResultFSATrace [FSATrace String]
x] -> [FSATrace String]
x)

instance CmdResult [FSATrace BS.ByteString] where
    cmdResult :: ([Result], [Result] -> [FSATrace ByteString])
cmdResult = ([[FSATrace ByteString] -> Result
ResultFSATraceBS []], \[ResultFSATraceBS [FSATrace ByteString]
x] -> [FSATrace ByteString]
x)

instance CmdString a => CmdResult (Stdout a) where
    cmdResult :: ([Result], [Result] -> Stdout a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdout Str
a], \[ResultStdout Str
x] -> forall a. a -> Stdout a
Stdout forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)

instance CmdString a => CmdResult (StdoutTrim a) where
    cmdResult :: ([Result], [Result] -> StdoutTrim a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdout Str
a], \[ResultStdout Str
x] -> forall a. a -> StdoutTrim a
StdoutTrim forall a b. (a -> b) -> a -> b
$ Str -> a
b forall a b. (a -> b) -> a -> b
$ Str -> Str
strTrim Str
x)

instance CmdString a => CmdResult (Stderr a) where
    cmdResult :: ([Result], [Result] -> Stderr a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStderr Str
a], \[ResultStderr Str
x] -> forall a. a -> Stderr a
Stderr forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)

instance CmdString a => CmdResult (Stdouterr a) where
    cmdResult :: ([Result], [Result] -> Stdouterr a)
cmdResult = let (Str
a,Str -> a
b) = forall a. CmdString a => (Str, Str -> a)
cmdString in ([Str -> Result
ResultStdouterr Str
a], \[ResultStdouterr Str
x] -> forall a. a -> Stdouterr a
Stdouterr forall a b. (a -> b) -> a -> b
$ Str -> a
b Str
x)

instance CmdResult () where
    cmdResult :: ([Result], [Result] -> ())
cmdResult = ([], \[] -> ())

instance (CmdResult x1, CmdResult x2) => CmdResult (x1,x2) where
    cmdResult :: ([Result], [Result] -> (x1, x2))
cmdResult = ([Result]
a1forall a. [a] -> [a] -> [a]
++[Result]
a2, \[Result]
rs -> let ([Result]
r1,[Result]
r2) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Result]
a1) [Result]
rs in ([Result] -> x1
b1 [Result]
r1, [Result] -> x2
b2 [Result]
r2))
        where ([Result]
a1,[Result] -> x1
b1) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult
              ([Result]
a2,[Result] -> x2
b2) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult

cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith b -> c
f = forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult

instance (CmdResult x1, CmdResult x2, CmdResult x3) => CmdResult (x1,x2,x3) where
    cmdResult :: ([Result], [Result] -> (x1, x2, x3))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c)) -> (x1
a,x2
b,x3
c)

instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4) => CmdResult (x1,x2,x3,x4) where
    cmdResult :: ([Result], [Result] -> (x1, x2, x3, x4))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c,x4
d)) -> (x1
a,x2
b,x3
c,x4
d)

instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4, CmdResult x5) => CmdResult (x1,x2,x3,x4,x5) where
    cmdResult :: ([Result], [Result] -> (x1, x2, x3, x4, x5))
cmdResult = forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)
cmdResultWith forall a b. (a -> b) -> a -> b
$ \(x1
a,(x2
b,x3
c,x4
d,x5
e)) -> (x1
a,x2
b,x3
c,x4
d,x5
e)


-- | 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 :: (Partial, CmdResult r) => [CmdOption] -> String -> [String] -> Action r
command :: forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
opts String
x [String]
xs = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"command" [CmdOption]
opts [Result]
a String
x [String]
xs)
    where ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult

-- | A version of 'command' where you do not require any results, used to avoid errors about being unable
--   to deduce 'CmdResult'.
command_ :: Partial => [CmdOption] -> String -> [String] -> Action ()
command_ :: Partial => [CmdOption] -> String -> [String] -> Action ()
command_ [CmdOption]
opts String
x [String]
xs = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"command_" [CmdOption]
opts [] String
x [String]
xs)


---------------------------------------------------------------------
-- 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


-- | Build or execute a system command. Before using 'cmd' to run a command, make sure you 'Development.Shake.need' any files
--   that are used by the command.
--
-- * @String@ arguments are treated as a list of whitespace separated arguments.
--
-- * @[String]@ arguments are treated as a list of literal arguments.
--
-- * 'CmdOption' arguments are used as options.
--
-- * 'CmdArgument' arguments, which can be built by 'cmd' itself, are spliced into the containing command.
--
--   Typically only string literals should be passed as @String@ arguments. When using variables
--   prefer @[myvar]@ so that if @myvar@ contains spaces they are properly escaped.
--
--   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
--
-- let gccCommand = 'cmd' \"gcc -c\" :: 'CmdArgument'                 -- build a sub-command. 'cmd' can return 'CmdArgument' values as well as execute commands
-- cmd ('Cwd' \"generated\") gccCommand [myfile]                 -- splice that command into a greater command
-- @
--
--   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_'. If you enable @OverloadedStrings@ or @OverloadedLists@
--   you may have to give type signatures to the arguments, or use the more constrained 'command' instead.
--
--   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 :: (Partial, CmdArguments args) => args :-> Action r
cmd :: forall args r. (Partial, CmdArguments args) => args
cmd = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall t. (CmdArguments t, Partial) => CmdArgument -> t
cmdArguments forall a. Monoid a => a
mempty

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

-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.
newtype CmdArgument = CmdArgument [Either CmdOption String]
  deriving (CmdArgument -> CmdArgument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdArgument -> CmdArgument -> Bool
$c/= :: CmdArgument -> CmdArgument -> Bool
== :: CmdArgument -> CmdArgument -> Bool
$c== :: CmdArgument -> CmdArgument -> Bool
Eq, NonEmpty CmdArgument -> CmdArgument
CmdArgument -> CmdArgument -> CmdArgument
forall b. Integral b => b -> CmdArgument -> CmdArgument
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CmdArgument -> CmdArgument
$cstimes :: forall b. Integral b => b -> CmdArgument -> CmdArgument
sconcat :: NonEmpty CmdArgument -> CmdArgument
$csconcat :: NonEmpty CmdArgument -> CmdArgument
<> :: CmdArgument -> CmdArgument -> CmdArgument
$c<> :: CmdArgument -> CmdArgument -> CmdArgument
Semigroup, Semigroup CmdArgument
CmdArgument
[CmdArgument] -> CmdArgument
CmdArgument -> CmdArgument -> CmdArgument
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CmdArgument] -> CmdArgument
$cmconcat :: [CmdArgument] -> CmdArgument
mappend :: CmdArgument -> CmdArgument -> CmdArgument
$cmappend :: CmdArgument -> CmdArgument -> CmdArgument
mempty :: CmdArgument
$cmempty :: CmdArgument
Monoid, Int -> CmdArgument -> String -> String
[CmdArgument] -> String -> String
CmdArgument -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CmdArgument] -> String -> String
$cshowList :: [CmdArgument] -> String -> String
show :: CmdArgument -> String
$cshow :: CmdArgument -> String
showsPrec :: Int -> CmdArgument -> String -> String
$cshowsPrec :: Int -> CmdArgument -> String -> String
Show)

-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.
class CmdArguments t where
    -- | Arguments to cmd
    cmdArguments :: Partial => CmdArgument -> t
instance (IsCmdArgument a, CmdArguments r) => CmdArguments (a -> r) where
    cmdArguments :: Partial => CmdArgument -> a -> r
cmdArguments CmdArgument
xs a
x = forall t. (CmdArguments t, Partial) => CmdArgument -> t
cmdArguments forall a b. (a -> b) -> a -> b
$ CmdArgument
xs forall a. Monoid a => a -> a -> a
`mappend` forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument a
x
instance CmdResult r => CmdArguments (Action r) where
    cmdArguments :: Partial => CmdArgument -> Action r
cmdArguments (CmdArgument [Either CmdOption String]
x) = case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
        ([CmdOption]
opts, String
x:[String]
xs) -> let ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> Action [Result]
commandExplicitAction (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"cmd" [CmdOption]
opts [Result]
a String
x [String]
xs)
        ([CmdOption], [String])
_ -> forall a. Partial => String -> a
error String
"Error, no executable or arguments given to Development.Shake.cmd"
instance CmdResult r => CmdArguments (IO r) where
    cmdArguments :: Partial => CmdArgument -> IO r
cmdArguments (CmdArgument [Either CmdOption String]
x) = case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either CmdOption String]
x of
        ([CmdOption]
opts, String
x:[String]
xs) -> let ([Result]
a,[Result] -> r
b) = forall a. CmdResult a => ([Result], [Result] -> a)
cmdResult in [Result] -> r
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => Params -> IO [Result]
commandExplicitIO (String -> [CmdOption] -> [Result] -> String -> [String] -> Params
Params String
"cmd" [CmdOption]
opts [Result]
a String
x [String]
xs)
        ([CmdOption], [String])
_ -> forall a. Partial => String -> a
error String
"Error, no executable or arguments given to Development.Shake.cmd"
instance CmdArguments CmdArgument where
    cmdArguments :: Partial => CmdArgument -> CmdArgument
cmdArguments = forall a. a -> a
id

-- | Class to convert an a  to a CmdArgument
class IsCmdArgument a where
    -- | Conversion to a CmdArgument
    toCmdArgument :: a -> CmdArgument
instance IsCmdArgument () where toCmdArgument :: () -> CmdArgument
toCmdArgument = forall a. Monoid a => a
mempty
instance IsCmdArgument String where toCmdArgument :: String -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
instance IsCmdArgument [String] where toCmdArgument :: [String] -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right
instance IsCmdArgument (NonEmpty String) where toCmdArgument :: NonEmpty String -> CmdArgument
toCmdArgument = forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance IsCmdArgument CmdOption where toCmdArgument :: CmdOption -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
instance IsCmdArgument [CmdOption] where toCmdArgument :: [CmdOption] -> CmdArgument
toCmdArgument = [Either CmdOption String] -> CmdArgument
CmdArgument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left
instance IsCmdArgument CmdArgument where toCmdArgument :: CmdArgument -> CmdArgument
toCmdArgument = forall a. a -> a
id
instance IsCmdArgument a => IsCmdArgument (Maybe a) where toCmdArgument :: Maybe a -> CmdArgument
toCmdArgument = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. IsCmdArgument a => a -> CmdArgument
toCmdArgument


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

-- A better version of showCommandForUser, which doesn't escape so much on Windows
showCommandForUser2 :: FilePath -> [String] -> String
showCommandForUser2 :: String -> [String] -> String
showCommandForUser2 String
cmd [String]
args = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> if String -> Bool
safe String
x then String
x else String -> [String] -> String
showCommandForUser String
x []) forall a b. (a -> b) -> a -> b
$ String
cmd forall a. a -> [a] -> [a]
: [String]
args
    where
        safe :: String -> Bool
safe String
xs = String
xs forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
bad String
xs)
        bad :: Char -> Bool
bad Char
x = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| (Char
x forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isWindows) Bool -> Bool -> Bool
|| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"\"\'" :: String)