{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Setup
( GlobalFlags (..)
, emptyGlobalFlags
, defaultGlobalFlags
, globalCommand
, ConfigFlags (..)
, emptyConfigFlags
, defaultConfigFlags
, configureCommand
, configPrograms
, configAbsolutePaths
, readPackageDb
, readPackageDbList
, showPackageDb
, showPackageDbList
, CopyFlags (..)
, emptyCopyFlags
, defaultCopyFlags
, copyCommand
, InstallFlags (..)
, emptyInstallFlags
, defaultInstallFlags
, installCommand
, HaddockTarget (..)
, HaddockFlags (..)
, emptyHaddockFlags
, defaultHaddockFlags
, haddockCommand
, Visibility (..)
, HaddockProjectFlags (..)
, emptyHaddockProjectFlags
, defaultHaddockProjectFlags
, haddockProjectCommand
, HscolourFlags (..)
, emptyHscolourFlags
, defaultHscolourFlags
, hscolourCommand
, BuildFlags (..)
, emptyBuildFlags
, defaultBuildFlags
, buildCommand
, DumpBuildInfo (..)
, ReplFlags (..)
, defaultReplFlags
, replCommand
, ReplOptions (..)
, CleanFlags (..)
, emptyCleanFlags
, defaultCleanFlags
, cleanCommand
, RegisterFlags (..)
, emptyRegisterFlags
, defaultRegisterFlags
, registerCommand
, unregisterCommand
, SDistFlags (..)
, emptySDistFlags
, defaultSDistFlags
, sdistCommand
, TestFlags (..)
, emptyTestFlags
, defaultTestFlags
, testCommand
, TestShowDetails (..)
, BenchmarkFlags (..)
, emptyBenchmarkFlags
, defaultBenchmarkFlags
, benchmarkCommand
, CopyDest (..)
, configureArgs
, configureOptions
, configureCCompiler
, configureLinker
, buildOptions
, haddockOptions
, haddockProjectOptions
, installDirsOptions
, testOptions'
, benchmarkOptions'
, programDbOptions
, programDbPaths'
, programFlagsDescription
, replOptions
, splitArgs
, defaultDistPref
, optionDistPref
, Flag (..)
, toFlag
, fromFlag
, fromFlagOrDefault
, flagToMaybe
, flagToList
, maybeToFlag
, BooleanFlag (..)
, boolOpt
, boolOpt'
, trueArg
, falseArg
, optionVerbosity
, BuildingWhat (..)
, buildingWhatVerbosity
, buildingWhatDistPref
) where
import GHC.Generics (Generic)
import Prelude (FilePath, Show, ($))
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
import Distribution.Types.DumpBuildInfo
import Distribution.Simple.Setup.Benchmark
import Distribution.Simple.Setup.Build
import Distribution.Simple.Setup.Clean
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Copy
import Distribution.Simple.Setup.Global
import Distribution.Simple.Setup.Haddock
import Distribution.Simple.Setup.Hscolour
import Distribution.Simple.Setup.Install
import Distribution.Simple.Setup.Register
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Setup.Test
import Distribution.Verbosity (Verbosity)
data BuildingWhat
=
BuildNormal BuildFlags
|
BuildRepl ReplFlags
|
BuildHaddock HaddockFlags
|
BuildHscolour HscolourFlags
deriving ((forall x. BuildingWhat -> Rep BuildingWhat x)
-> (forall x. Rep BuildingWhat x -> BuildingWhat)
-> Generic BuildingWhat
forall x. Rep BuildingWhat x -> BuildingWhat
forall x. BuildingWhat -> Rep BuildingWhat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildingWhat -> Rep BuildingWhat x
from :: forall x. BuildingWhat -> Rep BuildingWhat x
$cto :: forall x. Rep BuildingWhat x -> BuildingWhat
to :: forall x. Rep BuildingWhat x -> BuildingWhat
Generic, Int -> BuildingWhat -> ShowS
[BuildingWhat] -> ShowS
BuildingWhat -> String
(Int -> BuildingWhat -> ShowS)
-> (BuildingWhat -> String)
-> ([BuildingWhat] -> ShowS)
-> Show BuildingWhat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildingWhat -> ShowS
showsPrec :: Int -> BuildingWhat -> ShowS
$cshow :: BuildingWhat -> String
show :: BuildingWhat -> String
$cshowList :: [BuildingWhat] -> ShowS
showList :: [BuildingWhat] -> ShowS
Show)
buildingWhatVerbosity :: BuildingWhat -> Verbosity
buildingWhatVerbosity :: BuildingWhat -> Verbosity
buildingWhatVerbosity = \case
BuildNormal BuildFlags
flags -> Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
BuildRepl ReplFlags
flags -> Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags
BuildHaddock HaddockFlags
flags -> Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag Verbosity
haddockVerbosity HaddockFlags
flags
BuildHscolour HscolourFlags
flags -> Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ HscolourFlags -> Flag Verbosity
hscolourVerbosity HscolourFlags
flags
buildingWhatDistPref :: BuildingWhat -> FilePath
buildingWhatDistPref :: BuildingWhat -> String
buildingWhatDistPref = \case
BuildNormal BuildFlags
flags -> Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag String -> String) -> Flag String -> String
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag String
buildDistPref BuildFlags
flags
BuildRepl ReplFlags
flags -> Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag String -> String) -> Flag String -> String
forall a b. (a -> b) -> a -> b
$ ReplFlags -> Flag String
replDistPref ReplFlags
flags
BuildHaddock HaddockFlags
flags -> Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag String -> String) -> Flag String -> String
forall a b. (a -> b) -> a -> b
$ HaddockFlags -> Flag String
haddockDistPref HaddockFlags
flags
BuildHscolour HscolourFlags
flags -> Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag String -> String) -> Flag String -> String
forall a b. (a -> b) -> a -> b
$ HscolourFlags -> Flag String
hscolourDistPref HscolourFlags
flags