module Distribution.Simple.Program.Script (
invocationAsSystemScript,
invocationAsShellScript,
invocationAsBatchFile,
) where
import Distribution.Simple.Program.Run
( ProgramInvocation(..) )
import Distribution.System
( OS(..) )
import Data.Maybe
( maybeToList )
invocationAsSystemScript :: OS -> ProgramInvocation -> String
invocationAsSystemScript Windows = invocationAsBatchFile :: ProgramInvocation -> StringinvocationAsBatchFile
invocationAsSystemScript _ = invocationAsShellScript :: ProgramInvocation -> StringinvocationAsShellScript
invocationAsShellScript :: ProgramInvocation -> String
invocationAsShellScript
ProgramInvocation {
progInvokePath = path,
progInvokeArgs = args,
progInvokeEnv = envExtra,
progInvokeCwd = mcwd,
progInvokeInput = minput
} = unlines :: [String] -> Stringunlines ($) :: (a -> b) -> a -> b$
[ "#!/bin/sh" ]
(++) :: [a] -> [a] -> [a]++ [ "export " (++) :: [a] -> [a] -> [a]++ var :: Stringvar (++) :: [a] -> [a] -> [a]++ "=" (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote val :: Stringval
| (var,val) <- envExtra :: [(String, String)]envExtra ]
(++) :: [a] -> [a] -> [a]++ [ "cd " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote cwd :: FilePathcwd | cwd <- maybeToList :: Maybe a -> [a]maybeToList mcwd :: Maybe FilePathmcwd ]
(++) :: [a] -> [a] -> [a]++ [ (case minput :: Maybe Stringminput of
Nothing -> ""
Just input -> "echo " (++) :: [a] -> [a] -> [a]++ quote :: String -> Stringquote input :: Stringinput (++) :: [a] -> [a] -> [a]++ " | ")
(++) :: [a] -> [a] -> [a]++ unwords :: [String] -> Stringunwords (map :: (a -> b) -> [a] -> [b]map quote :: String -> Stringquote ($) :: (a -> b) -> a -> b$ path :: FilePathpath (:) :: a -> [a] -> [a]: args :: [String]args) (++) :: [a] -> [a] -> [a]++ " \"$@\""]
where
quote :: String -> String
quote s = "'" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape s :: Strings (++) :: [a] -> [a] -> [a]++ "'"
escape [] = [] :: [a][]
escape ('\'':cs) = "'\\''" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape (c :cs) = c :: Charc (:) :: a -> [a] -> [a]: escape :: [Char] -> [Char]escape cs :: [Char]cs
invocationAsBatchFile :: ProgramInvocation -> String
invocationAsBatchFile
ProgramInvocation {
progInvokePath = path,
progInvokeArgs = args,
progInvokeEnv = envExtra,
progInvokeCwd = mcwd,
progInvokeInput = minput
} = unlines :: [String] -> Stringunlines ($) :: (a -> b) -> a -> b$
[ "@echo off" ]
(++) :: [a] -> [a] -> [a]++ [ "set " (++) :: [a] -> [a] -> [a]++ var :: Stringvar (++) :: [a] -> [a] -> [a]++ "=" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape val :: Stringval | (var,val) <- envExtra :: [(String, String)]envExtra ]
(++) :: [a] -> [a] -> [a]++ [ "cd \"" (++) :: [a] -> [a] -> [a]++ cwd :: FilePathcwd (++) :: [a] -> [a] -> [a]++ "\"" | cwd <- maybeToList :: Maybe a -> [a]maybeToList mcwd :: Maybe FilePathmcwd ]
(++) :: [a] -> [a] -> [a]++ case minput :: Maybe Stringminput of
Nothing ->
[ path :: FilePathpath (++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap (' '(:) :: a -> [a] -> [a]:) args :: [String]args ]
Just input ->
[ "(" ]
(++) :: [a] -> [a] -> [a]++ [ "echo " (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape line :: Stringline | line <- lines :: String -> [String]lines input :: Stringinput ]
(++) :: [a] -> [a] -> [a]++ [ ") | "
(++) :: [a] -> [a] -> [a]++ "\"" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath (++) :: [a] -> [a] -> [a]++ "\""
(++) :: [a] -> [a] -> [a]++ concatMap :: (a -> [b]) -> [a] -> [b]concatMap (\arg -> ' '(:) :: a -> [a] -> [a]:quote :: String -> Stringquote arg :: Stringarg) args :: [String]args ]
where
quote :: String -> String
quote s = "\"" (++) :: [a] -> [a] -> [a]++ escapeQ :: [Char] -> [Char]escapeQ s :: Strings (++) :: [a] -> [a] -> [a]++ "\""
escapeQ [] = [] :: [a][]
escapeQ ('"':cs) = "\"\"\"" (++) :: [a] -> [a] -> [a]++ escapeQ :: [Char] -> [Char]escapeQ cs :: [Char]cs
escapeQ (c :cs) = c :: Charc (:) :: a -> [a] -> [a]: escapeQ :: [Char] -> [Char]escapeQ cs :: [Char]cs
escape [] = [] :: [a][]
escape ('|':cs) = "^|" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape ('<':cs) = "^<" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape ('>':cs) = "^>" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape ('&':cs) = "^&" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape ('(':cs) = "^(" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape (')':cs) = "^)" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape ('^':cs) = "^^" (++) :: [a] -> [a] -> [a]++ escape :: [Char] -> [Char]escape cs :: [Char]cs
escape (c :cs) = c :: Charc (:) :: a -> [a] -> [a]: escape :: [Char] -> [Char]escape cs :: [Char]cs