{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
module Distribution.Client.Targets (
UserTarget(..),
readUserTargets,
resolveUserTargets,
UserTargetProblem(..),
readUserTarget,
reportUserTargetProblems,
expandUserTarget,
PackageTarget(..),
fetchPackageTarget,
readPackageTarget,
PackageTargetProblem(..),
reportPackageTargetProblems,
disambiguatePackageTargets,
disambiguatePackageName,
UserQualifier(..),
UserConstraintScope(..),
UserConstraint(..),
userConstraintPackageName,
readUserConstraint,
userToPackageConstraint,
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Package
( Package(..), PackageName, unPackageName, mkPackageName
, packageName )
import Distribution.Client.Types
( PackageLocation(..), ResolvedPkgLoc, UnresolvedSourcePackage
, PackageSpecifier(..) )
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackageIndex (PackageIndex)
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import Distribution.Solver.Types.SourcePackage
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.FetchUtils
import Distribution.Client.Utils ( tryFindPackageDesc )
import Distribution.Client.GlobalFlags
( RepoContext(..) )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint (..) )
import Distribution.PackageDescription
( GenericPackageDescription )
import Distribution.Types.Flag
( parsecFlagAssignmentNonEmpty )
import Distribution.Version
( isAnyVersion )
import Distribution.Simple.Utils
( die', lowercase )
import Distribution.PackageDescription.Parsec
( parseGenericPackageDescriptionMaybe )
import Distribution.Simple.PackageDescription
( readGenericPackageDescription )
import qualified Data.Map as Map
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.Client.GZipUtils as GZipUtils
import qualified Distribution.Compat.CharParsing as P
import System.FilePath
( takeExtension, dropExtension, takeDirectory, splitPath )
import System.Directory
( doesFileExist, doesDirectoryExist )
import Network.URI
( URI(..), URIAuth(..), parseAbsoluteURI )
data UserTarget =
UserTargetNamed PackageVersionConstraint
| UserTargetLocalDir FilePath
| UserTargetLocalCabalFile FilePath
| UserTargetLocalTarball FilePath
| UserTargetRemoteTarball URI
deriving (Int -> UserTarget -> ShowS
[UserTarget] -> ShowS
UserTarget -> String
(Int -> UserTarget -> ShowS)
-> (UserTarget -> String)
-> ([UserTarget] -> ShowS)
-> Show UserTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserTarget] -> ShowS
$cshowList :: [UserTarget] -> ShowS
show :: UserTarget -> String
$cshow :: UserTarget -> String
showsPrec :: Int -> UserTarget -> ShowS
$cshowsPrec :: Int -> UserTarget -> ShowS
Show,UserTarget -> UserTarget -> Bool
(UserTarget -> UserTarget -> Bool)
-> (UserTarget -> UserTarget -> Bool) -> Eq UserTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserTarget -> UserTarget -> Bool
$c/= :: UserTarget -> UserTarget -> Bool
== :: UserTarget -> UserTarget -> Bool
$c== :: UserTarget -> UserTarget -> Bool
Eq)
readUserTargets :: Verbosity -> [String] -> IO [UserTarget]
readUserTargets :: Verbosity -> [String] -> IO [UserTarget]
readUserTargets Verbosity
verbosity [String]
targetStrs = do
([UserTargetProblem]
problems, [UserTarget]
targets) <- ([Either UserTargetProblem UserTarget]
-> ([UserTargetProblem], [UserTarget]))
-> IO [Either UserTargetProblem UserTarget]
-> IO ([UserTargetProblem], [UserTarget])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Either UserTargetProblem UserTarget]
-> ([UserTargetProblem], [UserTarget])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
((String -> IO (Either UserTargetProblem UserTarget))
-> [String] -> IO [Either UserTargetProblem UserTarget]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (Either UserTargetProblem UserTarget)
readUserTarget [String]
targetStrs)
Verbosity -> [UserTargetProblem] -> IO ()
reportUserTargetProblems Verbosity
verbosity [UserTargetProblem]
problems
[UserTarget] -> IO [UserTarget]
forall (m :: * -> *) a. Monad m => a -> m a
return [UserTarget]
targets
data UserTargetProblem
= UserTargetUnexpectedFile String
| UserTargetNonexistantFile String
| UserTargetUnexpectedUriScheme String
| UserTargetUnrecognisedUri String
| UserTargetUnrecognised String
deriving Int -> UserTargetProblem -> ShowS
[UserTargetProblem] -> ShowS
UserTargetProblem -> String
(Int -> UserTargetProblem -> ShowS)
-> (UserTargetProblem -> String)
-> ([UserTargetProblem] -> ShowS)
-> Show UserTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserTargetProblem] -> ShowS
$cshowList :: [UserTargetProblem] -> ShowS
show :: UserTargetProblem -> String
$cshow :: UserTargetProblem -> String
showsPrec :: Int -> UserTargetProblem -> ShowS
$cshowsPrec :: Int -> UserTargetProblem -> ShowS
Show
readUserTarget :: String -> IO (Either UserTargetProblem UserTarget)
readUserTarget :: String -> IO (Either UserTargetProblem UserTarget)
readUserTarget String
targetstr =
case String -> Either String PackageVersionConstraint
forall a. Parsec a => String -> Either String a
eitherParsec String
targetstr of
Right PackageVersionConstraint
dep -> Either UserTargetProblem UserTarget
-> IO (Either UserTargetProblem UserTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (UserTarget -> Either UserTargetProblem UserTarget
forall a b. b -> Either a b
Right (PackageVersionConstraint -> UserTarget
UserTargetNamed PackageVersionConstraint
dep))
Left String
_err -> do
Maybe (Either UserTargetProblem UserTarget)
fileTarget <- String -> IO (Maybe (Either UserTargetProblem UserTarget))
testFileTargets String
targetstr
case Maybe (Either UserTargetProblem UserTarget)
fileTarget of
Just Either UserTargetProblem UserTarget
target -> Either UserTargetProblem UserTarget
-> IO (Either UserTargetProblem UserTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return Either UserTargetProblem UserTarget
target
Maybe (Either UserTargetProblem UserTarget)
Nothing ->
case String -> Maybe (Either UserTargetProblem UserTarget)
testUriTargets String
targetstr of
Just Either UserTargetProblem UserTarget
target -> Either UserTargetProblem UserTarget
-> IO (Either UserTargetProblem UserTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return Either UserTargetProblem UserTarget
target
Maybe (Either UserTargetProblem UserTarget)
Nothing -> Either UserTargetProblem UserTarget
-> IO (Either UserTargetProblem UserTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return (UserTargetProblem -> Either UserTargetProblem UserTarget
forall a b. a -> Either a b
Left (String -> UserTargetProblem
UserTargetUnrecognised String
targetstr))
where
testFileTargets :: FilePath -> IO (Maybe (Either UserTargetProblem UserTarget))
testFileTargets :: String -> IO (Maybe (Either UserTargetProblem UserTarget))
testFileTargets String
filename = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
filename
Bool
isFile <- String -> IO Bool
doesFileExist String
filename
Bool
parentDirExists <- case ShowS
takeDirectory String
filename of
[] -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
String
dir -> String -> IO Bool
doesDirectoryExist String
dir
let result :: Maybe (Either UserTargetProblem UserTarget)
result :: Maybe (Either UserTargetProblem UserTarget)
result
| Bool
isDir
= Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTarget -> Either UserTargetProblem UserTarget
forall a b. b -> Either a b
Right (String -> UserTarget
UserTargetLocalDir String
filename))
| Bool
isFile Bool -> Bool -> Bool
&& String -> Bool
extensionIsTarGz String
filename
= Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTarget -> Either UserTargetProblem UserTarget
forall a b. b -> Either a b
Right (String -> UserTarget
UserTargetLocalTarball String
filename))
| Bool
isFile Bool -> Bool -> Bool
&& ShowS
takeExtension String
filename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal"
= Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTarget -> Either UserTargetProblem UserTarget
forall a b. b -> Either a b
Right (String -> UserTarget
UserTargetLocalCabalFile String
filename))
| Bool
isFile
= Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTargetProblem -> Either UserTargetProblem UserTarget
forall a b. a -> Either a b
Left (String -> UserTargetProblem
UserTargetUnexpectedFile String
filename))
| Bool
parentDirExists
= Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTargetProblem -> Either UserTargetProblem UserTarget
forall a b. a -> Either a b
Left (String -> UserTargetProblem
UserTargetNonexistantFile String
filename))
| Bool
otherwise
= Maybe (Either UserTargetProblem UserTarget)
forall a. Maybe a
Nothing
Maybe (Either UserTargetProblem UserTarget)
-> IO (Maybe (Either UserTargetProblem UserTarget))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either UserTargetProblem UserTarget)
result
testUriTargets :: String -> Maybe (Either UserTargetProblem UserTarget)
testUriTargets :: String -> Maybe (Either UserTargetProblem UserTarget)
testUriTargets String
str =
case String -> Maybe URI
parseAbsoluteURI String
str of
Just uri :: URI
uri@URI {
uriScheme :: URI -> String
uriScheme = String
scheme,
uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just URIAuth { uriRegName :: URIAuth -> String
uriRegName = String
host }
}
| String
scheme String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"http:" Bool -> Bool -> Bool
&& String
scheme String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"https:" ->
Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTargetProblem -> Either UserTargetProblem UserTarget
forall a b. a -> Either a b
Left (String -> UserTargetProblem
UserTargetUnexpectedUriScheme String
targetstr))
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host ->
Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTargetProblem -> Either UserTargetProblem UserTarget
forall a b. a -> Either a b
Left (String -> UserTargetProblem
UserTargetUnrecognisedUri String
targetstr))
| Bool
otherwise ->
Either UserTargetProblem UserTarget
-> Maybe (Either UserTargetProblem UserTarget)
forall a. a -> Maybe a
Just (UserTarget -> Either UserTargetProblem UserTarget
forall a b. b -> Either a b
Right (URI -> UserTarget
UserTargetRemoteTarball URI
uri))
Maybe URI
_ -> Maybe (Either UserTargetProblem UserTarget)
forall a. Maybe a
Nothing
extensionIsTarGz :: FilePath -> Bool
extensionIsTarGz :: String -> Bool
extensionIsTarGz String
f = ShowS
takeExtension String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gz"
Bool -> Bool -> Bool
&& ShowS
takeExtension (ShowS
dropExtension String
f) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".tar"
reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO ()
reportUserTargetProblems :: Verbosity -> [UserTargetProblem] -> IO ()
reportUserTargetProblems Verbosity
verbosity [UserTargetProblem]
problems = do
case [ String
target | UserTargetUnrecognised String
target <- [UserTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
target -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Unrecognised target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
| String
name <- [String]
target ]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Targets can be:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - package names, e.g. 'pkgname', 'pkgname-1.0.1', 'pkgname < 2.0'\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - cabal files 'pkgname.cabal' or package directories 'pkgname/'\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - package tarballs 'pkgname.tar.gz' or 'http://example.com/pkgname.tar.gz'"
case [ String
target | UserTargetNonexistantFile String
target <- [UserTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
target -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"The file does not exist '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
| String
name <- [String]
target ]
case [ String
target | UserTargetUnexpectedFile String
target <- [UserTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
target -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Unrecognised file target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
| String
name <- [String]
target ]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"File targets can be either package tarballs 'pkgname.tar.gz' "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"or cabal files 'pkgname.cabal'."
case [ String
target | UserTargetUnexpectedUriScheme String
target <- [UserTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
target -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"URL target not supported '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
| String
name <- [String]
target ]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Only 'http://' and 'https://' URLs are supported."
case [ String
target | UserTargetUnrecognisedUri String
target <- [UserTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[String]
target -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
(String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Unrecognise URL target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
| String
name <- [String]
target ]
resolveUserTargets :: Package pkg
=> Verbosity
-> RepoContext
-> PackageIndex pkg
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
resolveUserTargets :: Verbosity
-> RepoContext
-> PackageIndex pkg
-> [UserTarget]
-> IO [PackageSpecifier UnresolvedSourcePackage]
resolveUserTargets Verbosity
verbosity RepoContext
repoCtxt PackageIndex pkg
available [UserTarget]
userTargets = do
[PackageTarget UnresolvedSourcePackage]
packageTargets <- (PackageTarget ResolvedPkgLoc
-> IO (PackageTarget UnresolvedSourcePackage))
-> [PackageTarget ResolvedPkgLoc]
-> IO [PackageTarget UnresolvedSourcePackage]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity
-> PackageTarget ResolvedPkgLoc
-> IO (PackageTarget UnresolvedSourcePackage)
readPackageTarget Verbosity
verbosity)
([PackageTarget ResolvedPkgLoc]
-> IO [PackageTarget UnresolvedSourcePackage])
-> IO [PackageTarget ResolvedPkgLoc]
-> IO [PackageTarget UnresolvedSourcePackage]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc))
-> [PackageTarget (PackageLocation ())]
-> IO [PackageTarget ResolvedPkgLoc]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity
-> RepoContext
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc)
fetchPackageTarget Verbosity
verbosity RepoContext
repoCtxt) ([PackageTarget (PackageLocation ())]
-> IO [PackageTarget ResolvedPkgLoc])
-> ([[PackageTarget (PackageLocation ())]]
-> [PackageTarget (PackageLocation ())])
-> [[PackageTarget (PackageLocation ())]]
-> IO [PackageTarget ResolvedPkgLoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PackageTarget (PackageLocation ())]]
-> [PackageTarget (PackageLocation ())]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([[PackageTarget (PackageLocation ())]]
-> IO [PackageTarget ResolvedPkgLoc])
-> IO [[PackageTarget (PackageLocation ())]]
-> IO [PackageTarget ResolvedPkgLoc]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (UserTarget -> IO [PackageTarget (PackageLocation ())])
-> [UserTarget] -> IO [[PackageTarget (PackageLocation ())]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity -> UserTarget -> IO [PackageTarget (PackageLocation ())]
expandUserTarget Verbosity
verbosity) [UserTarget]
userTargets
let ([PackageTargetProblem]
problems, [PackageSpecifier UnresolvedSourcePackage]
packageSpecifiers) :: ([PackageTargetProblem], [PackageSpecifier UnresolvedSourcePackage]) =
PackageIndex pkg
-> [PackageName]
-> [PackageTarget UnresolvedSourcePackage]
-> ([PackageTargetProblem],
[PackageSpecifier UnresolvedSourcePackage])
forall pkg' pkg.
Package pkg' =>
PackageIndex pkg'
-> [PackageName]
-> [PackageTarget pkg]
-> ([PackageTargetProblem], [PackageSpecifier pkg])
disambiguatePackageTargets PackageIndex pkg
available [PackageName]
availableExtra [PackageTarget UnresolvedSourcePackage]
packageTargets
availableExtra :: [PackageName]
availableExtra :: [PackageName]
availableExtra = [ UnresolvedSourcePackage -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName UnresolvedSourcePackage
pkg
| PackageTargetLocation UnresolvedSourcePackage
pkg <- [PackageTarget UnresolvedSourcePackage]
packageTargets ]
Verbosity -> [PackageTargetProblem] -> IO ()
reportPackageTargetProblems Verbosity
verbosity [PackageTargetProblem]
problems
[PackageSpecifier UnresolvedSourcePackage]
-> IO [PackageSpecifier UnresolvedSourcePackage]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageSpecifier UnresolvedSourcePackage]
packageSpecifiers
data PackageTarget pkg =
PackageTargetNamed PackageName [PackageProperty] UserTarget
| PackageTargetNamedFuzzy PackageName [PackageProperty] UserTarget
| PackageTargetLocation pkg
deriving (Int -> PackageTarget pkg -> ShowS
[PackageTarget pkg] -> ShowS
PackageTarget pkg -> String
(Int -> PackageTarget pkg -> ShowS)
-> (PackageTarget pkg -> String)
-> ([PackageTarget pkg] -> ShowS)
-> Show (PackageTarget pkg)
forall pkg. Show pkg => Int -> PackageTarget pkg -> ShowS
forall pkg. Show pkg => [PackageTarget pkg] -> ShowS
forall pkg. Show pkg => PackageTarget pkg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageTarget pkg] -> ShowS
$cshowList :: forall pkg. Show pkg => [PackageTarget pkg] -> ShowS
show :: PackageTarget pkg -> String
$cshow :: forall pkg. Show pkg => PackageTarget pkg -> String
showsPrec :: Int -> PackageTarget pkg -> ShowS
$cshowsPrec :: forall pkg. Show pkg => Int -> PackageTarget pkg -> ShowS
Show, a -> PackageTarget b -> PackageTarget a
(a -> b) -> PackageTarget a -> PackageTarget b
(forall a b. (a -> b) -> PackageTarget a -> PackageTarget b)
-> (forall a b. a -> PackageTarget b -> PackageTarget a)
-> Functor PackageTarget
forall a b. a -> PackageTarget b -> PackageTarget a
forall a b. (a -> b) -> PackageTarget a -> PackageTarget b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PackageTarget b -> PackageTarget a
$c<$ :: forall a b. a -> PackageTarget b -> PackageTarget a
fmap :: (a -> b) -> PackageTarget a -> PackageTarget b
$cfmap :: forall a b. (a -> b) -> PackageTarget a -> PackageTarget b
Functor, PackageTarget a -> Bool
(a -> m) -> PackageTarget a -> m
(a -> b -> b) -> b -> PackageTarget a -> b
(forall m. Monoid m => PackageTarget m -> m)
-> (forall m a. Monoid m => (a -> m) -> PackageTarget a -> m)
-> (forall m a. Monoid m => (a -> m) -> PackageTarget a -> m)
-> (forall a b. (a -> b -> b) -> b -> PackageTarget a -> b)
-> (forall a b. (a -> b -> b) -> b -> PackageTarget a -> b)
-> (forall b a. (b -> a -> b) -> b -> PackageTarget a -> b)
-> (forall b a. (b -> a -> b) -> b -> PackageTarget a -> b)
-> (forall a. (a -> a -> a) -> PackageTarget a -> a)
-> (forall a. (a -> a -> a) -> PackageTarget a -> a)
-> (forall a. PackageTarget a -> [a])
-> (forall a. PackageTarget a -> Bool)
-> (forall a. PackageTarget a -> Int)
-> (forall a. Eq a => a -> PackageTarget a -> Bool)
-> (forall a. Ord a => PackageTarget a -> a)
-> (forall a. Ord a => PackageTarget a -> a)
-> (forall a. Num a => PackageTarget a -> a)
-> (forall a. Num a => PackageTarget a -> a)
-> Foldable PackageTarget
forall a. Eq a => a -> PackageTarget a -> Bool
forall a. Num a => PackageTarget a -> a
forall a. Ord a => PackageTarget a -> a
forall m. Monoid m => PackageTarget m -> m
forall a. PackageTarget a -> Bool
forall a. PackageTarget a -> Int
forall a. PackageTarget a -> [a]
forall a. (a -> a -> a) -> PackageTarget a -> a
forall m a. Monoid m => (a -> m) -> PackageTarget a -> m
forall b a. (b -> a -> b) -> b -> PackageTarget a -> b
forall a b. (a -> b -> b) -> b -> PackageTarget a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: PackageTarget a -> a
$cproduct :: forall a. Num a => PackageTarget a -> a
sum :: PackageTarget a -> a
$csum :: forall a. Num a => PackageTarget a -> a
minimum :: PackageTarget a -> a
$cminimum :: forall a. Ord a => PackageTarget a -> a
maximum :: PackageTarget a -> a
$cmaximum :: forall a. Ord a => PackageTarget a -> a
elem :: a -> PackageTarget a -> Bool
$celem :: forall a. Eq a => a -> PackageTarget a -> Bool
length :: PackageTarget a -> Int
$clength :: forall a. PackageTarget a -> Int
null :: PackageTarget a -> Bool
$cnull :: forall a. PackageTarget a -> Bool
toList :: PackageTarget a -> [a]
$ctoList :: forall a. PackageTarget a -> [a]
foldl1 :: (a -> a -> a) -> PackageTarget a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PackageTarget a -> a
foldr1 :: (a -> a -> a) -> PackageTarget a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PackageTarget a -> a
foldl' :: (b -> a -> b) -> b -> PackageTarget a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PackageTarget a -> b
foldl :: (b -> a -> b) -> b -> PackageTarget a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PackageTarget a -> b
foldr' :: (a -> b -> b) -> b -> PackageTarget a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PackageTarget a -> b
foldr :: (a -> b -> b) -> b -> PackageTarget a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PackageTarget a -> b
foldMap' :: (a -> m) -> PackageTarget a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PackageTarget a -> m
foldMap :: (a -> m) -> PackageTarget a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PackageTarget a -> m
fold :: PackageTarget m -> m
$cfold :: forall m. Monoid m => PackageTarget m -> m
Foldable, Functor PackageTarget
Foldable PackageTarget
Functor PackageTarget
-> Foldable PackageTarget
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageTarget a -> f (PackageTarget b))
-> (forall (f :: * -> *) a.
Applicative f =>
PackageTarget (f a) -> f (PackageTarget a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageTarget a -> m (PackageTarget b))
-> (forall (m :: * -> *) a.
Monad m =>
PackageTarget (m a) -> m (PackageTarget a))
-> Traversable PackageTarget
(a -> f b) -> PackageTarget a -> f (PackageTarget b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PackageTarget (m a) -> m (PackageTarget a)
forall (f :: * -> *) a.
Applicative f =>
PackageTarget (f a) -> f (PackageTarget a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageTarget a -> m (PackageTarget b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageTarget a -> f (PackageTarget b)
sequence :: PackageTarget (m a) -> m (PackageTarget a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PackageTarget (m a) -> m (PackageTarget a)
mapM :: (a -> m b) -> PackageTarget a -> m (PackageTarget b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PackageTarget a -> m (PackageTarget b)
sequenceA :: PackageTarget (f a) -> f (PackageTarget a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PackageTarget (f a) -> f (PackageTarget a)
traverse :: (a -> f b) -> PackageTarget a -> f (PackageTarget b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PackageTarget a -> f (PackageTarget b)
$cp2Traversable :: Foldable PackageTarget
$cp1Traversable :: Functor PackageTarget
Traversable)
expandUserTarget :: Verbosity
-> UserTarget
-> IO [PackageTarget (PackageLocation ())]
expandUserTarget :: Verbosity -> UserTarget -> IO [PackageTarget (PackageLocation ())]
expandUserTarget Verbosity
verbosity UserTarget
userTarget = case UserTarget
userTarget of
UserTargetNamed (PackageVersionConstraint PackageName
name VersionRange
vrange) ->
let props :: [PackageProperty]
props = [ VersionRange -> PackageProperty
PackagePropertyVersion VersionRange
vrange
| Bool -> Bool
not (VersionRange -> Bool
isAnyVersion VersionRange
vrange) ]
in [PackageTarget (PackageLocation ())]
-> IO [PackageTarget (PackageLocation ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageName
-> [PackageProperty]
-> UserTarget
-> PackageTarget (PackageLocation ())
forall pkg.
PackageName -> [PackageProperty] -> UserTarget -> PackageTarget pkg
PackageTargetNamedFuzzy PackageName
name [PackageProperty]
props UserTarget
userTarget]
UserTargetLocalDir String
dir ->
[PackageTarget (PackageLocation ())]
-> IO [PackageTarget (PackageLocation ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageLocation () -> PackageTarget (PackageLocation ())
forall pkg. pkg -> PackageTarget pkg
PackageTargetLocation (String -> PackageLocation ()
forall local. String -> PackageLocation local
LocalUnpackedPackage String
dir) ]
UserTargetLocalCabalFile String
file -> do
let dir :: String
dir = ShowS
takeDirectory String
file
String
_ <- Verbosity -> String -> String -> IO String
tryFindPackageDesc Verbosity
verbosity String
dir (ShowS
localPackageError String
dir)
[PackageTarget (PackageLocation ())]
-> IO [PackageTarget (PackageLocation ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageLocation () -> PackageTarget (PackageLocation ())
forall pkg. pkg -> PackageTarget pkg
PackageTargetLocation (String -> PackageLocation ()
forall local. String -> PackageLocation local
LocalUnpackedPackage String
dir) ]
UserTargetLocalTarball String
tarballFile ->
[PackageTarget (PackageLocation ())]
-> IO [PackageTarget (PackageLocation ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageLocation () -> PackageTarget (PackageLocation ())
forall pkg. pkg -> PackageTarget pkg
PackageTargetLocation (String -> PackageLocation ()
forall local. String -> PackageLocation local
LocalTarballPackage String
tarballFile) ]
UserTargetRemoteTarball URI
tarballURL ->
[PackageTarget (PackageLocation ())]
-> IO [PackageTarget (PackageLocation ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [ PackageLocation () -> PackageTarget (PackageLocation ())
forall pkg. pkg -> PackageTarget pkg
PackageTargetLocation (URI -> () -> PackageLocation ()
forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
tarballURL ()) ]
localPackageError :: FilePath -> String
localPackageError :: ShowS
localPackageError String
dir =
String
"Error reading local package.\nCouldn't find .cabal file in: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir
fetchPackageTarget :: Verbosity
-> RepoContext
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc)
fetchPackageTarget :: Verbosity
-> RepoContext
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc)
fetchPackageTarget Verbosity
verbosity RepoContext
repoCtxt = (PackageLocation () -> IO ResolvedPkgLoc)
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((PackageLocation () -> IO ResolvedPkgLoc)
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc))
-> (PackageLocation () -> IO ResolvedPkgLoc)
-> PackageTarget (PackageLocation ())
-> IO (PackageTarget ResolvedPkgLoc)
forall a b. (a -> b) -> a -> b
$
Verbosity -> RepoContext -> UnresolvedPkgLoc -> IO ResolvedPkgLoc
fetchPackage Verbosity
verbosity RepoContext
repoCtxt (UnresolvedPkgLoc -> IO ResolvedPkgLoc)
-> (PackageLocation () -> UnresolvedPkgLoc)
-> PackageLocation ()
-> IO ResolvedPkgLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Maybe String) -> PackageLocation () -> UnresolvedPkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String -> () -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing)
readPackageTarget :: Verbosity
-> PackageTarget ResolvedPkgLoc
-> IO (PackageTarget UnresolvedSourcePackage)
readPackageTarget :: Verbosity
-> PackageTarget ResolvedPkgLoc
-> IO (PackageTarget UnresolvedSourcePackage)
readPackageTarget Verbosity
verbosity = (ResolvedPkgLoc -> IO UnresolvedSourcePackage)
-> PackageTarget ResolvedPkgLoc
-> IO (PackageTarget UnresolvedSourcePackage)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ResolvedPkgLoc -> IO UnresolvedSourcePackage
modifyLocation
where
modifyLocation :: ResolvedPkgLoc -> IO UnresolvedSourcePackage
modifyLocation :: ResolvedPkgLoc -> IO UnresolvedSourcePackage
modifyLocation ResolvedPkgLoc
location = case ResolvedPkgLoc
location of
LocalUnpackedPackage String
dir -> do
GenericPackageDescription
pkg <- Verbosity -> String -> String -> IO String
tryFindPackageDesc Verbosity
verbosity String
dir (ShowS
localPackageError String
dir) IO String
-> (String -> IO GenericPackageDescription)
-> IO GenericPackageDescription
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
verbosity
UnresolvedSourcePackage -> IO UnresolvedSourcePackage
forall (m :: * -> *) a. Monad m => a -> m a
return SourcePackage :: forall loc.
PackageId
-> GenericPackageDescription
-> loc
-> PackageDescriptionOverride
-> SourcePackage loc
SourcePackage
{ srcpkgPackageId :: PackageId
srcpkgPackageId = GenericPackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg
, srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkg
, srcpkgSource :: UnresolvedPkgLoc
srcpkgSource = (String -> Maybe String) -> ResolvedPkgLoc -> UnresolvedPkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just ResolvedPkgLoc
location
, srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride = PackageDescriptionOverride
forall a. Maybe a
Nothing
}
LocalTarballPackage String
tarballFile ->
ResolvedPkgLoc -> String -> String -> IO UnresolvedSourcePackage
readTarballPackageTarget ResolvedPkgLoc
location String
tarballFile String
tarballFile
RemoteTarballPackage URI
tarballURL String
tarballFile ->
ResolvedPkgLoc -> String -> String -> IO UnresolvedSourcePackage
readTarballPackageTarget ResolvedPkgLoc
location String
tarballFile (URI -> String
forall a. Show a => a -> String
show URI
tarballURL)
RepoTarballPackage Repo
_repo PackageId
_pkgid String
_ ->
String -> IO UnresolvedSourcePackage
forall a. HasCallStack => String -> a
error String
"TODO: readPackageTarget RepoTarballPackage"
RemoteSourceRepoPackage SourceRepoMaybe
_srcRepo String
_ ->
String -> IO UnresolvedSourcePackage
forall a. HasCallStack => String -> a
error String
"TODO: readPackageTarget RemoteSourceRepoPackage"
readTarballPackageTarget :: ResolvedPkgLoc -> FilePath -> FilePath -> IO UnresolvedSourcePackage
readTarballPackageTarget :: ResolvedPkgLoc -> String -> String -> IO UnresolvedSourcePackage
readTarballPackageTarget ResolvedPkgLoc
location String
tarballFile String
tarballOriginalLoc = do
(String
filename, ByteString
content) <- String -> String -> IO (String, ByteString)
extractTarballPackageCabalFile
String
tarballFile String
tarballOriginalLoc
case ByteString -> Maybe GenericPackageDescription
parsePackageDescription' ByteString
content of
Maybe GenericPackageDescription
Nothing -> Verbosity -> String -> IO UnresolvedSourcePackage
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO UnresolvedSourcePackage)
-> String -> IO UnresolvedSourcePackage
forall a b. (a -> b) -> a -> b
$ String
"Could not parse the cabal file "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tarballFile
Just GenericPackageDescription
pkg ->
UnresolvedSourcePackage -> IO UnresolvedSourcePackage
forall (m :: * -> *) a. Monad m => a -> m a
return SourcePackage :: forall loc.
PackageId
-> GenericPackageDescription
-> loc
-> PackageDescriptionOverride
-> SourcePackage loc
SourcePackage
{ srcpkgPackageId :: PackageId
srcpkgPackageId = GenericPackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg
, srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkg
, srcpkgSource :: UnresolvedPkgLoc
srcpkgSource = (String -> Maybe String) -> ResolvedPkgLoc -> UnresolvedPkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just ResolvedPkgLoc
location
, srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride = PackageDescriptionOverride
forall a. Maybe a
Nothing
}
extractTarballPackageCabalFile :: FilePath -> String
-> IO (FilePath, BS.ByteString)
extractTarballPackageCabalFile :: String -> String -> IO (String, ByteString)
extractTarballPackageCabalFile String
tarballFile String
tarballOriginalLoc =
(String -> IO (String, ByteString))
-> ((String, ByteString) -> IO (String, ByteString))
-> Either String (String, ByteString)
-> IO (String, ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> String -> IO (String, ByteString)
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO (String, ByteString))
-> ShowS -> String -> IO (String, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
formatErr) (String, ByteString) -> IO (String, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either String (String, ByteString) -> IO (String, ByteString))
-> (ByteString -> Either String (String, ByteString))
-> ByteString
-> IO (String, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
-> Either String (String, ByteString)
forall a k.
Show a =>
Either a (Map k Entry) -> Either String (String, ByteString)
check
(Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
-> Either String (String, ByteString))
-> (ByteString
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry))
-> ByteString
-> Either String (String, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entries FormatError
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
accumEntryMap
(Entries FormatError
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry))
-> (ByteString -> Entries FormatError)
-> ByteString
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry -> Bool) -> Entries FormatError -> Entries FormatError
forall e. (Entry -> Bool) -> Entries e -> Entries e
Tar.filterEntries Entry -> Bool
isCabalFile
(Entries FormatError -> Entries FormatError)
-> (ByteString -> Entries FormatError)
-> ByteString
-> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
(ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZipUtils.maybeDecompress
(ByteString -> IO (String, ByteString))
-> IO ByteString -> IO (String, ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
tarballFile
where
formatErr :: ShowS
formatErr String
msg = String
"Error reading " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tarballOriginalLoc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
accumEntryMap :: Tar.Entries Tar.FormatError
-> Either (Tar.FormatError, Map Tar.TarPath Tar.Entry) (Map Tar.TarPath Tar.Entry)
accumEntryMap :: Entries FormatError
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
accumEntryMap = (Map TarPath Entry -> Entry -> Map TarPath Entry)
-> Map TarPath Entry
-> Entries FormatError
-> Either (FormatError, Map TarPath Entry) (Map TarPath Entry)
forall a e. (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
Tar.foldlEntries
(\Map TarPath Entry
m Entry
e -> TarPath -> Entry -> Map TarPath Entry -> Map TarPath Entry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Entry -> TarPath
Tar.entryTarPath Entry
e) Entry
e Map TarPath Entry
m)
Map TarPath Entry
forall k a. Map k a
Map.empty
check :: Either a (Map k Entry) -> Either String (String, ByteString)
check (Left a
e) = String -> Either String (String, ByteString)
forall a b. a -> Either a b
Left (a -> String
forall a. Show a => a -> String
show a
e)
check (Right Map k Entry
m) = case Map k Entry -> [Entry]
forall k a. Map k a -> [a]
Map.elems Map k Entry
m of
[] -> String -> Either String (String, ByteString)
forall a b. a -> Either a b
Left String
noCabalFile
[Entry
file] -> case Entry -> EntryContent
Tar.entryContent Entry
file of
Tar.NormalFile ByteString
content FileSize
_ -> (String, ByteString) -> Either String (String, ByteString)
forall a b. b -> Either a b
Right (Entry -> String
Tar.entryPath Entry
file, ByteString
content)
EntryContent
_ -> String -> Either String (String, ByteString)
forall a b. a -> Either a b
Left String
noCabalFile
[Entry]
_files -> String -> Either String (String, ByteString)
forall a b. a -> Either a b
Left String
multipleCabalFiles
where
noCabalFile :: String
noCabalFile = String
"No cabal file found"
multipleCabalFiles :: String
multipleCabalFiles = String
"Multiple cabal files found"
isCabalFile :: Tar.Entry -> Bool
isCabalFile :: Entry -> Bool
isCabalFile Entry
e = case String -> [String]
splitPath (Entry -> String
Tar.entryPath Entry
e) of
[ String
_dir, String
file] -> ShowS
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal"
[String
".", String
_dir, String
file] -> ShowS
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal"
[String]
_ -> Bool
False
parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription
parsePackageDescription' :: ByteString -> Maybe GenericPackageDescription
parsePackageDescription' ByteString
bs =
ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> ByteString
BS.toStrict ByteString
bs)
data PackageTargetProblem
= PackageNameUnknown PackageName UserTarget
| PackageNameAmbiguous PackageName [PackageName] UserTarget
deriving Int -> PackageTargetProblem -> ShowS
[PackageTargetProblem] -> ShowS
PackageTargetProblem -> String
(Int -> PackageTargetProblem -> ShowS)
-> (PackageTargetProblem -> String)
-> ([PackageTargetProblem] -> ShowS)
-> Show PackageTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageTargetProblem] -> ShowS
$cshowList :: [PackageTargetProblem] -> ShowS
show :: PackageTargetProblem -> String
$cshow :: PackageTargetProblem -> String
showsPrec :: Int -> PackageTargetProblem -> ShowS
$cshowsPrec :: Int -> PackageTargetProblem -> ShowS
Show
disambiguatePackageTargets :: Package pkg'
=> PackageIndex pkg'
-> [PackageName]
-> [PackageTarget pkg]
-> ( [PackageTargetProblem]
, [PackageSpecifier pkg] )
disambiguatePackageTargets :: PackageIndex pkg'
-> [PackageName]
-> [PackageTarget pkg]
-> ([PackageTargetProblem], [PackageSpecifier pkg])
disambiguatePackageTargets PackageIndex pkg'
availablePkgIndex [PackageName]
availableExtra [PackageTarget pkg]
targets =
[Either PackageTargetProblem (PackageSpecifier pkg)]
-> ([PackageTargetProblem], [PackageSpecifier pkg])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((PackageTarget pkg
-> Either PackageTargetProblem (PackageSpecifier pkg))
-> [PackageTarget pkg]
-> [Either PackageTargetProblem (PackageSpecifier pkg)]
forall a b. (a -> b) -> [a] -> [b]
map PackageTarget pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall pkg.
PackageTarget pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
disambiguatePackageTarget [PackageTarget pkg]
targets)
where
disambiguatePackageTarget :: PackageTarget pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
disambiguatePackageTarget PackageTarget pkg
packageTarget = case PackageTarget pkg
packageTarget of
PackageTargetLocation pkg
pkg -> PackageSpecifier pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. b -> Either a b
Right (pkg -> PackageSpecifier pkg
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage pkg
pkg)
PackageTargetNamed PackageName
pkgname [PackageProperty]
props UserTarget
userTarget
| [pkg'] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageIndex pkg' -> PackageName -> [pkg']
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
PackageIndex.lookupPackageName PackageIndex pkg'
availablePkgIndex PackageName
pkgname)
-> PackageTargetProblem
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. a -> Either a b
Left (PackageName -> UserTarget -> PackageTargetProblem
PackageNameUnknown PackageName
pkgname UserTarget
userTarget)
| Bool
otherwise -> PackageSpecifier pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. b -> Either a b
Right (PackageName -> [PackageProperty] -> PackageSpecifier pkg
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pkgname [PackageProperty]
props)
PackageTargetNamedFuzzy PackageName
pkgname [PackageProperty]
props UserTarget
userTarget ->
case PackageNameEnv -> PackageName -> MaybeAmbiguous PackageName
disambiguatePackageName PackageNameEnv
packageNameEnv PackageName
pkgname of
MaybeAmbiguous PackageName
None -> PackageTargetProblem
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. a -> Either a b
Left (PackageName -> UserTarget -> PackageTargetProblem
PackageNameUnknown
PackageName
pkgname UserTarget
userTarget)
Ambiguous [PackageName]
pkgnames -> PackageTargetProblem
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. a -> Either a b
Left (PackageName -> [PackageName] -> UserTarget -> PackageTargetProblem
PackageNameAmbiguous
PackageName
pkgname [PackageName]
pkgnames UserTarget
userTarget)
Unambiguous PackageName
pkgname' -> PackageSpecifier pkg
-> Either PackageTargetProblem (PackageSpecifier pkg)
forall a b. b -> Either a b
Right (PackageName -> [PackageProperty] -> PackageSpecifier pkg
forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pkgname' [PackageProperty]
props)
packageNameEnv :: PackageNameEnv
packageNameEnv :: PackageNameEnv
packageNameEnv = PackageNameEnv -> PackageNameEnv -> PackageNameEnv
forall a. Monoid a => a -> a -> a
mappend (PackageIndex pkg' -> PackageNameEnv
forall pkg. PackageIndex pkg -> PackageNameEnv
indexPackageNameEnv PackageIndex pkg'
availablePkgIndex)
([PackageName] -> PackageNameEnv
extraPackageNameEnv [PackageName]
availableExtra)
reportPackageTargetProblems :: Verbosity
-> [PackageTargetProblem] -> IO ()
reportPackageTargetProblems :: Verbosity -> [PackageTargetProblem] -> IO ()
reportPackageTargetProblems Verbosity
verbosity [PackageTargetProblem]
problems = do
case [ PackageName
pkg | PackageNameUnknown PackageName
pkg UserTarget
_ <- [PackageTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[PackageName]
pkgs -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"There is no package named '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. "
| PackageName
name <- [PackageName]
pkgs ]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You may need to run 'cabal update' to get the latest "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"list of available packages."
case [ (PackageName
pkg, [PackageName]
matches) | PackageNameAmbiguous PackageName
pkg [PackageName]
matches UserTarget
_ <- [PackageTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(PackageName, [PackageName])]
ambiguities -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"There is no package named '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if [PackageName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
matches Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then String
"However, the following package names exist: "
else String
"However, the following package name exists: ")
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [ String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Pretty a => a -> String
prettyShow PackageName
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'" | PackageName
m <- [PackageName]
matches]
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
| (PackageName
name, [PackageName]
matches) <- [(PackageName, [PackageName])]
ambiguities ]
data MaybeAmbiguous a = None | Unambiguous a | Ambiguous [a]
disambiguatePackageName :: PackageNameEnv
-> PackageName
-> MaybeAmbiguous PackageName
disambiguatePackageName :: PackageNameEnv -> PackageName -> MaybeAmbiguous PackageName
disambiguatePackageName (PackageNameEnv PackageName -> [PackageName]
pkgNameLookup) PackageName
name =
case [PackageName] -> [PackageName]
forall a. Eq a => [a] -> [a]
nub (PackageName -> [PackageName]
pkgNameLookup PackageName
name) of
[] -> MaybeAmbiguous PackageName
forall a. MaybeAmbiguous a
None
[PackageName]
names -> case (PackageName -> Bool) -> [PackageName] -> Maybe PackageName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (PackageName
namePackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
==) [PackageName]
names of
Just PackageName
name' -> PackageName -> MaybeAmbiguous PackageName
forall a. a -> MaybeAmbiguous a
Unambiguous PackageName
name'
Maybe PackageName
Nothing -> [PackageName] -> MaybeAmbiguous PackageName
forall a. [a] -> MaybeAmbiguous a
Ambiguous [PackageName]
names
newtype PackageNameEnv = PackageNameEnv (PackageName -> [PackageName])
instance Monoid PackageNameEnv where
mempty :: PackageNameEnv
mempty = (PackageName -> [PackageName]) -> PackageNameEnv
PackageNameEnv ([PackageName] -> PackageName -> [PackageName]
forall a b. a -> b -> a
const [])
mappend :: PackageNameEnv -> PackageNameEnv -> PackageNameEnv
mappend = PackageNameEnv -> PackageNameEnv -> PackageNameEnv
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup PackageNameEnv where
PackageNameEnv PackageName -> [PackageName]
lookupA <> :: PackageNameEnv -> PackageNameEnv -> PackageNameEnv
<> PackageNameEnv PackageName -> [PackageName]
lookupB =
(PackageName -> [PackageName]) -> PackageNameEnv
PackageNameEnv (\PackageName
name -> PackageName -> [PackageName]
lookupA PackageName
name [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ PackageName -> [PackageName]
lookupB PackageName
name)
indexPackageNameEnv :: PackageIndex pkg -> PackageNameEnv
indexPackageNameEnv :: PackageIndex pkg -> PackageNameEnv
indexPackageNameEnv PackageIndex pkg
pkgIndex = (PackageName -> [PackageName]) -> PackageNameEnv
PackageNameEnv PackageName -> [PackageName]
pkgNameLookup
where
pkgNameLookup :: PackageName -> [PackageName]
pkgNameLookup PackageName
pname =
((PackageName, [pkg]) -> PackageName)
-> [(PackageName, [pkg])] -> [PackageName]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, [pkg]) -> PackageName
forall a b. (a, b) -> a
fst (PackageIndex pkg -> String -> [(PackageName, [pkg])]
forall pkg. PackageIndex pkg -> String -> [(PackageName, [pkg])]
PackageIndex.searchByName PackageIndex pkg
pkgIndex (String -> [(PackageName, [pkg])])
-> String -> [(PackageName, [pkg])]
forall a b. (a -> b) -> a -> b
$ PackageName -> String
unPackageName PackageName
pname)
extraPackageNameEnv :: [PackageName] -> PackageNameEnv
[PackageName]
names = (PackageName -> [PackageName]) -> PackageNameEnv
PackageNameEnv PackageName -> [PackageName]
pkgNameLookup
where
pkgNameLookup :: PackageName -> [PackageName]
pkgNameLookup PackageName
pname =
[ PackageName
pname'
| let lname :: String
lname = ShowS
lowercase (PackageName -> String
unPackageName PackageName
pname)
, PackageName
pname' <- [PackageName]
names
, ShowS
lowercase (PackageName -> String
unPackageName PackageName
pname') String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lname ]
data UserQualifier =
UserQualToplevel
| UserQualSetup PackageName
| UserQualExe PackageName PackageName
deriving (UserQualifier -> UserQualifier -> Bool
(UserQualifier -> UserQualifier -> Bool)
-> (UserQualifier -> UserQualifier -> Bool) -> Eq UserQualifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserQualifier -> UserQualifier -> Bool
$c/= :: UserQualifier -> UserQualifier -> Bool
== :: UserQualifier -> UserQualifier -> Bool
$c== :: UserQualifier -> UserQualifier -> Bool
Eq, Int -> UserQualifier -> ShowS
[UserQualifier] -> ShowS
UserQualifier -> String
(Int -> UserQualifier -> ShowS)
-> (UserQualifier -> String)
-> ([UserQualifier] -> ShowS)
-> Show UserQualifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserQualifier] -> ShowS
$cshowList :: [UserQualifier] -> ShowS
show :: UserQualifier -> String
$cshow :: UserQualifier -> String
showsPrec :: Int -> UserQualifier -> ShowS
$cshowsPrec :: Int -> UserQualifier -> ShowS
Show, (forall x. UserQualifier -> Rep UserQualifier x)
-> (forall x. Rep UserQualifier x -> UserQualifier)
-> Generic UserQualifier
forall x. Rep UserQualifier x -> UserQualifier
forall x. UserQualifier -> Rep UserQualifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserQualifier x -> UserQualifier
$cfrom :: forall x. UserQualifier -> Rep UserQualifier x
Generic)
instance Binary UserQualifier
instance Structured UserQualifier
data UserConstraintScope =
UserQualified UserQualifier PackageName
| UserAnySetupQualifier PackageName
| UserAnyQualifier PackageName
deriving (UserConstraintScope -> UserConstraintScope -> Bool
(UserConstraintScope -> UserConstraintScope -> Bool)
-> (UserConstraintScope -> UserConstraintScope -> Bool)
-> Eq UserConstraintScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserConstraintScope -> UserConstraintScope -> Bool
$c/= :: UserConstraintScope -> UserConstraintScope -> Bool
== :: UserConstraintScope -> UserConstraintScope -> Bool
$c== :: UserConstraintScope -> UserConstraintScope -> Bool
Eq, Int -> UserConstraintScope -> ShowS
[UserConstraintScope] -> ShowS
UserConstraintScope -> String
(Int -> UserConstraintScope -> ShowS)
-> (UserConstraintScope -> String)
-> ([UserConstraintScope] -> ShowS)
-> Show UserConstraintScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserConstraintScope] -> ShowS
$cshowList :: [UserConstraintScope] -> ShowS
show :: UserConstraintScope -> String
$cshow :: UserConstraintScope -> String
showsPrec :: Int -> UserConstraintScope -> ShowS
$cshowsPrec :: Int -> UserConstraintScope -> ShowS
Show, (forall x. UserConstraintScope -> Rep UserConstraintScope x)
-> (forall x. Rep UserConstraintScope x -> UserConstraintScope)
-> Generic UserConstraintScope
forall x. Rep UserConstraintScope x -> UserConstraintScope
forall x. UserConstraintScope -> Rep UserConstraintScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserConstraintScope x -> UserConstraintScope
$cfrom :: forall x. UserConstraintScope -> Rep UserConstraintScope x
Generic)
instance Binary UserConstraintScope
instance Structured UserConstraintScope
fromUserQualifier :: UserQualifier -> Qualifier
fromUserQualifier :: UserQualifier -> Qualifier
fromUserQualifier UserQualifier
UserQualToplevel = Qualifier
QualToplevel
fromUserQualifier (UserQualSetup PackageName
name) = PackageName -> Qualifier
QualSetup PackageName
name
fromUserQualifier (UserQualExe PackageName
name1 PackageName
name2) = PackageName -> PackageName -> Qualifier
QualExe PackageName
name1 PackageName
name2
fromUserConstraintScope :: UserConstraintScope -> ConstraintScope
fromUserConstraintScope :: UserConstraintScope -> ConstraintScope
fromUserConstraintScope (UserQualified UserQualifier
q PackageName
pn) =
Qualifier -> PackageName -> ConstraintScope
ScopeQualified (UserQualifier -> Qualifier
fromUserQualifier UserQualifier
q) PackageName
pn
fromUserConstraintScope (UserAnySetupQualifier PackageName
pn) = PackageName -> ConstraintScope
ScopeAnySetupQualifier PackageName
pn
fromUserConstraintScope (UserAnyQualifier PackageName
pn) = PackageName -> ConstraintScope
ScopeAnyQualifier PackageName
pn
data UserConstraint =
UserConstraint UserConstraintScope PackageProperty
deriving (UserConstraint -> UserConstraint -> Bool
(UserConstraint -> UserConstraint -> Bool)
-> (UserConstraint -> UserConstraint -> Bool) -> Eq UserConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserConstraint -> UserConstraint -> Bool
$c/= :: UserConstraint -> UserConstraint -> Bool
== :: UserConstraint -> UserConstraint -> Bool
$c== :: UserConstraint -> UserConstraint -> Bool
Eq, Int -> UserConstraint -> ShowS
[UserConstraint] -> ShowS
UserConstraint -> String
(Int -> UserConstraint -> ShowS)
-> (UserConstraint -> String)
-> ([UserConstraint] -> ShowS)
-> Show UserConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserConstraint] -> ShowS
$cshowList :: [UserConstraint] -> ShowS
show :: UserConstraint -> String
$cshow :: UserConstraint -> String
showsPrec :: Int -> UserConstraint -> ShowS
$cshowsPrec :: Int -> UserConstraint -> ShowS
Show, (forall x. UserConstraint -> Rep UserConstraint x)
-> (forall x. Rep UserConstraint x -> UserConstraint)
-> Generic UserConstraint
forall x. Rep UserConstraint x -> UserConstraint
forall x. UserConstraint -> Rep UserConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserConstraint x -> UserConstraint
$cfrom :: forall x. UserConstraint -> Rep UserConstraint x
Generic)
instance Binary UserConstraint
instance Structured UserConstraint
userConstraintPackageName :: UserConstraint -> PackageName
userConstraintPackageName :: UserConstraint -> PackageName
userConstraintPackageName (UserConstraint UserConstraintScope
scope PackageProperty
_) = UserConstraintScope -> PackageName
scopePN UserConstraintScope
scope
where
scopePN :: UserConstraintScope -> PackageName
scopePN (UserQualified UserQualifier
_ PackageName
pn) = PackageName
pn
scopePN (UserAnyQualifier PackageName
pn) = PackageName
pn
scopePN (UserAnySetupQualifier PackageName
pn) = PackageName
pn
userToPackageConstraint :: UserConstraint -> PackageConstraint
userToPackageConstraint :: UserConstraint -> PackageConstraint
userToPackageConstraint (UserConstraint UserConstraintScope
scope PackageProperty
prop) =
ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (UserConstraintScope -> ConstraintScope
fromUserConstraintScope UserConstraintScope
scope) PackageProperty
prop
readUserConstraint :: String -> Either String UserConstraint
readUserConstraint :: String -> Either String UserConstraint
readUserConstraint String
str =
case ParsecParser UserConstraint
-> String -> Either String UserConstraint
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser UserConstraint
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec String
str of
Left String
err -> String -> Either String UserConstraint
forall a b. a -> Either a b
Left (String -> Either String UserConstraint)
-> String -> Either String UserConstraint
forall a b. (a -> b) -> a -> b
$ String
msgCannotParse String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
Right UserConstraint
c -> UserConstraint -> Either String UserConstraint
forall a b. b -> Either a b
Right UserConstraint
c
where
msgCannotParse :: String
msgCannotParse =
String
"expected a (possibly qualified) package name followed by a " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"constraint, which is either a version range, 'installed', " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"'source', 'test', 'bench', or flags. "
instance Pretty UserConstraint where
pretty :: UserConstraint -> Doc
pretty (UserConstraint UserConstraintScope
scope PackageProperty
prop) =
PackageConstraint -> Doc
dispPackageConstraint (PackageConstraint -> Doc) -> PackageConstraint -> Doc
forall a b. (a -> b) -> a -> b
$ ConstraintScope -> PackageProperty -> PackageConstraint
PackageConstraint (UserConstraintScope -> ConstraintScope
fromUserConstraintScope UserConstraintScope
scope) PackageProperty
prop
instance Parsec UserConstraint where
parsec :: m UserConstraint
parsec = do
UserConstraintScope
scope <- m UserConstraintScope
forall (m :: * -> *). CabalParsing m => m UserConstraintScope
parseConstraintScope
m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
PackageProperty
prop <- [m PackageProperty] -> m PackageProperty
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
[ FlagAssignment -> PackageProperty
PackagePropertyFlags (FlagAssignment -> PackageProperty)
-> m FlagAssignment -> m PackageProperty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FlagAssignment
forall (m :: * -> *). CabalParsing m => m FlagAssignment
parsecFlagAssignmentNonEmpty
, VersionRange -> PackageProperty
PackagePropertyVersion (VersionRange -> PackageProperty)
-> m VersionRange -> m PackageProperty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
, PackageProperty
PackagePropertyInstalled PackageProperty -> m String -> m PackageProperty
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"installed"
, PackageProperty
PackagePropertySource PackageProperty -> m String -> m PackageProperty
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"source"
, [OptionalStanza] -> PackageProperty
PackagePropertyStanzas [OptionalStanza
TestStanzas] PackageProperty -> m String -> m PackageProperty
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"test"
, [OptionalStanza] -> PackageProperty
PackagePropertyStanzas [OptionalStanza
BenchStanzas] PackageProperty -> m String -> m PackageProperty
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"bench"
]
UserConstraint -> m UserConstraint
forall (m :: * -> *) a. Monad m => a -> m a
return (UserConstraintScope -> PackageProperty -> UserConstraint
UserConstraint UserConstraintScope
scope PackageProperty
prop)
where
parseConstraintScope :: forall m. CabalParsing m => m UserConstraintScope
parseConstraintScope :: m UserConstraintScope
parseConstraintScope = do
PackageName
pn <- m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
[m UserConstraintScope] -> m UserConstraintScope
forall (m :: * -> *) a. Alternative m => [m a] -> m a
P.choice
[ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'.' m Char -> m UserConstraintScope -> m UserConstraintScope
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PackageName -> m UserConstraintScope
withDot PackageName
pn
, Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m Char -> m UserConstraintScope -> m UserConstraintScope
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PackageName -> m UserConstraintScope
withColon PackageName
pn
, UserConstraintScope -> m UserConstraintScope
forall (m :: * -> *) a. Monad m => a -> m a
return (UserQualifier -> PackageName -> UserConstraintScope
UserQualified UserQualifier
UserQualToplevel PackageName
pn)
]
where
withDot :: PackageName -> m UserConstraintScope
withDot :: PackageName -> m UserConstraintScope
withDot PackageName
pn
| PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"any" = PackageName -> UserConstraintScope
UserAnyQualifier (PackageName -> UserConstraintScope)
-> m PackageName -> m UserConstraintScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
| PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== String -> PackageName
mkPackageName String
"setup" = PackageName -> UserConstraintScope
UserAnySetupQualifier (PackageName -> UserConstraintScope)
-> m PackageName -> m UserConstraintScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
| Bool
otherwise = String -> m UserConstraintScope
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected (String -> m UserConstraintScope)
-> String -> m UserConstraintScope
forall a b. (a -> b) -> a -> b
$ String
"constraint scope: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> String
unPackageName PackageName
pn
withColon :: PackageName -> m UserConstraintScope
withColon :: PackageName -> m UserConstraintScope
withColon PackageName
pn = UserQualifier -> PackageName -> UserConstraintScope
UserQualified (PackageName -> UserQualifier
UserQualSetup PackageName
pn)
(PackageName -> UserConstraintScope)
-> m String -> m (PackageName -> UserConstraintScope)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
P.string String
"setup."
m (PackageName -> UserConstraintScope)
-> m PackageName -> m UserConstraintScope
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m PackageName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec