src/Distribution/Simple/Program/Script.hs

    {-# 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 Windows = invocationAsBatchFile
    invocationAsSystemScript _       = invocationAsShellScript

    -- | 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 $
              [ "#!/bin/sh" ]
           ++ concatMap setEnv envExtra
           ++ [ "cd " ++ quote cwd | cwd <- maybeToList mcwd ]
           ++ [ (case minput of
                  Nothing     -> ""
                  Just input -> "echo " ++ quote (iodataToText input) ++ " | ")
             ++ unwords (map quote $ path : args) ++ " \"$@\""]

      where
        setEnv (var, Nothing)  = ["unset " ++ var, "export " ++ var]
        setEnv (var, Just val) = ["export " ++ var ++ "=" ++ quote val]

        quote :: String -> String
        quote s = "'" ++ escape s ++ "'"

        escape []        = []
        escape ('\'':cs) = "'\\''" ++ escape cs
        escape (c   :cs) = c        : escape cs

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

    -- | 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 $
              [ "@echo off" ]
           ++ map setEnv envExtra
           ++ [ "cd \"" ++ cwd ++ "\"" | cwd <- maybeToList mcwd ]
           ++ case minput of
                Nothing    ->
                    [ path ++ concatMap (' ':) args ]

                Just input ->
                    [ "(" ]
                 ++ [ "echo " ++ escape line | line <- lines $ iodataToText input ]
                 ++ [ ") | "
                   ++ "\"" ++ path ++ "\""
                   ++ concatMap (\arg -> ' ':quote arg) args ]

      where
        setEnv (var, Nothing)  = "set " ++ var ++ "="
        setEnv (var, Just val) = "set " ++ var ++ "=" ++ escape val

        quote :: String -> String
        quote s = "\"" ++ escapeQ s ++ "\""

        escapeQ []       = []
        escapeQ ('"':cs) = "\"\"\"" ++ escapeQ cs
        escapeQ (c  :cs) = c         : escapeQ cs

        escape []        = []
        escape ('|':cs) = "^|" ++ escape cs
        escape ('<':cs) = "^<" ++ escape cs
        escape ('>':cs) = "^>" ++ escape cs
        escape ('&':cs) = "^&" ++ escape cs
        escape ('(':cs) = "^(" ++ escape cs
        escape (')':cs) = "^)" ++ escape cs
        escape ('^':cs) = "^^" ++ escape cs
        escape (c  :cs) = c     : escape cs