{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.ComponentRequestedSpec (
    -- $buildable_vs_enabled_components

    ComponentRequestedSpec(..),
    ComponentDisabledReason(..),

    defaultComponentRequestedSpec,
    componentNameRequested,

    componentEnabled,
    componentDisabledReason,
) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.Component -- TODO: maybe remove me?
import Distribution.Types.ComponentName

import Distribution.Pretty (prettyShow)

-- $buildable_vs_enabled_components
-- #buildable_vs_enabled_components#
--
-- = Note: Buildable versus requested versus enabled components
-- What's the difference between a buildable component (ala
-- 'componentBuildable'), a requested component
-- (ala 'componentNameRequested'), and an enabled component (ala
-- 'componentEnabled')?
--
-- A component is __buildable__ if, after resolving flags and
-- conditionals, there is no @buildable: False@ property in it.
-- This is a /static/ property that arises from the
-- Cabal file and the package description flattening; once we have
-- a 'PackageDescription' buildability is known.
--
-- A component is __requested__ if a user specified, via a
-- the flags and arguments passed to configure, that it should be
-- built.  E.g., @--enable-tests@ or @--enable-benchmarks@ request
-- all tests and benchmarks, if they are provided.  What is requested
-- can be read off directly from 'ComponentRequestedSpec'.  A requested
-- component is not always buildable; e.g., a user may @--enable-tests@
-- but one of the test suites may have @buildable: False@.
--
-- A component is __enabled__ if it is BOTH buildable
-- and requested.  Once we have a 'LocalBuildInfo', whether or not a
-- component is enabled is known.
--
-- Generally speaking, most Cabal API code cares if a component
-- is enabled. (For example, if you want to run a preprocessor on each
-- component prior to building them, you want to run this on each
-- /enabled/ component.)
--
-- Note that post-configuration, you will generally not see a
-- non-buildable 'Component'.  This is because 'flattenPD' will drop
-- any such components from 'PackageDescription'.  See #3858 for
-- an example where this causes problems.

-- | Describes what components are enabled by user-interaction.
-- See also this note in
-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components".
--
-- @since 2.0.0.2
data ComponentRequestedSpec
    = ComponentRequestedSpec { ComponentRequestedSpec -> Bool
testsRequested      :: Bool
                             , ComponentRequestedSpec -> Bool
benchmarksRequested :: Bool }
    | OneComponentRequestedSpec ComponentName
  deriving ((forall x. ComponentRequestedSpec -> Rep ComponentRequestedSpec x)
-> (forall x.
    Rep ComponentRequestedSpec x -> ComponentRequestedSpec)
-> Generic ComponentRequestedSpec
forall x. Rep ComponentRequestedSpec x -> ComponentRequestedSpec
forall x. ComponentRequestedSpec -> Rep ComponentRequestedSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentRequestedSpec x -> ComponentRequestedSpec
$cfrom :: forall x. ComponentRequestedSpec -> Rep ComponentRequestedSpec x
Generic, ReadPrec [ComponentRequestedSpec]
ReadPrec ComponentRequestedSpec
Int -> ReadS ComponentRequestedSpec
ReadS [ComponentRequestedSpec]
(Int -> ReadS ComponentRequestedSpec)
-> ReadS [ComponentRequestedSpec]
-> ReadPrec ComponentRequestedSpec
-> ReadPrec [ComponentRequestedSpec]
-> Read ComponentRequestedSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentRequestedSpec]
$creadListPrec :: ReadPrec [ComponentRequestedSpec]
readPrec :: ReadPrec ComponentRequestedSpec
$creadPrec :: ReadPrec ComponentRequestedSpec
readList :: ReadS [ComponentRequestedSpec]
$creadList :: ReadS [ComponentRequestedSpec]
readsPrec :: Int -> ReadS ComponentRequestedSpec
$creadsPrec :: Int -> ReadS ComponentRequestedSpec
External instance of the constraint type Read ComponentName
External instance of the constraint type Read Bool
External instance of the constraint type Read Bool
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ComponentRequestedSpec
Read, Int -> ComponentRequestedSpec -> ShowS
[ComponentRequestedSpec] -> ShowS
ComponentRequestedSpec -> String
(Int -> ComponentRequestedSpec -> ShowS)
-> (ComponentRequestedSpec -> String)
-> ([ComponentRequestedSpec] -> ShowS)
-> Show ComponentRequestedSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentRequestedSpec] -> ShowS
$cshowList :: [ComponentRequestedSpec] -> ShowS
show :: ComponentRequestedSpec -> String
$cshow :: ComponentRequestedSpec -> String
showsPrec :: Int -> ComponentRequestedSpec -> ShowS
$cshowsPrec :: Int -> ComponentRequestedSpec -> ShowS
External instance of the constraint type Show ComponentName
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show, ComponentRequestedSpec -> ComponentRequestedSpec -> Bool
(ComponentRequestedSpec -> ComponentRequestedSpec -> Bool)
-> (ComponentRequestedSpec -> ComponentRequestedSpec -> Bool)
-> Eq ComponentRequestedSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentRequestedSpec -> ComponentRequestedSpec -> Bool
$c/= :: ComponentRequestedSpec -> ComponentRequestedSpec -> Bool
== :: ComponentRequestedSpec -> ComponentRequestedSpec -> Bool
$c== :: ComponentRequestedSpec -> ComponentRequestedSpec -> Bool
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Bool
External instance of the constraint type Eq ComponentName
Eq, Typeable)

instance Binary ComponentRequestedSpec
instance Structured ComponentRequestedSpec

-- | The default set of enabled components.  Historically tests and
-- benchmarks are NOT enabled by default.
--
-- @since 2.0.0.2
defaultComponentRequestedSpec :: ComponentRequestedSpec
defaultComponentRequestedSpec :: ComponentRequestedSpec
defaultComponentRequestedSpec = Bool -> Bool -> ComponentRequestedSpec
ComponentRequestedSpec Bool
False Bool
False

-- | Is this component enabled?  See also this note in
-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components".
--
-- @since 2.0.0.2
componentEnabled :: ComponentRequestedSpec -> Component -> Bool
componentEnabled :: ComponentRequestedSpec -> Component -> Bool
componentEnabled ComponentRequestedSpec
enabled = Maybe ComponentDisabledReason -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ComponentDisabledReason -> Bool)
-> (Component -> Maybe ComponentDisabledReason)
-> Component
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentRequestedSpec
-> Component -> Maybe ComponentDisabledReason
componentDisabledReason ComponentRequestedSpec
enabled

-- | Is this component name enabled?  See also this note in
-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components".
--
-- @since 2.0.0.2
componentNameRequested :: ComponentRequestedSpec -> ComponentName -> Bool
componentNameRequested :: ComponentRequestedSpec -> ComponentName -> Bool
componentNameRequested ComponentRequestedSpec
enabled = Maybe ComponentDisabledReason -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ComponentDisabledReason -> Bool)
-> (ComponentName -> Maybe ComponentDisabledReason)
-> ComponentName
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentRequestedSpec
-> ComponentName -> Maybe ComponentDisabledReason
componentNameNotRequestedReason ComponentRequestedSpec
enabled

-- | Is this component disabled, and if so, why?
--
-- @since 2.0.0.2
componentDisabledReason :: ComponentRequestedSpec -> Component
                        -> Maybe ComponentDisabledReason
componentDisabledReason :: ComponentRequestedSpec
-> Component -> Maybe ComponentDisabledReason
componentDisabledReason ComponentRequestedSpec
enabled Component
comp
    | Bool -> Bool
not (Component -> Bool
componentBuildable Component
comp) = ComponentDisabledReason -> Maybe ComponentDisabledReason
forall a. a -> Maybe a
Just ComponentDisabledReason
DisabledComponent
    | Bool
otherwise = ComponentRequestedSpec
-> ComponentName -> Maybe ComponentDisabledReason
componentNameNotRequestedReason ComponentRequestedSpec
enabled (Component -> ComponentName
componentName Component
comp)

-- | Is this component name disabled, and if so, why?
--
-- @since 2.0.0.2
componentNameNotRequestedReason :: ComponentRequestedSpec -> ComponentName
                            -> Maybe ComponentDisabledReason
componentNameNotRequestedReason :: ComponentRequestedSpec
-> ComponentName -> Maybe ComponentDisabledReason
componentNameNotRequestedReason
    ComponentRequestedSpec{ testsRequested :: ComponentRequestedSpec -> Bool
testsRequested      = Bool
False } (CTestName UnqualComponentName
_)
    = ComponentDisabledReason -> Maybe ComponentDisabledReason
forall a. a -> Maybe a
Just ComponentDisabledReason
DisabledAllTests
componentNameNotRequestedReason
    ComponentRequestedSpec{ benchmarksRequested :: ComponentRequestedSpec -> Bool
benchmarksRequested = Bool
False } (CBenchName UnqualComponentName
_)
    = ComponentDisabledReason -> Maybe ComponentDisabledReason
forall a. a -> Maybe a
Just ComponentDisabledReason
DisabledAllBenchmarks
componentNameNotRequestedReason ComponentRequestedSpec{} ComponentName
_ = Maybe ComponentDisabledReason
forall a. Maybe a
Nothing
componentNameNotRequestedReason (OneComponentRequestedSpec ComponentName
cname) ComponentName
c
    | ComponentName
c ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ComponentName
== ComponentName
cname = Maybe ComponentDisabledReason
forall a. Maybe a
Nothing
    | Bool
otherwise = ComponentDisabledReason -> Maybe ComponentDisabledReason
forall a. a -> Maybe a
Just (String -> ComponentDisabledReason
DisabledAllButOne (ComponentName -> String
forall a. Pretty a => a -> String
External instance of the constraint type Pretty ComponentName
prettyShow ComponentName
cname))

-- | A reason explaining why a component is disabled.
--
-- @since 2.0.0.2
data ComponentDisabledReason = DisabledComponent
                             | DisabledAllTests
                             | DisabledAllBenchmarks
                             | DisabledAllButOne String