{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

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

-- |
-- Module      :  Distribution.Simple.Setup.Build
-- Copyright   :  Isaac Jones 2003-2004
--                Duncan Coutts 2007
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Definition of the build command-line options.
-- See: @Distribution.Simple.Setup@
module Distribution.Simple.Setup.Build
  ( BuildFlags
      ( BuildCommonFlags
      , buildVerbosity
      , buildDistPref
      , buildCabalFilePath
      , buildWorkingDir
      , buildTargets
      , ..
      )
  , emptyBuildFlags
  , defaultBuildFlags
  , buildCommand
  , DumpBuildInfo (..)
  , buildOptions
  ) where

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

import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import Distribution.Simple.Flag
import Distribution.Simple.Program
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Types.DumpBuildInfo
import Distribution.Utils.Path
import Distribution.Verbosity

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

-- * Build flags

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

data BuildFlags = BuildFlags
  { BuildFlags -> CommonSetupFlags
buildCommonFlags :: !CommonSetupFlags
  , BuildFlags -> [(String, String)]
buildProgramPaths :: [(String, FilePath)]
  , BuildFlags -> [(String, [String])]
buildProgramArgs :: [(String, [String])]
  , BuildFlags -> Flag (Maybe Int)
buildNumJobs :: Flag (Maybe Int)
  , BuildFlags -> Flag String
buildUseSemaphore :: Flag String
  }
  deriving (ReadPrec [BuildFlags]
ReadPrec BuildFlags
Int -> ReadS BuildFlags
ReadS [BuildFlags]
(Int -> ReadS BuildFlags)
-> ReadS [BuildFlags]
-> ReadPrec BuildFlags
-> ReadPrec [BuildFlags]
-> Read BuildFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BuildFlags
readsPrec :: Int -> ReadS BuildFlags
$creadList :: ReadS [BuildFlags]
readList :: ReadS [BuildFlags]
$creadPrec :: ReadPrec BuildFlags
readPrec :: ReadPrec BuildFlags
$creadListPrec :: ReadPrec [BuildFlags]
readListPrec :: ReadPrec [BuildFlags]
Read, Int -> BuildFlags -> ShowS
[BuildFlags] -> ShowS
BuildFlags -> String
(Int -> BuildFlags -> ShowS)
-> (BuildFlags -> String)
-> ([BuildFlags] -> ShowS)
-> Show BuildFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildFlags -> ShowS
showsPrec :: Int -> BuildFlags -> ShowS
$cshow :: BuildFlags -> String
show :: BuildFlags -> String
$cshowList :: [BuildFlags] -> ShowS
showList :: [BuildFlags] -> ShowS
Show, (forall x. BuildFlags -> Rep BuildFlags x)
-> (forall x. Rep BuildFlags x -> BuildFlags) -> Generic BuildFlags
forall x. Rep BuildFlags x -> BuildFlags
forall x. BuildFlags -> Rep BuildFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildFlags -> Rep BuildFlags x
from :: forall x. BuildFlags -> Rep BuildFlags x
$cto :: forall x. Rep BuildFlags x -> BuildFlags
to :: forall x. Rep BuildFlags x -> BuildFlags
Generic, Typeable)

pattern BuildCommonFlags
  :: Flag Verbosity
  -> Flag (SymbolicPath Pkg (Dir Dist))
  -> Flag (SymbolicPath CWD (Dir Pkg))
  -> Flag (SymbolicPath Pkg File)
  -> [String]
  -> BuildFlags
pattern $mBuildCommonFlags :: forall {r}.
BuildFlags
-> (Flag Verbosity
    -> Flag (SymbolicPath Pkg ('Dir Dist))
    -> Flag (SymbolicPath CWD ('Dir Pkg))
    -> Flag (SymbolicPath Pkg 'File)
    -> [String]
    -> r)
-> ((# #) -> r)
-> r
BuildCommonFlags
  { BuildFlags -> Flag Verbosity
buildVerbosity
  , BuildFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
buildDistPref
  , BuildFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
buildWorkingDir
  , BuildFlags -> Flag (SymbolicPath Pkg 'File)
buildCabalFilePath
  , BuildFlags -> [String]
buildTargets
  } <-
  ( buildCommonFlags ->
      CommonSetupFlags
        { setupVerbosity = buildVerbosity
        , setupDistPref = buildDistPref
        , setupWorkingDir = buildWorkingDir
        , setupCabalFilePath = buildCabalFilePath
        , setupTargets = buildTargets
        }
    )

instance Binary BuildFlags
instance Structured BuildFlags

defaultBuildFlags :: BuildFlags
defaultBuildFlags :: BuildFlags
defaultBuildFlags =
  BuildFlags
    { buildCommonFlags :: CommonSetupFlags
buildCommonFlags = CommonSetupFlags
defaultCommonSetupFlags
    , buildProgramPaths :: [(String, String)]
buildProgramPaths = [(String, String)]
forall a. Monoid a => a
mempty
    , buildProgramArgs :: [(String, [String])]
buildProgramArgs = []
    , buildNumJobs :: Flag (Maybe Int)
buildNumJobs = Flag (Maybe Int)
forall a. Monoid a => a
mempty
    , buildUseSemaphore :: Flag String
buildUseSemaphore = Flag String
forall a. Flag a
NoFlag
    }

buildCommand :: ProgramDb -> CommandUI BuildFlags
buildCommand :: ProgramDb -> CommandUI BuildFlags
buildCommand ProgramDb
progDb =
  CommandUI
    { commandName :: String
commandName = String
"build"
    , commandSynopsis :: String
commandSynopsis = String
"Compile all/specific components."
    , commandDescription :: Maybe ShowS
commandDescription = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \String
_ ->
        ShowS
wrapText ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String
"Components encompass executables, tests, and benchmarks.\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Affected by configuration options, see `configure`.\n"
    , commandNotes :: Maybe ShowS
commandNotes = ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$ \String
pname ->
        String
"Examples:\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pname
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" build           "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"    All the components in the package\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pname
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" build foo       "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"    A component (i.e. lib, exe, test suite)\n\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgramDb -> String
programFlagsDescription ProgramDb
progDb
    , -- TODO: re-enable once we have support for module/file targets
      --        ++ "  " ++ pname ++ " build Foo.Bar   "
      --        ++ "    A module\n"
      --        ++ "  " ++ pname ++ " build Foo/Bar.hs"
      --        ++ "    A file\n\n"
      --        ++ "If a target is ambiguous it can be qualified with the component "
      --        ++ "name, e.g.\n"
      --        ++ "  " ++ pname ++ " build foo:Foo.Bar\n"
      --        ++ "  " ++ pname ++ " build testsuite1:Foo/Bar.hs\n"
      commandUsage :: ShowS
commandUsage =
        String -> [String] -> ShowS
usageAlternatives String
"build" ([String] -> ShowS) -> [String] -> ShowS
forall a b. (a -> b) -> a -> b
$
          [ String
"[FLAGS]"
          , String
"COMPONENTS [FLAGS]"
          ]
    , commandDefaultFlags :: BuildFlags
commandDefaultFlags = BuildFlags
defaultBuildFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField BuildFlags]
commandOptions = ProgramDb -> ShowOrParseArgs -> [OptionField BuildFlags]
buildOptions ProgramDb
progDb
    }

buildOptions
  :: ProgramDb
  -> ShowOrParseArgs
  -> [OptionField BuildFlags]
buildOptions :: ProgramDb -> ShowOrParseArgs -> [OptionField BuildFlags]
buildOptions ProgramDb
progDb ShowOrParseArgs
showOrParseArgs =
  (BuildFlags -> CommonSetupFlags)
-> (CommonSetupFlags -> BuildFlags -> BuildFlags)
-> ShowOrParseArgs
-> [OptionField BuildFlags]
-> [OptionField BuildFlags]
forall flags.
(flags -> CommonSetupFlags)
-> (CommonSetupFlags -> flags -> flags)
-> ShowOrParseArgs
-> [OptionField flags]
-> [OptionField flags]
withCommonSetupOptions
    BuildFlags -> CommonSetupFlags
buildCommonFlags
    (\CommonSetupFlags
c BuildFlags
f -> BuildFlags
f{buildCommonFlags = c})
    ShowOrParseArgs
showOrParseArgs
    ( [ (BuildFlags -> Flag (Maybe Int))
-> (Flag (Maybe Int) -> BuildFlags -> BuildFlags)
-> OptionField BuildFlags
forall flags.
(flags -> Flag (Maybe Int))
-> (Flag (Maybe Int) -> flags -> flags) -> OptionField flags
optionNumJobs
          BuildFlags -> Flag (Maybe Int)
buildNumJobs
          (\Flag (Maybe Int)
v BuildFlags
flags -> BuildFlags
flags{buildNumJobs = v})
      , String
-> [String]
-> String
-> (BuildFlags -> Flag String)
-> (Flag String -> BuildFlags -> BuildFlags)
-> MkOptDescr
     (BuildFlags -> Flag String)
     (Flag String -> BuildFlags -> BuildFlags)
     BuildFlags
-> OptionField BuildFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
          []
          [String
"semaphore"]
          String
"semaphore"
          BuildFlags -> Flag String
buildUseSemaphore
          (\Flag String
v BuildFlags
flags -> BuildFlags
flags{buildUseSemaphore = v})
          (String
-> (String -> Flag String)
-> (Flag String -> [String])
-> MkOptDescr
     (BuildFlags -> Flag String)
     (Flag String -> BuildFlags -> BuildFlags)
     BuildFlags
forall b a.
Monoid b =>
String
-> (String -> b)
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg' String
"SEMAPHORE" String -> Flag String
forall a. a -> Flag a
Flag Flag String -> [String]
forall a. Flag a -> [a]
flagToList)
      ]
    )
    [OptionField BuildFlags]
-> [OptionField BuildFlags] -> [OptionField BuildFlags]
forall a. [a] -> [a] -> [a]
++ ProgramDb
-> ShowOrParseArgs
-> (BuildFlags -> [(String, String)])
-> ([(String, String)] -> BuildFlags -> BuildFlags)
-> [OptionField BuildFlags]
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, String)])
-> ([(String, String)] -> flags -> flags)
-> [OptionField flags]
programDbPaths
      ProgramDb
progDb
      ShowOrParseArgs
showOrParseArgs
      BuildFlags -> [(String, String)]
buildProgramPaths
      (\[(String, String)]
v BuildFlags
flags -> BuildFlags
flags{buildProgramPaths = v})
    [OptionField BuildFlags]
-> [OptionField BuildFlags] -> [OptionField BuildFlags]
forall a. [a] -> [a] -> [a]
++ ProgramDb
-> ShowOrParseArgs
-> (BuildFlags -> [(String, [String])])
-> ([(String, [String])] -> BuildFlags -> BuildFlags)
-> [OptionField BuildFlags]
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOption
      ProgramDb
progDb
      ShowOrParseArgs
showOrParseArgs
      BuildFlags -> [(String, [String])]
buildProgramArgs
      (\[(String, [String])]
v BuildFlags
fs -> BuildFlags
fs{buildProgramArgs = v})
    [OptionField BuildFlags]
-> [OptionField BuildFlags] -> [OptionField BuildFlags]
forall a. [a] -> [a] -> [a]
++ ProgramDb
-> ShowOrParseArgs
-> (BuildFlags -> [(String, [String])])
-> ([(String, [String])] -> BuildFlags -> BuildFlags)
-> [OptionField BuildFlags]
forall flags.
ProgramDb
-> ShowOrParseArgs
-> (flags -> [(String, [String])])
-> ([(String, [String])] -> flags -> flags)
-> [OptionField flags]
programDbOptions
      ProgramDb
progDb
      ShowOrParseArgs
showOrParseArgs
      BuildFlags -> [(String, [String])]
buildProgramArgs
      (\[(String, [String])]
v BuildFlags
flags -> BuildFlags
flags{buildProgramArgs = v})

emptyBuildFlags :: BuildFlags
emptyBuildFlags :: BuildFlags
emptyBuildFlags = BuildFlags
forall a. Monoid a => a
mempty

instance Monoid BuildFlags where
  mempty :: BuildFlags
mempty = BuildFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: BuildFlags -> BuildFlags -> BuildFlags
mappend = BuildFlags -> BuildFlags -> BuildFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup BuildFlags where
  <> :: BuildFlags -> BuildFlags -> BuildFlags
(<>) = BuildFlags -> BuildFlags -> BuildFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend