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
(Int -> WithoutProjectTargetSelector -> ShowS)
-> (WithoutProjectTargetSelector -> String)
-> ([WithoutProjectTargetSelector] -> ShowS)
-> Show WithoutProjectTargetSelector
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 ParsecParser WithoutProjectTargetSelector
-> String -> Either String WithoutProjectTargetSelector
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser WithoutProjectTargetSelector
forall (m :: * -> *).
CabalParsing m =>
m WithoutProjectTargetSelector
parser String
input of
        Right WithoutProjectTargetSelector
ts -> WithoutProjectTargetSelector -> IO WithoutProjectTargetSelector
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 -> WithoutProjectTargetSelector -> IO WithoutProjectTargetSelector
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> WithoutProjectTargetSelector
WoURI URI
uri)
            Maybe URI
Nothing  -> Verbosity -> String -> IO WithoutProjectTargetSelector
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO WithoutProjectTargetSelector)
-> String -> IO WithoutProjectTargetSelector
forall a b. (a -> b) -> a -> b
$ String
"Invalid package ID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
input String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
  where
    parser :: CabalParsing m => m WithoutProjectTargetSelector
    parser :: m WithoutProjectTargetSelector
parser = do
        PackageId
pid <- m PackageId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
        Maybe UnqualComponentName
cn  <- m UnqualComponentName -> m (Maybe UnqualComponentName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
':' m Char -> m UnqualComponentName -> m UnqualComponentName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m UnqualComponentName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec)
        WithoutProjectTargetSelector -> m WithoutProjectTargetSelector
forall (m :: * -> *) a. Monad m => a -> m a
return (WithoutProjectTargetSelector -> m WithoutProjectTargetSelector)
-> WithoutProjectTargetSelector -> m WithoutProjectTargetSelector
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) Maybe ComponentKindFilter
forall a. Maybe a
Nothing
woPackageTargets (WoPackageComponent PackageId
pid ComponentName
cn) =
    PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown (PackageId -> PackageName
pkgName PackageId
pid) (ComponentName -> Either UnqualComponentName ComponentName
forall a b. b -> Either a b
Right ComponentName
cn) SubComponentTarget
WholeComponent
woPackageTargets (WoURI URI
_) =
    Maybe ComponentKindFilter -> TargetSelector
TargetAllPackages (ComponentKindFilter -> Maybe ComponentKindFilter
forall a. a -> Maybe a
Just ComponentKindFilter
ExeKind)

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

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