{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

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

-- |
-- Module      :  Distribution.Simple.Setup.Common
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Common utilities for defining command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Common
  ( CopyDest (..)
  , configureCCompiler
  , configureLinker
  , programDbOption
  , programDbOptions
  , programDbPaths
  , programDbPaths'
  , programFlagsDescription
  , splitArgs
  , testOrBenchmarkHelpText
  , defaultDistPref
  , extraCompilationArtifacts
  , optionDistPref
  , Flag (..)
  , toFlag
  , fromFlag
  , fromFlagOrDefault
  , flagToMaybe
  , flagToList
  , maybeToFlag
  , BooleanFlag (..)
  , boolOpt
  , boolOpt'
  , trueArg
  , falseArg
  , reqArgFlag
  , optionVerbosity
  , optionNumJobs
  ) where

import Distribution.Compat.Prelude hiding (get)
import Prelude ()

import Distribution.ReadE
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Verbosity

-- FIXME Not sure where this should live
defaultDistPref :: FilePath
defaultDistPref :: String
defaultDistPref = String
"dist"

-- | The name of the directory where optional compilation artifacts
-- go, such as ghc plugins and .hie files.
extraCompilationArtifacts :: FilePath
extraCompilationArtifacts :: String
extraCompilationArtifacts = String
"extra-compilation-artifacts"

-- | Help text for @test@ and @bench@ commands.
testOrBenchmarkHelpText
  :: String
  -- ^ Either @"test"@ or @"benchmark"@.
  -> String
  -- ^ Help text.
testOrBenchmarkHelpText :: String -> String
testOrBenchmarkHelpText String
s =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
      [String] -> String
unwords
      [
        [ String
"The package must have been build with configuration"
        , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"flag `--enable-", String
s, String
"s`."]
        ]
      , [] -- blank line
      ,
        [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"Note that additional dependencies of the ", String
s, String
"s"]
        , String
"must have already been installed."
        ]
      , []
      ,
        [ String
"By defining UserHooks in a custom Setup.hs, the package can define"
        , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"actions to be executed before and after running ", String
s, String
"s."]
        ]
      ]

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

-- * Shared options utils

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

programFlagsDescription :: ProgramDb -> String
programFlagsDescription :: ProgramDb -> String
programFlagsDescription ProgramDb
progDb =
  String
"The flags --with-PROG and --PROG-option(s) can be used with"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" the following programs:"
    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]
line -> String
"\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
line) ([[String]] -> String)
-> ([String] -> [[String]]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [[String]]
wrapLine Int
77 ([String] -> [[String]])
-> ([String] -> [String]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort)
      [Program -> String
programName Program
prog | (Program
prog, Maybe ConfiguredProgram
_) <- ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progDb]
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- | For each known program @PROG@ in 'progDb', produce a @with-PROG@
-- 'OptionField'.
programDbPaths
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, FilePath)])
  -> ([(String, FilePath)] -> (flags -> flags))
  -> [OptionField flags]
programDbPaths :: forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, String)]
get [(String, String)] -> flags -> flags
set =
  (String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
forall flags.
(String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths' (String
"with-" String -> String -> String
forall a. [a] -> [a] -> [a]
++) ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, String)]
get [(String, String)] -> flags -> flags
set

-- | Like 'programDbPaths', but allows to customise the option name.
programDbPaths'
  :: (String -> String)
  -> ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, FilePath)])
  -> ([(String, FilePath)] -> (flags -> flags))
  -> [OptionField flags]
programDbPaths' :: forall flags.
(String -> String)
-> ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths' String -> String
mkName ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, String)]
get [(String, String)] -> flags -> flags
set =
  case ShowOrParseArgs
showOrParseArgs of
    -- we don't want a verbose help text list so we just show a generic one:
    ShowOrParseArgs
ShowArgs -> [String -> OptionField flags
withProgramPath String
"PROG"]
    ShowOrParseArgs
ParseArgs ->
      ((Program, Maybe ConfiguredProgram) -> OptionField flags)
-> [(Program, Maybe ConfiguredProgram)] -> [OptionField flags]
forall a b. (a -> b) -> [a] -> [b]
map
        (String -> OptionField flags
withProgramPath (String -> OptionField flags)
-> ((Program, Maybe ConfiguredProgram) -> String)
-> (Program, Maybe ConfiguredProgram)
-> OptionField flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
programName (Program -> String)
-> ((Program, Maybe ConfiguredProgram) -> Program)
-> (Program, Maybe ConfiguredProgram)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program, Maybe ConfiguredProgram) -> Program
forall a b. (a, b) -> a
fst)
        (ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progDb)
  where
    withProgramPath :: String -> OptionField flags
withProgramPath String
prog =
      String
-> [String]
-> String
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> MkOptDescr
     (flags -> [(String, String)])
     ([(String, String)] -> flags -> flags)
     flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        String
""
        [String -> String
mkName String
prog]
        (String
"give the path to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog)
        flags -> [(String, String)]
get
        [(String, String)] -> flags -> flags
set
        ( String
-> (String -> [(String, String)])
-> ([(String, String)] -> [String])
-> MkOptDescr
     (flags -> [(String, String)])
     ([(String, String)] -> flags -> flags)
     flags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
            String
"PATH"
            (\String
path -> [(String
prog, String
path)])
            (\[(String, String)]
progPaths -> [String
path | (String
prog', String
path) <- [(String, String)]
progPaths, String
prog String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prog'])
        )

-- | For each known program @PROG@ in 'progDb', produce a @PROG-option@
-- 'OptionField'.
programDbOption
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, [String])])
  -> ([(String, [String])] -> (flags -> flags))
  -> [OptionField flags]
programDbOption :: forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOption ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, [String])]
get [(String, [String])] -> flags -> flags
set =
  case ShowOrParseArgs
showOrParseArgs of
    -- we don't want a verbose help text list so we just show a generic one:
    ShowOrParseArgs
ShowArgs -> [String -> OptionField flags
programOption String
"PROG"]
    ShowOrParseArgs
ParseArgs ->
      ((Program, Maybe ConfiguredProgram) -> OptionField flags)
-> [(Program, Maybe ConfiguredProgram)] -> [OptionField flags]
forall a b. (a -> b) -> [a] -> [b]
map
        (String -> OptionField flags
programOption (String -> OptionField flags)
-> ((Program, Maybe ConfiguredProgram) -> String)
-> (Program, Maybe ConfiguredProgram)
-> OptionField flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
programName (Program -> String)
-> ((Program, Maybe ConfiguredProgram) -> Program)
-> (Program, Maybe ConfiguredProgram)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program, Maybe ConfiguredProgram) -> Program
forall a b. (a, b) -> a
fst)
        (ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progDb)
  where
    programOption :: String -> OptionField flags
programOption String
prog =
      String
-> [String]
-> String
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        String
""
        [String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-option"]
        ( String
"give an extra option to "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (no need to quote options containing spaces)"
        )
        flags -> [(String, [String])]
get
        [(String, [String])] -> flags -> flags
set
        ( String
-> (String -> [(String, [String])])
-> ([(String, [String])] -> [String])
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg'
            String
"OPT"
            (\String
arg -> [(String
prog, [String
arg])])
            ( \[(String, [String])]
progArgs ->
                [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                  [ [String]
args
                  | (String
prog', [String]
args) <- [(String, [String])]
progArgs
                  , String
prog String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
prog'
                  ]
            )
        )

-- | For each known program @PROG@ in 'progDb', produce a @PROG-options@
-- 'OptionField'.
programDbOptions
  :: ProgramDb
  -> ShowOrParseArgs
  -> (flags -> [(String, [String])])
  -> ([(String, [String])] -> (flags -> flags))
  -> [OptionField flags]
programDbOptions :: forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOptions ProgramDb
progDb ShowOrParseArgs
showOrParseArgs flags -> [(String, [String])]
get [(String, [String])] -> flags -> flags
set =
  case ShowOrParseArgs
showOrParseArgs of
    -- we don't want a verbose help text list so we just show a generic one:
    ShowOrParseArgs
ShowArgs -> [String -> OptionField flags
programOptions String
"PROG"]
    ShowOrParseArgs
ParseArgs ->
      ((Program, Maybe ConfiguredProgram) -> OptionField flags)
-> [(Program, Maybe ConfiguredProgram)] -> [OptionField flags]
forall a b. (a -> b) -> [a] -> [b]
map
        (String -> OptionField flags
programOptions (String -> OptionField flags)
-> ((Program, Maybe ConfiguredProgram) -> String)
-> (Program, Maybe ConfiguredProgram)
-> OptionField flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
programName (Program -> String)
-> ((Program, Maybe ConfiguredProgram) -> Program)
-> (Program, Maybe ConfiguredProgram)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program, Maybe ConfiguredProgram) -> Program
forall a b. (a, b) -> a
fst)
        (ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
progDb)
  where
    programOptions :: String -> OptionField flags
programOptions String
prog =
      String
-> [String]
-> String
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        String
""
        [String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-options"]
        (String
"give extra options to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog)
        flags -> [(String, [String])]
get
        [(String, [String])] -> flags -> flags
set
        (String
-> (String -> [(String, [String])])
-> ([(String, [String])] -> [String])
-> MkOptDescr
     (flags -> [(String, [String])])
     ([(String, [String])] -> flags -> flags)
     flags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg' String
"OPTS" (\String
args -> [(String
prog, String -> [String]
splitArgs String
args)]) ([String] -> [(String, [String])] -> [String]
forall a b. a -> b -> a
const []))

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

-- * GetOpt Utils

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

boolOpt
  :: SFlags
  -> SFlags
  -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt :: forall a.
String
-> String -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt = (Flag Bool -> Maybe Bool)
-> (Bool -> Flag Bool)
-> String
-> String
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
forall b a.
(b -> Maybe Bool)
-> (Bool -> b)
-> String
-> String
-> MkOptDescr (a -> b) (b -> a -> a) a
Command.boolOpt Flag Bool -> Maybe Bool
forall a. Flag a -> Maybe a
flagToMaybe Bool -> Flag Bool
forall a. a -> Flag a
Flag

boolOpt'
  :: OptFlags
  -> OptFlags
  -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' :: forall a.
(String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' = (Flag Bool -> Maybe Bool)
-> (Bool -> Flag Bool)
-> (String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
forall b a.
(b -> Maybe Bool)
-> (Bool -> b)
-> (String, [String])
-> (String, [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
Command.boolOpt' Flag Bool -> Maybe Bool
forall a. Flag a -> Maybe a
flagToMaybe Bool -> Flag Bool
forall a. a -> Flag a
Flag

trueArg, falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg :: forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg String
sfT [String]
lfT = (String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
forall a.
(String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' (String
sfT, [String]
lfT) ([], []) String
sfT [String]
lfT
falseArg :: forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
falseArg String
sfF [String]
lfF = (String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
forall a.
(String, [String])
-> (String, [String])
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' ([], []) (String
sfF, [String]
lfF) String
sfF [String]
lfF

reqArgFlag
  :: ArgPlaceHolder
  -> SFlags
  -> LFlags
  -> Description
  -> (b -> Flag String)
  -> (Flag String -> b -> b)
  -> OptDescr b
reqArgFlag :: forall b.
String
-> String
-> [String]
-> String
-> (b -> Flag String)
-> (Flag String -> b -> b)
-> OptDescr b
reqArgFlag String
ad = String
-> ReadE (Flag String)
-> (Flag String -> [String])
-> MkOptDescr (b -> Flag String) (Flag String -> b -> b) b
forall b a.
Monoid b =>
String
-> ReadE b
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg String
ad ((String -> Flag String) -> ReadE (Flag String)
forall a. (String -> a) -> ReadE a
succeedReadE String -> Flag String
forall a. a -> Flag a
Flag) Flag String -> [String]
forall a. Flag a -> [a]
flagToList

optionDistPref
  :: (flags -> Flag FilePath)
  -> (Flag FilePath -> flags -> flags)
  -> ShowOrParseArgs
  -> OptionField flags
optionDistPref :: forall flags.
(flags -> Flag String)
-> (Flag String -> flags -> flags)
-> ShowOrParseArgs
-> OptionField flags
optionDistPref flags -> Flag String
get Flag String -> flags -> flags
set = \ShowOrParseArgs
showOrParseArgs ->
  String
-> [String]
-> String
-> (flags -> Flag String)
-> (Flag String -> flags -> flags)
-> MkOptDescr
     (flags -> Flag String) (Flag String -> flags -> flags) flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
    String
""
    (ShowOrParseArgs -> [String]
distPrefFlagName ShowOrParseArgs
showOrParseArgs)
    ( String
"The directory where Cabal puts generated build files "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(default "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
defaultDistPref
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    )
    flags -> Flag String
get
    Flag String -> flags -> flags
set
    (String
-> MkOptDescr
     (flags -> Flag String) (Flag String -> flags -> flags) flags
forall b.
String
-> String
-> [String]
-> String
-> (b -> Flag String)
-> (Flag String -> b -> b)
-> OptDescr b
reqArgFlag String
"DIR")
  where
    distPrefFlagName :: ShowOrParseArgs -> [String]
distPrefFlagName ShowOrParseArgs
ShowArgs = [String
"builddir"]
    distPrefFlagName ShowOrParseArgs
ParseArgs = [String
"builddir", String
"distdir", String
"distpref"]

optionVerbosity
  :: (flags -> Flag Verbosity)
  -> (Flag Verbosity -> flags -> flags)
  -> OptionField flags
optionVerbosity :: forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity flags -> Flag Verbosity
get Flag Verbosity -> flags -> flags
set =
  String
-> [String]
-> String
-> (flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags)
-> MkOptDescr
     (flags -> Flag Verbosity) (Flag Verbosity -> flags -> flags) flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
    String
"v"
    [String
"verbose"]
    String
"Control verbosity (n is 0--3, default verbosity level is 1)"
    flags -> Flag Verbosity
get
    Flag Verbosity -> flags -> flags
set
    ( String
-> ReadE (Flag Verbosity)
-> (String, Flag Verbosity)
-> (Flag Verbosity -> [Maybe String])
-> MkOptDescr
     (flags -> Flag Verbosity) (Flag Verbosity -> flags -> flags) flags
forall b a.
Monoid b =>
String
-> ReadE b
-> (String, b)
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg
        String
"n"
        ((Verbosity -> Flag Verbosity)
-> ReadE Verbosity -> ReadE (Flag Verbosity)
forall a b. (a -> b) -> ReadE a -> ReadE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag ReadE Verbosity
flagToVerbosity)
        (Verbosity -> String
forall a. Show a => a -> String
show Verbosity
verbose, Verbosity -> Flag Verbosity
forall a. a -> Flag a
Flag Verbosity
verbose) -- default Value if no n is given
        ((Verbosity -> Maybe String) -> [Verbosity] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Verbosity -> String) -> Verbosity -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String
showForCabal) ([Verbosity] -> [Maybe String])
-> (Flag Verbosity -> [Verbosity])
-> Flag Verbosity
-> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag Verbosity -> [Verbosity]
forall a. Flag a -> [a]
flagToList)
    )

optionNumJobs
  :: (flags -> Flag (Maybe Int))
  -> (Flag (Maybe Int) -> flags -> flags)
  -> OptionField flags
optionNumJobs :: forall flags.
(flags -> Flag (Maybe Int))
-> (Flag (Maybe Int) -> flags -> flags) -> OptionField flags
optionNumJobs flags -> Flag (Maybe Int)
get Flag (Maybe Int) -> flags -> flags
set =
  String
-> [String]
-> String
-> (flags -> Flag (Maybe Int))
-> (Flag (Maybe Int) -> flags -> flags)
-> MkOptDescr
     (flags -> Flag (Maybe Int))
     (Flag (Maybe Int) -> flags -> flags)
     flags
-> OptionField flags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
    String
"j"
    [String
"jobs"]
    String
"Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)."
    flags -> Flag (Maybe Int)
get
    Flag (Maybe Int) -> flags -> flags
set
    ( String
-> ReadE (Flag (Maybe Int))
-> (String, Flag (Maybe Int))
-> (Flag (Maybe Int) -> [Maybe String])
-> MkOptDescr
     (flags -> Flag (Maybe Int))
     (Flag (Maybe Int) -> flags -> flags)
     flags
forall b a.
Monoid b =>
String
-> ReadE b
-> (String, b)
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg
        String
"NUM"
        ((Maybe Int -> Flag (Maybe Int))
-> ReadE (Maybe Int) -> ReadE (Flag (Maybe Int))
forall a b. (a -> b) -> ReadE a -> ReadE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Int -> Flag (Maybe Int)
forall a. a -> Flag a
Flag ReadE (Maybe Int)
numJobsParser)
        (String
"$ncpus", Maybe Int -> Flag (Maybe Int)
forall a. a -> Flag a
Flag Maybe Int
forall a. Maybe a
Nothing)
        ((Maybe Int -> Maybe String) -> [Maybe Int] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Maybe Int -> String) -> Maybe Int -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"$ncpus" Int -> String
forall a. Show a => a -> String
show) ([Maybe Int] -> [Maybe String])
-> (Flag (Maybe Int) -> [Maybe Int])
-> Flag (Maybe Int)
-> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag (Maybe Int) -> [Maybe Int]
forall a. Flag a -> [a]
flagToList)
    )
  where
    numJobsParser :: ReadE (Maybe Int)
    numJobsParser :: ReadE (Maybe Int)
numJobsParser = (String -> Either String (Maybe Int)) -> ReadE (Maybe Int)
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String (Maybe Int)) -> ReadE (Maybe Int))
-> (String -> Either String (Maybe Int)) -> ReadE (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \String
s ->
      case String
s of
        String
"$ncpus" -> Maybe Int -> Either String (Maybe Int)
forall a b. b -> Either a b
Right Maybe Int
forall a. Maybe a
Nothing
        String
_ -> case ReadS Int
forall a. Read a => ReadS a
reads String
s of
          [(Int
n, String
"")]
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> String -> Either String (Maybe Int)
forall a b. a -> Either a b
Left String
"The number of jobs should be 1 or more."
            | Bool
otherwise -> Maybe Int -> Either String (Maybe Int)
forall a b. b -> Either a b
Right (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
          [(Int, String)]
_ -> String -> Either String (Maybe Int)
forall a b. a -> Either a b
Left String
"The jobs value should be a number or '$ncpus'"

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

-- * Other Utils

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

configureCCompiler
  :: Verbosity
  -> ProgramDb
  -> IO (FilePath, [String])
configureCCompiler :: Verbosity -> ProgramDb -> IO (String, [String])
configureCCompiler Verbosity
verbosity ProgramDb
progdb = Verbosity -> ProgramDb -> Program -> IO (String, [String])
configureProg Verbosity
verbosity ProgramDb
progdb Program
gccProgram

configureLinker :: Verbosity -> ProgramDb -> IO (FilePath, [String])
configureLinker :: Verbosity -> ProgramDb -> IO (String, [String])
configureLinker Verbosity
verbosity ProgramDb
progdb = Verbosity -> ProgramDb -> Program -> IO (String, [String])
configureProg Verbosity
verbosity ProgramDb
progdb Program
ldProgram

configureProg
  :: Verbosity
  -> ProgramDb
  -> Program
  -> IO (FilePath, [String])
configureProg :: Verbosity -> ProgramDb -> Program -> IO (String, [String])
configureProg Verbosity
verbosity ProgramDb
programDb Program
prog = do
  (p, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
programDb
  let pInv = ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
p []
  return (progInvokePath pInv, progInvokeArgs pInv)

-- | Helper function to split a string into a list of arguments.
-- It's supposed to handle quoted things sensibly, eg:
--
-- > splitArgs "--foo=\"C:/Program Files/Bar/" --baz"
-- >   = ["--foo=C:/Program Files/Bar", "--baz"]
--
-- > splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz"
-- >   = ["-DMSGSTR=\"foo bar\"","--baz"]
splitArgs :: String -> [String]
splitArgs :: String -> [String]
splitArgs = String -> String -> [String]
space []
  where
    space :: String -> String -> [String]
    space :: String -> String -> [String]
space String
w [] = String -> [String] -> [String]
forall {a}. [a] -> [[a]] -> [[a]]
word String
w []
    space String
w (Char
c : String
s)
      | Char -> Bool
isSpace Char
c = String -> [String] -> [String]
forall {a}. [a] -> [[a]] -> [[a]]
word String
w (String -> String -> [String]
space [] String
s)
    space String
w (Char
'"' : String
s) = String -> String -> [String]
string String
w String
s
    space String
w String
s = String -> String -> [String]
nonstring String
w String
s

    string :: String -> String -> [String]
    string :: String -> String -> [String]
string String
w [] = String -> [String] -> [String]
forall {a}. [a] -> [[a]] -> [[a]]
word String
w []
    string String
w (Char
'"' : String
s) = String -> String -> [String]
space String
w String
s
    string String
w (Char
'\\' : Char
'"' : String
s) = String -> String -> [String]
string (Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
w) String
s
    string String
w (Char
c : String
s) = String -> String -> [String]
string (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
w) String
s

    nonstring :: String -> String -> [String]
    nonstring :: String -> String -> [String]
nonstring String
w [] = String -> [String] -> [String]
forall {a}. [a] -> [[a]] -> [[a]]
word String
w []
    nonstring String
w (Char
'"' : String
s) = String -> String -> [String]
string String
w String
s
    nonstring String
w (Char
c : String
s) = String -> String -> [String]
space (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
w) String
s

    word :: [a] -> [[a]] -> [[a]]
word [] [[a]]
s = [[a]]
s
    word [a]
w [[a]]
s = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
w [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
s