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.Errors
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 (dieWithException)

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
$cshowsPrec :: Int -> WithoutProjectTargetSelector -> ShowS
showsPrec :: Int -> WithoutProjectTargetSelector -> ShowS
$cshow :: WithoutProjectTargetSelector -> String
show :: WithoutProjectTargetSelector -> String
$cshowList :: [WithoutProjectTargetSelector] -> ShowS
showList :: [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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> WithoutProjectTargetSelector
WoURI URI
uri)
      Maybe URI
Nothing -> Verbosity
-> CabalInstallException -> IO WithoutProjectTargetSelector
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO WithoutProjectTargetSelector)
-> CabalInstallException -> IO WithoutProjectTargetSelector
forall a b. (a -> b) -> a -> b
$ String -> String -> CabalInstallException
ProjectTargetSelector String
input String
err
  where
    parser :: CabalParsing m => m WithoutProjectTargetSelector
    parser :: forall (m :: * -> *).
CabalParsing m =>
m WithoutProjectTargetSelector
parser = do
      PackageId
pid <- m PackageId
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m PackageId
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 a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m UnqualComponentName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m UnqualComponentName
parsec)
      WithoutProjectTargetSelector -> m WithoutProjectTargetSelector
forall a. a -> m a
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 :: forall pkg.
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
mkNamedPackage 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
mkNamedPackage PackageId
pid)
woPackageSpecifiers (WoURI URI
uri) = URI -> Either URI (PackageSpecifier pkg)
forall a b. a -> Either a b
Left URI
uri