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