-----------------------------------------------------------------------------
-- |
-- 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.Simple.Program.Run
         ( ProgramInvocation(..) )
import Distribution.System
         ( OS(..) )

import Data.Maybe
         ( maybeToList )

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


-- | Generate a POSIX shell script that invokes a program.
--
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


-- | Generate a Windows batch file that invokes a program.
--
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