{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}

-- |

-- Module      :  BuildEnv.Script

-- Description :  Tiny build script DSL

--

-- This modules provides a tiny build script DSL.

--

-- A 'BuildScript' is a series of simple build steps (process calls).

--

-- A 'BuildScript' can be executed in the 'IO' monad, using 'executeBuildScript'.

--

-- A 'BuildScript' can be turned into a shell script which can be executed

-- later, using 'script'.

module BuildEnv.Script
  ( -- * Interpreting build scripts


    -- ** Executing build scripts

    executeBuildScript

    -- ** Shell-script output

  , script

    -- * Build scripts

  , BuildScript, BuildScriptM(..)
  , emptyBuildScript, askScriptConfig
  , buildSteps

    -- ** Individual build steps

  , BuildStep(..), BuildSteps
  , step
  , callProcess, createDir, logMessage, reportProgress

    -- ** Configuring build scripts

  , ScriptOutput(..), ScriptConfig(..), hostRunCfg
  , EscapeVars(..), quoteArg

  ) where

-- base

import Control.Monad
  ( when )
import Data.Foldable
  ( traverse_, foldl', for_ )
import Data.IORef
  ( atomicModifyIORef' )
import Data.Monoid
  ( Ap(..) )
import Data.String
  ( IsString(..) )
import System.IO
  ( hFlush )
import qualified System.IO as System
  ( stdout )

-- directory

import System.Directory
  ( createDirectoryIfMissing )

-- filepath

import System.FilePath
  ( (<.>) )

-- text

import Data.Text
  ( Text )
import qualified Data.Text as Text

-- transformers

import Control.Monad.Trans.Reader
  ( ReaderT(..) )
import Control.Monad.Trans.Writer.CPS
  ( Writer, execWriter, tell )

-- build-env

import BuildEnv.Config
  ( Verbosity(..), Counter(..), Style(..)
  , hostStyle
  )
import BuildEnv.Utils
  ( ProgPath(..), CallProcess(..), callProcessInIO )

--------------------------------------------------------------------------------

-- Build scripts: general monad setup.


-- | A build script: a list of build steps, given a 'ScriptConfig' context.

type BuildScript = BuildScriptM ()

deriving via Ap BuildScriptM ()
  instance Semigroup BuildScript
deriving via Ap BuildScriptM ()
  instance Monoid BuildScript

-- | Build script monad.

newtype BuildScriptM a =
  BuildScript
    { forall a.
BuildScriptM a -> ReaderT ScriptConfig (Writer BuildSteps) a
runBuildScript :: ReaderT ScriptConfig ( Writer BuildSteps ) a }
  deriving newtype ( forall a b. a -> BuildScriptM b -> BuildScriptM a
forall a b. (a -> b) -> BuildScriptM a -> BuildScriptM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BuildScriptM b -> BuildScriptM a
$c<$ :: forall a b. a -> BuildScriptM b -> BuildScriptM a
fmap :: forall a b. (a -> b) -> BuildScriptM a -> BuildScriptM b
$cfmap :: forall a b. (a -> b) -> BuildScriptM a -> BuildScriptM b
Functor, Functor BuildScriptM
forall a. a -> BuildScriptM a
forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM a
forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
forall a b.
BuildScriptM (a -> b) -> BuildScriptM a -> BuildScriptM b
forall a b c.
(a -> b -> c) -> BuildScriptM a -> BuildScriptM b -> BuildScriptM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM a
$c<* :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM a
*> :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
$c*> :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
liftA2 :: forall a b c.
(a -> b -> c) -> BuildScriptM a -> BuildScriptM b -> BuildScriptM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BuildScriptM a -> BuildScriptM b -> BuildScriptM c
<*> :: forall a b.
BuildScriptM (a -> b) -> BuildScriptM a -> BuildScriptM b
$c<*> :: forall a b.
BuildScriptM (a -> b) -> BuildScriptM a -> BuildScriptM b
pure :: forall a. a -> BuildScriptM a
$cpure :: forall a. a -> BuildScriptM a
Applicative, Applicative BuildScriptM
forall a. a -> BuildScriptM a
forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
forall a b.
BuildScriptM a -> (a -> BuildScriptM b) -> BuildScriptM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BuildScriptM a
$creturn :: forall a. a -> BuildScriptM a
>> :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
$c>> :: forall a b. BuildScriptM a -> BuildScriptM b -> BuildScriptM b
>>= :: forall a b.
BuildScriptM a -> (a -> BuildScriptM b) -> BuildScriptM b
$c>>= :: forall a b.
BuildScriptM a -> (a -> BuildScriptM b) -> BuildScriptM b
Monad )

-- | The empty build script: no build steps.

emptyBuildScript :: BuildScript
emptyBuildScript :: BuildScript
emptyBuildScript = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Retrieve the 'ScriptConfig' from the 'ReaderT' environment.

askScriptConfig :: BuildScriptM ScriptConfig
askScriptConfig :: BuildScriptM ScriptConfig
askScriptConfig = forall a.
ReaderT ScriptConfig (Writer BuildSteps) a -> BuildScriptM a
BuildScript forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Obtain the build steps of a 'BuildScript'.

buildSteps :: ScriptConfig -> BuildScript -> BuildSteps
buildSteps :: ScriptConfig -> BuildScript -> BuildSteps
buildSteps ScriptConfig
cfg BuildScript
buildScript
  = forall w a. Monoid w => Writer w a -> w
execWriter (forall a.
BuildScriptM a -> ReaderT ScriptConfig (Writer BuildSteps) a
runBuildScript BuildScript
buildScript forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` ScriptConfig
cfg)

--------------------------------------------------------------------------------

-- Individual build steps


-- | A list of build steps.

type BuildSteps = [BuildStep]

-- | A build step.

data BuildStep
  -- | Call a processs with the given arguments.

  = CallProcess CallProcess
  -- | Create the given directory.

  | CreateDir   FilePath
  -- | Log a message to @stdout@.

  | LogMessage  String
  -- | Report one unit of progress.

  | ReportProgress
      { BuildStep -> Bool
outputProgress :: Bool
        -- ^ Whether to log the progress to @stdout@.

      }

-- | Declare a build step.

step :: BuildStep -> BuildScript
step :: BuildStep -> BuildScript
step BuildStep
s = forall a.
ReaderT ScriptConfig (Writer BuildSteps) a -> BuildScriptM a
BuildScript forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \ ScriptConfig
_ -> forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell [BuildStep
s]

-- | Call a process with given arguments.

callProcess :: CallProcess -> BuildScript
callProcess :: CallProcess -> BuildScript
callProcess = BuildStep -> BuildScript
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallProcess -> BuildStep
CallProcess

-- | Create the given directory.

createDir :: FilePath -> BuildScript
createDir :: String -> BuildScript
createDir = BuildStep -> BuildScript
step forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BuildStep
CreateDir

-- | Log a message.

logMessage :: Verbosity -> Verbosity -> String -> BuildScript
logMessage :: Verbosity -> Verbosity -> String -> BuildScript
logMessage Verbosity
v Verbosity
msg_v String
msg
  | Verbosity
v forall a. Ord a => a -> a -> Bool
>= Verbosity
msg_v
  = BuildStep -> BuildScript
step forall a b. (a -> b) -> a -> b
$ String -> BuildStep
LogMessage String
msg
  | Bool
otherwise
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Report one unit of progress.

reportProgress :: Verbosity -> BuildScript
reportProgress :: Verbosity -> BuildScript
reportProgress Verbosity
v = BuildStep -> BuildScript
step ( ReportProgress { outputProgress :: Bool
outputProgress = Verbosity
v forall a. Ord a => a -> a -> Bool
> Verbosity
Quiet } )

--------------------------------------------------------------------------------

-- Configuration


-- | How to interpret the build script: run it in 'IO', or turn it

-- into a shell script?

data ScriptOutput
  -- | Run the build script in 'IO'

  = Run
  -- | Generate a shell script.

  | Shell
    { ScriptOutput -> Bool
useVariables :: !Bool
      -- ^ Replace various values with variables, so that

      -- they can be set before running the build script.

      --

      -- Values:

      --

      --  - @GHC@ and @GHC-PKG@,

      --  - fetched sources directory @SOURCES@,

      --  - @PREFIX@ and @DESTDIR@.

    }

-- | Configuration options for a 'BuildScript'.

data ScriptConfig
  = ScriptConfig
  { ScriptConfig -> ScriptOutput
scriptOutput :: !ScriptOutput
    -- ^ Whether we are outputting a shell script, so that we can know whether

    -- we should:

    --

    --  - add quotes around command-line arguments?

    --  - add @./@ to run an executable in the current working directory?

  , ScriptConfig -> Style
scriptStyle :: !Style
    -- ^ Whether to use Posix or Windows style conventions. See 'Style'.


  , ScriptConfig -> Maybe Word
scriptTotal :: !(Maybe Word)
    -- ^ Optional: the total number of units we are building;

    -- used to report progress.

  }

-- | Configure a script to run on the host (in @IO@).

hostRunCfg :: Maybe Word -- ^ Optional: total to report progress against.

           -> ScriptConfig
hostRunCfg :: Maybe Word -> ScriptConfig
hostRunCfg Maybe Word
mbTotal =
  ScriptConfig
    { scriptOutput :: ScriptOutput
scriptOutput = ScriptOutput
Run
    , scriptStyle :: Style
scriptStyle  = Style
hostStyle
    , scriptTotal :: Maybe Word
scriptTotal  = Maybe Word
mbTotal }

-- | Whether to expand or escape variables in a shell script.

data EscapeVars
  -- | Allow the shell to expand variables.

  = ExpandVars
  -- | Escape variables so that the shell doesn't expand them.

  | EscapeVars
  deriving stock Int -> EscapeVars -> ShowS
[EscapeVars] -> ShowS
EscapeVars -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeVars] -> ShowS
$cshowList :: [EscapeVars] -> ShowS
show :: EscapeVars -> String
$cshow :: EscapeVars -> String
showsPrec :: Int -> EscapeVars -> ShowS
$cshowsPrec :: Int -> EscapeVars -> ShowS
Show

-- | Quote a string, to avoid spaces causing the string

-- to be interpreted as multiple arguments.

q :: ( IsString r, Monoid r ) => EscapeVars-> String -> r
q :: forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
escapeVars String
t = r
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString ( ShowS
escapeArg String
t ) forall a. Semigroup a => a -> a -> a
<> r
"\""
  where
    escapeArg :: String -> String
    escapeArg :: ShowS
escapeArg = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' String -> Char -> String
escape []

    charsToEscape :: [ Char ]
    charsToEscape :: String
charsToEscape = case EscapeVars
escapeVars of
      EscapeVars
ExpandVars -> [ Char
'\\', Char
'\'', Char
'"' ]
      EscapeVars
EscapeVars -> [ Char
'\\', Char
'\'', Char
'"', Char
'$' ]

    escape :: String -> Char -> String
    escape :: String -> Char -> String
escape String
cs Char
c
      | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
charsToEscape
      = Char
cforall a. a -> [a] -> [a]
:Char
'\\'forall a. a -> [a] -> [a]
:String
cs
      | Bool
otherwise
      = Char
cforall a. a -> [a] -> [a]
:String
cs

-- | Quote a command-line argument, if the 'ScriptConfig' requires arguments

-- to be quoted.

--

-- No need to call this on the 'cwd' or 'prog' fields of 'CallProcess',

-- as these will be quoted by the shell-script backend no matter what.

quoteArg :: ( IsString r, Monoid r )
         => EscapeVars
         -> ScriptConfig
         -> String
         -> r
quoteArg :: forall r.
(IsString r, Monoid r) =>
EscapeVars -> ScriptConfig -> String -> r
quoteArg EscapeVars
escapeVars ( ScriptConfig { ScriptOutput
scriptOutput :: ScriptOutput
scriptOutput :: ScriptConfig -> ScriptOutput
scriptOutput } ) =
  case ScriptOutput
scriptOutput of
    ScriptOutput
Run      -> forall a. IsString a => String -> a
fromString
    Shell {} -> forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
escapeVars

--------------------------------------------------------------------------------

-- Interpretation


------

-- IO


-- | Execute a 'BuildScript' in the 'IO' monad.

executeBuildScript :: Maybe Counter -- ^ Optional counter to use to report progress.

                   -> BuildScript   -- ^ The build script to execute.

                   -> IO ()
executeBuildScript :: Maybe Counter -> BuildScript -> IO ()
executeBuildScript Maybe Counter
counter
  = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_  ( Maybe Counter -> BuildStep -> IO ()
executeBuildStep Maybe Counter
counter )
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptConfig -> BuildScript -> BuildSteps
buildSteps ( Maybe Word -> ScriptConfig
hostRunCfg forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Counter -> Word
counterMax Maybe Counter
counter )

-- | Execute a single 'BuildStep' in the 'IO' monad.

executeBuildStep :: Maybe Counter
                     -- ^ Optional counter to use to report progress.

                 -> BuildStep
                 -> IO ()
executeBuildStep :: Maybe Counter -> BuildStep -> IO ()
executeBuildStep Maybe Counter
mbCounter = \case
  CallProcess CallProcess
cp  -> HasCallStack => Maybe Counter -> CallProcess -> IO ()
callProcessInIO Maybe Counter
mbCounter CallProcess
cp
  CreateDir   String
dir -> Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
  LogMessage  String
msg -> do { String -> IO ()
putStrLn String
msg ; Handle -> IO ()
hFlush Handle
System.stdout }
  ReportProgress { Bool
outputProgress :: Bool
outputProgress :: BuildStep -> Bool
outputProgress } ->
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Counter
mbCounter \ Counter
counter -> do
      Word
completed <-
        forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' ( Counter -> IORef Word
counterRef Counter
counter )
          ( \ Word
x -> let !x' :: Word
x' = Word
xforall a. Num a => a -> a -> a
+Word
1 in (Word
x',Word
x') )
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputProgress do
        let
          txt :: String
txt = String
"## " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
completed forall a. Semigroup a => a -> a -> a
<> String
" of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ( Counter -> Word
counterMax Counter
counter ) forall a. Semigroup a => a -> a -> a
<> String
" ##"
          n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [ String
""
          , String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
n Char
'#'
          , String
" " forall a. Semigroup a => a -> a -> a
<> String
txt
          , String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
n Char
'#'
          , String
"" ]

----------------

-- Shell script


-- | Obtain the textual contents of a build script.

script :: ScriptConfig -> BuildScript -> Text
script :: ScriptConfig -> BuildScript -> Text
script ScriptConfig
scriptCfg BuildScript
buildScript =
  [Text] -> Text
Text.unlines ( [Text]
header forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ( ScriptConfig -> BuildStep -> [Text]
stepScript ScriptConfig
scriptCfg ) ( ScriptConfig -> BuildScript -> BuildSteps
buildSteps ScriptConfig
scriptCfg BuildScript
buildScript ) )
  where
    header, varsHelper, progressVars :: [ Text ]
    header :: [Text]
header = [ Text
"#!/bin/bash" , Text
"" ] forall a. [a] -> [a] -> [a]
++ [Text]
varsHelper forall a. [a] -> [a] -> [a]
++ [Text]
logDir forall a. [a] -> [a] -> [a]
++ [Text]
progressVars
    varsHelper :: [Text]
varsHelper
      | Shell { Bool
useVariables :: Bool
useVariables :: ScriptOutput -> Bool
useVariables } <- ScriptConfig -> ScriptOutput
scriptOutput ScriptConfig
scriptCfg
      , Bool
useVariables
      = [Text]
variablesHelper
      | Bool
otherwise
      = []
    progressVars :: [Text]
progressVars =
      case ScriptConfig -> Maybe Word
scriptTotal ScriptConfig
scriptCfg of
        Maybe Word
Nothing -> []
        Just {} ->
          [ Text
"buildEnvProgress=0" ]
    logDir :: [Text]
logDir = [ Text
"LOGDIR=\"$PWD/logs/$(date --utc +%Y-%m-%d_%H-%M-%S)\""
             , Text
"mkdir -p \"${LOGDIR}\"" ]

-- | The underlying script of a build step.

stepScript :: ScriptConfig -> BuildStep -> [ Text ]
stepScript :: ScriptConfig -> BuildStep -> [Text]
stepScript ScriptConfig
scriptCfg = \case
  CreateDir String
dir ->
    [ Text
"mkdir -p " forall a. Semigroup a => a -> a -> a
<> forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars String
dir ]
  LogMessage String
str ->
    [ Text
"echo " forall a. Semigroup a => a -> a -> a
<> forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars String
str ]
  ReportProgress { Bool
outputProgress :: Bool
outputProgress :: BuildStep -> Bool
outputProgress } ->
    case ScriptConfig -> Maybe Word
scriptTotal ScriptConfig
scriptCfg of
      Maybe Word
Nothing
        -> []
      Just Word
tot
        | Bool
outputProgress
        -> [ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"printf \"" forall a. Semigroup a => a -> a -> a
<> String
txt forall a. Semigroup a => a -> a -> a
<> String
"\" $((++buildEnvProgress))" ]
        | Bool
otherwise
        -> [ Text
"((++buildEnvProgress))" ]
          -- Still increment the progress variable, as we use this variable

          -- to report progress upon failure.

        where
          n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word
tot
          l :: Int
l = Int
2 forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
10
          txt :: String
txt = String
"\\n " forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
l Char
'#' forall a. Semigroup a => a -> a -> a
<> String
"\\n "
                       forall a. Semigroup a => a -> a -> a
<> String
"## %0" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
"d of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
tot forall a. Semigroup a => a -> a -> a
<> String
" ##" forall a. Semigroup a => a -> a -> a
<> String
"\\n "
                       forall a. Semigroup a => a -> a -> a
<> forall a. Int -> a -> [a]
replicate Int
l Char
'#' forall a. Semigroup a => a -> a -> a
<> String
"\\n"

  CallProcess ( CP { String
cwd :: CallProcess -> String
cwd :: String
cwd, [String]
extraPATH :: CallProcess -> [String]
extraPATH :: [String]
extraPATH, [(String, String)]
extraEnvVars :: CallProcess -> [(String, String)]
extraEnvVars :: [(String, String)]
extraEnvVars, ProgPath
prog :: CallProcess -> ProgPath
prog :: ProgPath
prog, [String]
args :: CallProcess -> [String]
args :: [String]
args, Maybe String
logBasePath :: CallProcess -> Maybe String
logBasePath :: Maybe String
logBasePath } ) ->
    -- NB: we ignore the semaphore, as the build scripts we produce

    -- are inherently sequential.

    [Text]
logCommand forall a. [a] -> [a] -> [a]
++
    [ Text
"( cd " forall a. Semigroup a => a -> a -> a
<> forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars String
cwd forall a. Semigroup a => a -> a -> a
<> Text
" ; \\" ]
    forall a. [a] -> [a] -> [a]
++ [Text]
mbUpdatePath
    forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> Text
mkEnvVar [(String, String)]
extraEnvVars
    forall a. [a] -> [a] -> [a]
++
    [ Text
"  " forall a. Semigroup a => a -> a -> a
<> Text
cmd forall a. Semigroup a => a -> a -> a
<> Text
pipeToLogs forall a. Semigroup a => a -> a -> a
<> Text
" )"
    , Text
resVar forall a. Semigroup a => a -> a -> a
<> Text
"=$?"
    , Text
"if [ \"${" forall a. Semigroup a => a -> a -> a
<> Text
resVar forall a. Semigroup a => a -> a -> a
<> Text
"}\" -eq 0 ]"
    , Text
"then true"
    , Text
"else"
    , Text
"  echo -e " forall a. Semigroup a => a -> a -> a
<>
        Text
"\"callProcess failed with non-zero exit code. Command:\\n" forall a. Semigroup a => a -> a -> a
<>
        Text
"  > " forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
cmd forall a. Semigroup a => a -> a -> a
<> Text
"\\n" forall a. Semigroup a => a -> a -> a
<>
        Text
"  CWD = " forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote (forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars String
cwd) forall a. Semigroup a => a -> a -> a
<> Text
"\""
      forall a. Semigroup a => a -> a -> a
<> Text
logErr
    ]
    forall a. [a] -> [a] -> [a]
++ [Text]
progressReport
    forall a. [a] -> [a] -> [a]
++ [Text]
logMsg
    forall a. [a] -> [a] -> [a]
++
    [ Text
"  exit \"${" forall a. Semigroup a => a -> a -> a
<> Text
resVar forall a. Semigroup a => a -> a -> a
<> Text
"}\""
    , Text
"fi" ]
    where
      cmd :: Text
      cmd :: Text
cmd = forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars ( ProgPath -> String
progPath ProgPath
prog ) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
args)
        --         (1)                                         (2)

        --

        -- (1)

        --   In shell scripts, we always change directory before running the

        --   program. As the program path is either absolute or relative to @cwd@,

        --   we don't need to modify the program path.

        --

        -- (2)

        --   Don't quote the arguments: arguments which needed quoting will have

        --   been quoted using the 'quoteArg' function.

        --

        --   This allows users to pass multiple arguments using variables:

        --

        --   > myArgs="arg1 arg2 arg3"

        --   > Setup configure $myArgs

        --

        --   by passing @$myArgs@ as a @Setup configure@ argument.

      resVar :: Text
      resVar :: Text
resVar = Text
"buildEnvLastExitCode"
      mbUpdatePath :: [Text]
      mbUpdatePath :: [Text]
mbUpdatePath
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
extraPATH
        = []
        | Bool
otherwise
        = [  Text
"  export PATH=$PATH:"
          forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
":" (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
Text.pack [String]
extraPATH) -- (already quoted)

          forall a. Semigroup a => a -> a -> a
<> Text
" ; \\" ]

      mkEnvVar :: (String, String) -> Text
      mkEnvVar :: (String, String) -> Text
mkEnvVar (String
var,String
val) = Text
"  export "
                        forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
var
                        forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
val forall a. Semigroup a => a -> a -> a
<> Text
" ; \\"
                                   -- (already quoted)


      logCommand, logMsg :: [Text]
      pipeToLogs, logErr :: Text
      ([Text]
logCommand, Text
pipeToLogs, Text
logErr, [Text]
logMsg) =
        case Maybe String
logBasePath of
          Maybe String
Nothing      -> ( [], Text
"", Text
" >&2", [] )
          Just String
logPath ->
            let stdoutFile, stderrFile :: Text
                stdoutFile :: Text
stdoutFile = forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars ( String
logPath String -> ShowS
<.> String
"stdout" )
                stderrFile :: Text
stderrFile = forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars ( String
logPath String -> ShowS
<.> String
"stderr" )
            in ( [ Text
"echo \"> " forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote Text
cmd forall a. Semigroup a => a -> a -> a
<> Text
"\" >> " forall a. Semigroup a => a -> a -> a
<> Text
stdoutFile ]
               , Text
" > " forall a. Semigroup a => a -> a -> a
<> Text
stdoutFile forall a. Semigroup a => a -> a -> a
<> Text
" 2> >( tee -a " forall a. Semigroup a => a -> a -> a
<> Text
stderrFile forall a. Semigroup a => a -> a -> a
<> Text
" >&2 )"
                  -- Write stdout to the stdout log file.

                  -- Write stderr both to the terminal and to the stderr log file.

               , Text
" | tee -a " forall a. Semigroup a => a -> a -> a
<> Text
stderrFile forall a. Semigroup a => a -> a -> a
<> Text
" >&2"
               , [ Text
"  echo \"Logs are available at: " forall a. Semigroup a => a -> a -> a
<> Text -> Text
unquote ( forall r. (IsString r, Monoid r) => EscapeVars -> String -> r
q EscapeVars
ExpandVars ( String
logPath forall a. Semigroup a => a -> a -> a
<> String
".{stdout,stderr}" ) ) forall a. Semigroup a => a -> a -> a
<> Text
"\"" ] )

      progressReport :: [Text]
      progressReport :: [Text]
progressReport =
        case ScriptConfig -> Maybe Word
scriptTotal ScriptConfig
scriptCfg of
          Maybe Word
Nothing  -> []
          Just Word
tot ->
            [ Text
"  echo \"After ${buildEnvProgress} of " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Word
tot) forall a. Semigroup a => a -> a -> a
<> Text
"\"" ]

unquote :: Text -> Text
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
Text.filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Char
'\"') )

----

-- Helper to check that environment variables are set as expected.


-- | All the environment variables that a shell script using variables

-- expects to be set.

allVars :: [ Text ]
allVars :: [Text]
allVars = [ Text
"GHC", Text
"GHCPKG", Text
"SOURCES", Text
"PREFIX", Text
"DESTDIR" ]

-- | A preamble that checks the required environment variables are defined.

variablesHelper :: [ Text ]
variablesHelper :: [Text]
variablesHelper =
    [ Text
"", Text
"echo \"Checking that required environment variables are set.\"" ]
    forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
variableHelper [Text]
allVars
    forall a. [a] -> [a] -> [a]
++ [ Text
"" ]

-- | Check that the given environment variable is defined, giving an error

-- message if it isn't (to avoid an error cascade).

variableHelper :: Text -> [ Text ]
variableHelper :: Text -> [Text]
variableHelper Text
varName =
  [ Text
"if [ -z ${" forall a. Semigroup a => a -> a -> a
<> Text
varName forall a. Semigroup a => a -> a -> a
<> Text
"} ]"
  , Text
"then"
  , Text
"  echo \"Environment variable " forall a. Semigroup a => a -> a -> a
<> Text
varName forall a. Semigroup a => a -> a -> a
<> Text
" not set.\""
  , Text
"  echo \"When using --variables, the build script expects the following environment variables to be set:\""
  , Text
"  echo \"  " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
allVars forall a. Semigroup a => a -> a -> a
<> Text
".\""
  , Text
"  exit 1"
  , Text
"fi" ]