1{-# LANGUAGE GADTs #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Distribution.Simple.Program.Script
5-- Copyright   :  Duncan Coutts 2009
6--
7-- Maintainer  :  cabal-devel@haskell.org
8-- Portability :  portable
9--
10-- This module provides an library interface to the @hc-pkg@ program.
11-- Currently only GHC and LHC have hc-pkg programs.
12
13module Distribution.Simple.Program.Script (
14
15    invocationAsSystemScript,
16    invocationAsShellScript,
17    invocationAsBatchFile,
18  ) where
19
20import Prelude ()
21import Distribution.Compat.Prelude
22
23import Distribution.Simple.Program.Run
24import Distribution.Simple.Utils
25import Distribution.System
26
27-- | Generate a system script, either POSIX shell script or Windows batch file
28-- as appropriate for the given system.
29--
30invocationAsSystemScript :: OS -> ProgramInvocation -> String
31invocationAsSystemScript Windows = invocationAsBatchFile
32invocationAsSystemScript _       = invocationAsShellScript
33
34
35-- | Generate a POSIX shell script that invokes a program.
36--
37invocationAsShellScript :: ProgramInvocation -> String
38invocationAsShellScript
39  ProgramInvocation {
40    progInvokePath  = path,
41    progInvokeArgs  = args,
42    progInvokeEnv   = envExtra,
43    progInvokeCwd   = mcwd,
44    progInvokeInput = minput
45  } = unlines $
46          [ "#!/bin/sh" ]
47       ++ concatMap setEnv envExtra
48       ++ [ "cd " ++ quote cwd | cwd <- maybeToList mcwd ]
49       ++ [ (case minput of
50              Nothing     -> ""
51              Just input -> "echo " ++ quote (iodataToText input) ++ " | ")
52         ++ unwords (map quote $ path : args) ++ " \"$@\""]
53
54  where
55    setEnv (var, Nothing)  = ["unset " ++ var, "export " ++ var]
56    setEnv (var, Just val) = ["export " ++ var ++ "=" ++ quote val]
57
58    quote :: String -> String
59    quote s = "'" ++ escape s ++ "'"
60
61    escape []        = []
62    escape ('\'':cs) = "'\\''" ++ escape cs
63    escape (c   :cs) = c        : escape cs
64
65iodataToText :: IOData -> String
66iodataToText (IODataText str)   = str
67iodataToText (IODataBinary lbs) = fromUTF8LBS lbs
68
69
70-- | Generate a Windows batch file that invokes a program.
71--
72invocationAsBatchFile :: ProgramInvocation -> String
73invocationAsBatchFile
74  ProgramInvocation {
75    progInvokePath  = path,
76    progInvokeArgs  = args,
77    progInvokeEnv   = envExtra,
78    progInvokeCwd   = mcwd,
79    progInvokeInput = minput
80  } = unlines $
81          [ "@echo off" ]
82       ++ map setEnv envExtra
83       ++ [ "cd \"" ++ cwd ++ "\"" | cwd <- maybeToList mcwd ]
84       ++ case minput of
85            Nothing    ->
86                [ path ++ concatMap (' ':) args ]
87
88            Just input ->
89                [ "(" ]
90             ++ [ "echo " ++ escape line | line <- lines $ iodataToText input ]
91             ++ [ ") | "
92               ++ "\"" ++ path ++ "\""
93               ++ concatMap (\arg -> ' ':quote arg) args ]
94
95  where
96    setEnv (var, Nothing)  = "set " ++ var ++ "="
97    setEnv (var, Just val) = "set " ++ var ++ "=" ++ escape val
98
99    quote :: String -> String
100    quote s = "\"" ++ escapeQ s ++ "\""
101
102    escapeQ []       = []
103    escapeQ ('"':cs) = "\"\"\"" ++ escapeQ cs
104    escapeQ (c  :cs) = c         : escapeQ cs
105
106    escape []        = []
107    escape ('|':cs) = "^|" ++ escape cs
108    escape ('<':cs) = "^<" ++ escape cs
109    escape ('>':cs) = "^>" ++ escape cs
110    escape ('&':cs) = "^&" ++ escape cs
111    escape ('(':cs) = "^(" ++ escape cs
112    escape (')':cs) = "^)" ++ escape cs
113    escape ('^':cs) = "^^" ++ escape cs
114    escape (c  :cs) = c     : escape cs
115