{-# LANGUAGE DeriveFunctor #-}
module Distribution.Client.TargetProblem (
    TargetProblem(..),
    TargetProblem',
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.ProjectPlanning    (AvailableTarget)
import Distribution.Client.TargetSelector     (SubComponentTarget, TargetSelector)
import Distribution.Package                   (PackageId, PackageName)
import Distribution.Simple.LocalBuildInfo     (ComponentName (..))
import Distribution.Types.UnqualComponentName (UnqualComponentName)

-- | Target problems that occur during project orchestration.
data TargetProblem a
    = TargetNotInProject                   PackageName
    | TargetAvailableInIndex               PackageName

    | TargetComponentNotProjectLocal
      PackageId ComponentName SubComponentTarget

    | TargetComponentNotBuildable
      PackageId ComponentName SubComponentTarget

    | TargetOptionalStanzaDisabledByUser
      PackageId ComponentName SubComponentTarget

    | TargetOptionalStanzaDisabledBySolver
      PackageId ComponentName SubComponentTarget

    | TargetProblemUnknownComponent
      PackageName (Either UnqualComponentName ComponentName)

    | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
      -- ^ The 'TargetSelector' matches component (test/benchmark/...) but none are buildable

    | TargetProblemNoTargets TargetSelector
      -- ^ There are no targets at all

    -- The target matching stuff only returns packages local to the project,
    -- so these lookups should never fail, but if 'resolveTargets' is called
    -- directly then of course it can.
    | TargetProblemNoSuchPackage           PackageId
    | TargetProblemNoSuchComponent         PackageId ComponentName

      -- | A custom target problem
    | CustomTargetProblem a
  deriving (TargetProblem a -> TargetProblem a -> Bool
(TargetProblem a -> TargetProblem a -> Bool)
-> (TargetProblem a -> TargetProblem a -> Bool)
-> Eq (TargetProblem a)
forall a. Eq a => TargetProblem a -> TargetProblem a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetProblem a -> TargetProblem a -> Bool
$c/= :: forall a. Eq a => TargetProblem a -> TargetProblem a -> Bool
== :: TargetProblem a -> TargetProblem a -> Bool
$c== :: forall a. Eq a => TargetProblem a -> TargetProblem a -> Bool
Eq, Int -> TargetProblem a -> ShowS
[TargetProblem a] -> ShowS
TargetProblem a -> String
(Int -> TargetProblem a -> ShowS)
-> (TargetProblem a -> String)
-> ([TargetProblem a] -> ShowS)
-> Show (TargetProblem a)
forall a. Show a => Int -> TargetProblem a -> ShowS
forall a. Show a => [TargetProblem a] -> ShowS
forall a. Show a => TargetProblem a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetProblem a] -> ShowS
$cshowList :: forall a. Show a => [TargetProblem a] -> ShowS
show :: TargetProblem a -> String
$cshow :: forall a. Show a => TargetProblem a -> String
showsPrec :: Int -> TargetProblem a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TargetProblem a -> ShowS
Show, a -> TargetProblem b -> TargetProblem a
(a -> b) -> TargetProblem a -> TargetProblem b
(forall a b. (a -> b) -> TargetProblem a -> TargetProblem b)
-> (forall a b. a -> TargetProblem b -> TargetProblem a)
-> Functor TargetProblem
forall a b. a -> TargetProblem b -> TargetProblem a
forall a b. (a -> b) -> TargetProblem a -> TargetProblem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TargetProblem b -> TargetProblem a
$c<$ :: forall a b. a -> TargetProblem b -> TargetProblem a
fmap :: (a -> b) -> TargetProblem a -> TargetProblem b
$cfmap :: forall a b. (a -> b) -> TargetProblem a -> TargetProblem b
Functor)

-- | Type alias for a 'TargetProblem' with no user-defined problems/errors.
--
-- Can use the utilities below for reporting/rendering problems.
type TargetProblem' = TargetProblem Void