    {-# LANGUAGE GADTs #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Program.Script
    -- Copyright   :  Duncan Coutts 2009
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- This module provides an library interface to the @hc-pkg@ program.
    -- Currently only GHC and LHC have hc-pkg programs.

    module Distribution.Simple.Program.Script (

        invocationAsSystemScript,
        invocationAsShellScript,
        invocationAsBatchFile,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Simple.Program.Run
    import Distribution.Simple.Utils
    import Distribution.System

    -- | Generate a system script, either POSIX shell script or Windows batch file
    -- as appropriate for the given system.
    --
    invocationAsSystemScript :: OS -> ProgramInvocation -> String
    invocationAsSystemScript :: OS -> ProgramInvocation -> String
    invocationAsSystemScript OS
    Windows = ProgramInvocation -> String
    invocationAsBatchFile
    invocationAsSystemScript OS
    _       = ProgramInvocation -> String
    invocationAsShellScript

    -- | Generate a POSIX shell script that invokes a program.
    --
    invocationAsShellScript :: ProgramInvocation -> String
    invocationAsShellScript :: ProgramInvocation -> String
    invocationAsShellScript
      ProgramInvocation {
        progInvokePath :: ProgramInvocation -> String
    progInvokePath  = String
    path,
        progInvokeArgs :: ProgramInvocation -> [String]
    progInvokeArgs  = [String]
    args,
        progInvokeEnv :: ProgramInvocation -> [(String, Maybe String)]
    progInvokeEnv   = [(String, Maybe String)]
    envExtra,
        progInvokeCwd :: ProgramInvocation -> Maybe String
    progInvokeCwd   = Maybe String
    mcwd,
        progInvokeInput :: ProgramInvocation -> Maybe IOData
    progInvokeInput = Maybe IOData
    minput
      } = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
              [ String
    "#!/bin/sh" ]
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ((String, Maybe String) -> [String])
    -> [(String, Maybe String)] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (String, Maybe String) -> [String]
    setEnv [(String, Maybe String)]
    envExtra
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "cd " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    quote String
    cwd | String
    cwd <- Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList Maybe String
    mcwd ]
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ (case Maybe IOData
    minput of
                  Maybe IOData
    Nothing     -> String
    ""
                  Just IOData
    input -> String
    "printf '%s' " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    quote (IOData -> String
    iodataToText IOData
    input) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | ")
             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    quote ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String
    path String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    args) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " \"$@\""]

      where
        setEnv :: (String, Maybe String) -> [String]
    setEnv (String
    var, Maybe String
    Nothing)  = [String
    "unset " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    var, String
    "export " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    var]
        setEnv (String
    var, Just String
    val) = [String
    "export " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    var String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    quote String
    val]

        quote :: String -> String
        quote :: String -> String
    quote String
    s = String
    "'" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"

        escape :: String -> String
    escape []        = []
        escape (Char
    '\'':String
    cs) = String
    "'\\''" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    c   :String
    cs) = Char
    c        Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    escape String
    cs

    iodataToText :: IOData -> String
    iodataToText :: IOData -> String
    iodataToText (IODataText String
    str)   = String
    str
    iodataToText (IODataBinary ByteString
    lbs) = ByteString -> String
    fromUTF8LBS ByteString
    lbs

    -- | Generate a Windows batch file that invokes a program.
    --
    invocationAsBatchFile :: ProgramInvocation -> String
    invocationAsBatchFile :: ProgramInvocation -> String
    invocationAsBatchFile
      ProgramInvocation {
        progInvokePath :: ProgramInvocation -> String
    progInvokePath  = String
    path,
        progInvokeArgs :: ProgramInvocation -> [String]
    progInvokeArgs  = [String]
    args,
        progInvokeEnv :: ProgramInvocation -> [(String, Maybe String)]
    progInvokeEnv   = [(String, Maybe String)]
    envExtra,
        progInvokeCwd :: ProgramInvocation -> Maybe String
    progInvokeCwd   = Maybe String
    mcwd,
        progInvokeInput :: ProgramInvocation -> Maybe IOData
    progInvokeInput = Maybe IOData
    minput
      } = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
              [ String
    "@echo off" ]
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ((String, Maybe String) -> String)
    -> [(String, Maybe String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe String) -> String
    setEnv [(String, Maybe String)]
    envExtra
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "cd \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cwd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"" | String
    cwd <- Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList Maybe String
    mcwd ]
           [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ case Maybe IOData
    minput of
                Maybe IOData
    Nothing    ->
                    [ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Char
    ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) [String]
    args ]

                Just IOData
    input ->
                    [ String
    "(" ]
                 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "echo " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    line | String
    line <- String -> [String]
    lines (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ IOData -> String
    iodataToText IOData
    input ]
                 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    ") | "
                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\String
    arg -> Char
    ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String -> String
    quote String
    arg) [String]
    args ]

      where
        setEnv :: (String, Maybe String) -> String
    setEnv (String
    var, Maybe String
    Nothing)  = String
    "set " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    var String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "="
        setEnv (String
    var, Just String
    val) = String
    "set " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    var String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    val

        quote :: String -> String
        quote :: String -> String
    quote String
    s = String
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escapeQ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""

        escapeQ :: String -> String
    escapeQ []       = []
        escapeQ (Char
    '"':String
    cs) = String
    "\"\"\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escapeQ String
    cs
        escapeQ (Char
    c  :String
    cs) = Char
    c         Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    escapeQ String
    cs

        escape :: String -> String
    escape []        = []
        escape (Char
    '|':String
    cs) = String
    "^|" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    '<':String
    cs) = String
    "^<" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    '>':String
    cs) = String
    "^>" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    '&':String
    cs) = String
    "^&" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    '(':String
    cs) = String
    "^(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    ')':String
    cs) = String
    "^)" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    '^':String
    cs) = String
    "^^" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    escape String
    cs
        escape (Char
    c  :String
    cs) = Char
    c     Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    escape String
    cs