module Distribution.Client.CmdInstall.ClientInstallTargetSelector (
    WithoutProjectTargetSelector (..),
    parseWithoutProjectTargetSelector,
    woPackageNames,
    woPackageTargets,
    woPackageSpecifiers,
    ) where

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

import Network.URI (URI, parseURI)

import Distribution.Client.TargetSelector
import Distribution.Client.Types
import Distribution.Compat.CharParsing             (char, optional)
import Distribution.Package
import Distribution.Simple.LocalBuildInfo          (ComponentName (CExeName))
import Distribution.Simple.Utils                   (die')
import Distribution.Solver.Types.PackageConstraint (PackageProperty (..))
import Distribution.Version

data WithoutProjectTargetSelector
    = WoPackageId PackageId
    | WoPackageComponent PackageId ComponentName
    | WoURI URI
  deriving (Int -> WithoutProjectTargetSelector -> ShowS
[WithoutProjectTargetSelector] -> ShowS
WithoutProjectTargetSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithoutProjectTargetSelector] -> ShowS
$cshowList :: [WithoutProjectTargetSelector] -> ShowS
show :: WithoutProjectTargetSelector -> String
$cshow :: WithoutProjectTargetSelector -> String
showsPrec :: Int -> WithoutProjectTargetSelector -> ShowS
$cshowsPrec :: Int -> WithoutProjectTargetSelector -> ShowS
Show)

parseWithoutProjectTargetSelector :: Verbosity -> String -> IO WithoutProjectTargetSelector
parseWithoutProjectTargetSelector :: Verbosity -> String -> IO WithoutProjectTargetSelector
parseWithoutProjectTargetSelector Verbosity
verbosity String
input =
    case forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec forall (m :: * -> *).
CabalParsing m =>
m WithoutProjectTargetSelector
parser String
input of
        Right WithoutProjectTargetSelector
ts -> forall (m :: * -> *) a. Monad m => a -> m a
return WithoutProjectTargetSelector
ts
        Left String
err -> case String -> Maybe URI
parseURI String
input of
            Just URI
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> WithoutProjectTargetSelector
WoURI URI
uri)
            Maybe URI
Nothing  -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Invalid package ID: " forall a. [a] -> [a] -> [a]
++ String
input forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
err
  where
    parser :: CabalParsing m => m WithoutProjectTargetSelector
    parser :: forall (m :: * -> *).
CabalParsing m =>
m WithoutProjectTargetSelector
parser = do
        PackageId
pid <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        Maybe UnqualComponentName
cn  <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe UnqualComponentName
cn of
            Maybe UnqualComponentName
Nothing -> PackageId -> WithoutProjectTargetSelector
WoPackageId PackageId
pid
            Just UnqualComponentName
cn' -> PackageId -> ComponentName -> WithoutProjectTargetSelector
WoPackageComponent PackageId
pid (UnqualComponentName -> ComponentName
CExeName UnqualComponentName
cn')

woPackageNames  :: WithoutProjectTargetSelector -> [PackageName]
woPackageNames :: WithoutProjectTargetSelector -> [PackageName]
woPackageNames (WoPackageId PackageId
pid)          = [PackageId -> PackageName
pkgName PackageId
pid]
woPackageNames (WoPackageComponent PackageId
pid ComponentName
_) = [PackageId -> PackageName
pkgName PackageId
pid]
woPackageNames (WoURI URI
_)                  = []

woPackageTargets  :: WithoutProjectTargetSelector -> TargetSelector
woPackageTargets :: WithoutProjectTargetSelector -> TargetSelector
woPackageTargets (WoPackageId PackageId
pid) =
    PackageName -> Maybe ComponentKindFilter -> TargetSelector
TargetPackageNamed (PackageId -> PackageName
pkgName PackageId
pid) forall a. Maybe a
Nothing
woPackageTargets (WoPackageComponent PackageId
pid ComponentName
cn) =
    PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown (PackageId -> PackageName
pkgName PackageId
pid) (forall a b. b -> Either a b
Right ComponentName
cn) SubComponentTarget
WholeComponent
woPackageTargets (WoURI URI
_) =
    Maybe ComponentKindFilter -> TargetSelector
TargetAllPackages (forall a. a -> Maybe a
Just ComponentKindFilter
ExeKind)

woPackageSpecifiers  :: WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg)
woPackageSpecifiers :: forall pkg.
WithoutProjectTargetSelector -> Either URI (PackageSpecifier pkg)
woPackageSpecifiers (WoPackageId PackageId
pid)          = forall a b. b -> Either a b
Right (forall pkg. PackageId -> PackageSpecifier pkg
pidPackageSpecifiers PackageId
pid)
woPackageSpecifiers (WoPackageComponent PackageId
pid ComponentName
_) = forall a b. b -> Either a b
Right (forall pkg. PackageId -> PackageSpecifier pkg
pidPackageSpecifiers PackageId
pid)
woPackageSpecifiers (WoURI URI
uri)                = forall a b. a -> Either a b
Left URI
uri

pidPackageSpecifiers :: PackageId -> PackageSpecifier pkg
pidPackageSpecifiers :: forall pkg. PackageId -> PackageSpecifier pkg
pidPackageSpecifiers PackageId
pid
    | PackageId -> Version
pkgVersion PackageId
pid forall a. Eq a => a -> a -> Bool
== Version
nullVersion = forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage (PackageId -> PackageName
pkgName PackageId
pid) []
    | Bool
otherwise                     = forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage (PackageId -> PackageName
pkgName PackageId
pid)
        [ VersionRange -> PackageProperty
PackagePropertyVersion (Version -> VersionRange
thisVersion (PackageId -> Version
pkgVersion PackageId
pid))
        ]