{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE OverloadedRecordDot   #-}

-- | Configuration options for building.

module Stack.Types.BuildOpts
  ( BuildOpts (..)
  , HaddockOpts (..)
  , TestOpts (..)
  , BenchmarkOpts (..)
  , buildOptsHaddockL
  , buildOptsInstallExesL
  ) where

import           Stack.Prelude
import           Stack.Types.BuildOptsMonoid
                   ( CabalVerbosity (..), ProgressBarFormat (..) )

-- | Build options that is interpreted by the build command. This is built up

-- from BuildOptsCLI and BuildOptsMonoid

data BuildOpts = BuildOpts
  { BuildOpts -> Bool
libProfile :: !Bool
  , BuildOpts -> Bool
exeProfile :: !Bool
  , BuildOpts -> Bool
libStrip :: !Bool
  , BuildOpts -> Bool
exeStrip :: !Bool
  , BuildOpts -> Bool
buildHaddocks :: !Bool
    -- ^ Build Haddock documentation?

  , BuildOpts -> HaddockOpts
haddockOpts :: !HaddockOpts
    -- ^ Options to pass to haddock

  , BuildOpts -> Bool
openHaddocks :: !Bool
    -- ^ Open haddocks in the browser?

  , BuildOpts -> Maybe Bool
haddockDeps :: !(Maybe Bool)
    -- ^ Build haddocks for dependencies?

  , BuildOpts -> Bool
haddockInternal :: !Bool
    -- ^ Build haddocks for all symbols and packages, like

    -- @cabal haddock --internal@

  , BuildOpts -> Bool
haddockHyperlinkSource :: !Bool
    -- ^ Build hyperlinked source. Disable for no sources.

  , BuildOpts -> Bool
haddockForHackage :: !Bool
    -- ^ Build with flags to generate Haddock documentation suitable to upload

    -- to Hackage.

  , BuildOpts -> Bool
installExes :: !Bool
    -- ^ Install executables to user path after building?

  , BuildOpts -> Bool
installCompilerTool :: !Bool
    -- ^ Install executables to compiler tools path after building?

  , BuildOpts -> Bool
preFetch :: !Bool
    -- ^ Fetch all packages immediately

    -- ^ Watch files for changes and automatically rebuild

  , BuildOpts -> Maybe Bool
keepGoing :: !(Maybe Bool)
    -- ^ Keep building/running after failure

  , BuildOpts -> Bool
keepTmpFiles :: !Bool
    -- ^ Keep intermediate files and build directories

  , BuildOpts -> Bool
forceDirty :: !Bool
    -- ^ Force treating all local packages as having dirty files

  , BuildOpts -> Bool
tests :: !Bool
    -- ^ Turn on tests for local targets

  , BuildOpts -> TestOpts
testOpts :: !TestOpts
    -- ^ Additional test arguments

  , BuildOpts -> Bool
benchmarks :: !Bool
    -- ^ Turn on benchmarks for local targets

  , BuildOpts -> BenchmarkOpts
benchmarkOpts :: !BenchmarkOpts
    -- ^ Additional test arguments

    -- ^ Commands (with arguments) to run after a successful build

    -- ^ Only perform the configure step when building

  , BuildOpts -> Bool
reconfigure :: !Bool
    -- ^ Perform the configure step even if already configured

  , BuildOpts -> CabalVerbosity
cabalVerbose :: !CabalVerbosity
    -- ^ Ask Cabal to be verbose in its builds

  , BuildOpts -> Bool
splitObjs :: !Bool
    -- ^ Whether to enable split-objs.

  , BuildOpts -> [Text]
skipComponents :: ![Text]
    -- ^ Which components to skip when building

  , BuildOpts -> Bool
interleavedOutput :: !Bool
    -- ^ Should we use the interleaved GHC output when building

    -- multiple packages?

  , BuildOpts -> ProgressBarFormat
progressBar :: !ProgressBarFormat
    -- ^ Format of the progress bar

  , BuildOpts -> Maybe Text
ddumpDir :: !(Maybe Text)
  }
  deriving Int -> BuildOpts -> ShowS
[BuildOpts] -> ShowS
BuildOpts -> String
(Int -> BuildOpts -> ShowS)
-> (BuildOpts -> String)
-> ([BuildOpts] -> ShowS)
-> Show BuildOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildOpts -> ShowS
showsPrec :: Int -> BuildOpts -> ShowS
$cshow :: BuildOpts -> String
show :: BuildOpts -> String
$cshowList :: [BuildOpts] -> ShowS
showList :: [BuildOpts] -> ShowS
Show

-- | Haddock Options

newtype HaddockOpts = HaddockOpts
  { HaddockOpts -> [String]
additionalArgs :: [String] -- ^ Arguments passed to haddock program

  }
  deriving (HaddockOpts -> HaddockOpts -> Bool
(HaddockOpts -> HaddockOpts -> Bool)
-> (HaddockOpts -> HaddockOpts -> Bool) -> Eq HaddockOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HaddockOpts -> HaddockOpts -> Bool
== :: HaddockOpts -> HaddockOpts -> Bool
$c/= :: HaddockOpts -> HaddockOpts -> Bool
/= :: HaddockOpts -> HaddockOpts -> Bool
Eq, Int -> HaddockOpts -> ShowS
[HaddockOpts] -> ShowS
HaddockOpts -> String
(Int -> HaddockOpts -> ShowS)
-> (HaddockOpts -> String)
-> ([HaddockOpts] -> ShowS)
-> Show HaddockOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HaddockOpts -> ShowS
showsPrec :: Int -> HaddockOpts -> ShowS
$cshow :: HaddockOpts -> String
show :: HaddockOpts -> String
$cshowList :: [HaddockOpts] -> ShowS
showList :: [HaddockOpts] -> ShowS
Show)

-- | Options for the 'FinalAction' 'DoTests'

data TestOpts = TestOpts
  { TestOpts -> Bool
rerunTests :: !Bool -- ^ Whether successful tests will be run gain

  , TestOpts -> [String]
additionalArgs :: ![String] -- ^ Arguments passed to the test program

  , TestOpts -> Bool
coverage :: !Bool -- ^ Generate a code coverage report

  , TestOpts -> Bool
disableRun :: !Bool -- ^ Disable running of tests

  , TestOpts -> Maybe Int
maximumTimeSeconds :: !(Maybe Int) -- ^ test suite timeout in seconds

  , TestOpts -> Bool
allowStdin :: !Bool -- ^ Whether to allow standard input

  }
  deriving (TestOpts -> TestOpts -> Bool
(TestOpts -> TestOpts -> Bool)
-> (TestOpts -> TestOpts -> Bool) -> Eq TestOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestOpts -> TestOpts -> Bool
== :: TestOpts -> TestOpts -> Bool
$c/= :: TestOpts -> TestOpts -> Bool
/= :: TestOpts -> TestOpts -> Bool
Eq, Int -> TestOpts -> ShowS
[TestOpts] -> ShowS
TestOpts -> String
(Int -> TestOpts -> ShowS)
-> (TestOpts -> String) -> ([TestOpts] -> ShowS) -> Show TestOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestOpts -> ShowS
showsPrec :: Int -> TestOpts -> ShowS
$cshow :: TestOpts -> String
show :: TestOpts -> String
$cshowList :: [TestOpts] -> ShowS
showList :: [TestOpts] -> ShowS
Show)

-- | Options for the 'FinalAction' 'DoBenchmarks'

data BenchmarkOpts = BenchmarkOpts
  { BenchmarkOpts -> Maybe String
additionalArgs :: !(Maybe String)
    -- ^ Arguments passed to the benchmark program

  , BenchmarkOpts -> Bool
disableRun :: !Bool
    -- ^ Disable running of benchmarks

  }
  deriving (BenchmarkOpts -> BenchmarkOpts -> Bool
(BenchmarkOpts -> BenchmarkOpts -> Bool)
-> (BenchmarkOpts -> BenchmarkOpts -> Bool) -> Eq BenchmarkOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BenchmarkOpts -> BenchmarkOpts -> Bool
== :: BenchmarkOpts -> BenchmarkOpts -> Bool
$c/= :: BenchmarkOpts -> BenchmarkOpts -> Bool
/= :: BenchmarkOpts -> BenchmarkOpts -> Bool
Eq, Int -> BenchmarkOpts -> ShowS
[BenchmarkOpts] -> ShowS
BenchmarkOpts -> String
(Int -> BenchmarkOpts -> ShowS)
-> (BenchmarkOpts -> String)
-> ([BenchmarkOpts] -> ShowS)
-> Show BenchmarkOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BenchmarkOpts -> ShowS
showsPrec :: Int -> BenchmarkOpts -> ShowS
$cshow :: BenchmarkOpts -> String
show :: BenchmarkOpts -> String
$cshowList :: [BenchmarkOpts] -> ShowS
showList :: [BenchmarkOpts] -> ShowS
Show)

buildOptsInstallExesL :: Lens' BuildOpts Bool
buildOptsInstallExesL :: Lens' BuildOpts Bool
buildOptsInstallExesL =
  (BuildOpts -> Bool)
-> (BuildOpts -> Bool -> BuildOpts) -> Lens' BuildOpts Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.installExes) (\BuildOpts
bopts Bool
t -> BuildOpts
bopts {installExes = t})

buildOptsHaddockL :: Lens' BuildOpts Bool
buildOptsHaddockL :: Lens' BuildOpts Bool
buildOptsHaddockL =
  (BuildOpts -> Bool)
-> (BuildOpts -> Bool -> BuildOpts) -> Lens' BuildOpts Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.buildHaddocks) (\BuildOpts
bopts Bool
t -> BuildOpts
bopts {buildHaddocks = t})