{-# 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)
  | -- | The 'TargetSelector' matches component (test/benchmark/...) but none are buildable
    TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
  | -- | There are no targets at all
    TargetProblemNoTargets TargetSelector
  | -- 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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> TargetProblem a -> ShowS
showsPrec :: Int -> TargetProblem a -> ShowS
$cshow :: forall a. Show a => TargetProblem a -> String
show :: TargetProblem a -> String
$cshowList :: forall a. Show a => [TargetProblem a] -> ShowS
showList :: [TargetProblem a] -> ShowS
Show, (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
$cfmap :: forall a b. (a -> b) -> TargetProblem a -> TargetProblem b
fmap :: forall a b. (a -> b) -> TargetProblem a -> TargetProblem b
$c<$ :: forall a b. a -> TargetProblem b -> TargetProblem a
<$ :: forall a b. a -> TargetProblem b -> TargetProblem a
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