    {-# 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 Distribution.Compat.Prelude
    import 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