{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE OverloadedStrings #-}
-- | License: GPL-3.0-or-later AND BSD-3-Clause
--
module Cabal.Project (
    -- * Project
    Project (..),
    triverseProject,
    emptyProject,
    -- * Parse project
    readProject,
    parseProject,
    -- * Resolve project
    resolveProject,
    ResolveError (..),
    renderResolveError,
    -- * Read packages
    readPackagesOfProject
    ) where

import Control.DeepSeq            (NFData (..))
import Control.Exception          (Exception (..), throwIO)
import Control.Monad.IO.Class     (liftIO)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Data.Bifoldable            (Bifoldable (..))
import Data.Bifunctor             (Bifunctor (..))
import Data.Bitraversable         (Bitraversable (..), bifoldMapDefault, bimapDefault)
import Data.ByteString            (ByteString)
import Data.Either                (partitionEithers)
import Data.Foldable              (toList)
import Data.Function              ((&))
import Data.Functor               (void)
import Data.List                  (foldl', isSuffixOf)
import Data.List.NonEmpty         (NonEmpty)
import Data.Maybe                 (mapMaybe)
import Data.Traversable           (for)
import Data.Void                  (Void)
import Distribution.Compat.Lens   (LensLike', over)
import GHC.Generics               (Generic)
import Network.URI                (URI (URI), parseURI)
import System.Directory           (doesDirectoryExist, doesFileExist)
import System.FilePath            (isAbsolute, normalise, splitDirectories, splitDrive, takeDirectory, (</>))

import qualified Data.ByteString                 as BS
import qualified Data.Map.Strict                 as M
import qualified Distribution.CabalSpecVersion   as C
import qualified Distribution.FieldGrammar       as C
import qualified Distribution.Fields             as C
import qualified Distribution.PackageDescription as C
import qualified Distribution.Parsec             as C

import Cabal.Internal.Glob
import Cabal.Internal.Newtypes
import Cabal.Optimization
import Cabal.Package
import Cabal.Parse
import Cabal.SourceRepo

infixl 1 <&>
(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- $setup
-- >>> :set -XOverloadedStrings

-- | @cabal.project@ file
data Project uri opt pkg = Project
    { forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages     :: [pkg]  -- ^ packages field
    , forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages  :: [opt]  -- ^ optional packages
    , forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages  :: [uri]  -- ^ URI packages, filled in by 'resolveProject'
    , forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints  :: [String] -- ^ constaints, parsed as 'String's.
    , forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer   :: [String] -- ^ allow-newer, parsed as 'String's.
    , forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals :: Bool
    , forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps :: Maybe Int
    , forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization :: Optimization
    , forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos  :: [SourceRepositoryPackage Maybe]
    , forall uri opt pkg. Project uri opt pkg -> [PrettyField ()]
prjOtherFields  :: [C.PrettyField ()] -- ^ other fields
    }
  deriving (forall a b. a -> Project uri opt b -> Project uri opt a
forall a b. (a -> b) -> Project uri opt a -> Project uri opt b
forall uri opt a b. a -> Project uri opt b -> Project uri opt a
forall uri opt a b.
(a -> b) -> Project uri opt a -> Project uri opt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Project uri opt b -> Project uri opt a
$c<$ :: forall uri opt a b. a -> Project uri opt b -> Project uri opt a
fmap :: forall a b. (a -> b) -> Project uri opt a -> Project uri opt b
$cfmap :: forall uri opt a b.
(a -> b) -> Project uri opt a -> Project uri opt b
Functor, forall a. Project uri opt a -> Bool
forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
forall uri opt a. Eq a => a -> Project uri opt a -> Bool
forall uri opt a. Num a => Project uri opt a -> a
forall uri opt a. Ord a => Project uri opt a -> a
forall uri opt m. Monoid m => Project uri opt m -> m
forall uri opt pkg. Project uri opt pkg -> Bool
forall uri opt a. Project uri opt a -> Int
forall uri opt pkg. Project uri opt pkg -> [pkg]
forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
forall uri opt a b. (a -> b -> b) -> b -> Project uri opt 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 :: forall a. Num a => Project uri opt a -> a
$cproduct :: forall uri opt a. Num a => Project uri opt a -> a
sum :: forall a. Num a => Project uri opt a -> a
$csum :: forall uri opt a. Num a => Project uri opt a -> a
minimum :: forall a. Ord a => Project uri opt a -> a
$cminimum :: forall uri opt a. Ord a => Project uri opt a -> a
maximum :: forall a. Ord a => Project uri opt a -> a
$cmaximum :: forall uri opt a. Ord a => Project uri opt a -> a
elem :: forall a. Eq a => a -> Project uri opt a -> Bool
$celem :: forall uri opt a. Eq a => a -> Project uri opt a -> Bool
length :: forall a. Project uri opt a -> Int
$clength :: forall uri opt a. Project uri opt a -> Int
null :: forall a. Project uri opt a -> Bool
$cnull :: forall uri opt pkg. Project uri opt pkg -> Bool
toList :: forall a. Project uri opt a -> [a]
$ctoList :: forall uri opt pkg. Project uri opt pkg -> [pkg]
foldl1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$cfoldl1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldr1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$cfoldr1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
$cfoldl' :: forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
$cfoldl :: forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
$cfoldr' :: forall uri opt a b. (a -> b -> b) -> b -> Project uri opt a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
$cfoldr :: forall uri opt a b. (a -> b -> b) -> b -> Project uri opt a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
$cfoldMap' :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
$cfoldMap :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
fold :: forall m. Monoid m => Project uri opt m -> m
$cfold :: forall uri opt m. Monoid m => Project uri opt m -> m
Foldable, forall uri opt. Functor (Project uri opt)
forall uri opt. Foldable (Project uri opt)
forall uri opt (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
forall uri opt (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
forall uri opt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
forall uri opt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
$csequence :: forall uri opt (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
$cmapM :: forall uri opt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
$csequenceA :: forall uri opt (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
$ctraverse :: forall uri opt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall uri opt pkg x.
Rep (Project uri opt pkg) x -> Project uri opt pkg
forall uri opt pkg x.
Project uri opt pkg -> Rep (Project uri opt pkg) x
$cto :: forall uri opt pkg x.
Rep (Project uri opt pkg) x -> Project uri opt pkg
$cfrom :: forall uri opt pkg x.
Project uri opt pkg -> Rep (Project uri opt pkg) x
Generic)

-- | Doesn't compare 'prjOtherFields'
instance (Eq uri, Eq opt, Eq pkg) => Eq (Project uri opt pkg) where
    Project uri opt pkg
x == :: Project uri opt pkg -> Project uri opt pkg -> Bool
== Project uri opt pkg
y = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization
        , forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos
        ]
      where
        eqOn :: (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> a
f = Project uri opt pkg -> a
f Project uri opt pkg
x forall a. Eq a => a -> a -> Bool
== Project uri opt pkg -> a
f Project uri opt pkg
y

-- | Doesn't show 'prjOtherFields'
--
-- @since 0.4.4
instance (Show uri, Show opt, Show pkg) => Show (Project uri opt pkg) where
    showsPrec :: Int -> Project uri opt pkg -> ShowS
showsPrec Int
p Project uri opt pkg
prj =
        Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
            ( [Char] -> ShowS
showString [Char]
"Project{prjPackages = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptPackages = "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjUriPackages = "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjConstraints = "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjAllowNewer = "     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjReorderGoals = "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjMaxBackjumps = "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptimization = "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjSourceRepos = "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
            )

instance Bifunctor (Project c) where bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Project c a c -> Project c b d
bimap = forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifoldable (Project c) where bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Project c a b -> m
bifoldMap = forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

-- | 'traverse' over all three type arguments of 'Project'.
triverseProject
    :: Applicative f
    => (uri -> f uri')
    -> (opt -> f opt')
    -> (pkg -> f pkg')
    -> Project uri opt pkg -> f (Project uri' opt' pkg')
triverseProject :: forall (f :: * -> *) uri uri' opt opt' pkg pkg'.
Applicative f =>
(uri -> f uri')
-> (opt -> f opt')
-> (pkg -> f pkg')
-> Project uri opt pkg
-> f (Project uri' opt' pkg')
triverseProject uri -> f uri'
f opt -> f opt'
g pkg -> f pkg'
h Project uri opt pkg
prj =
    (\[uri']
c [opt']
b [pkg']
a -> Project uri opt pkg
prj { prjPackages :: [pkg']
prjPackages = [pkg']
a, prjOptPackages :: [opt']
prjOptPackages = [opt']
b, prjUriPackages :: [uri']
prjUriPackages = [uri']
c })
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse uri -> f uri'
f (forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse opt -> f opt'
g (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse pkg -> f pkg'
h (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj)

instance Bitraversable (Project uri) where
    bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Project uri a b -> f (Project uri c d)
bitraverse = forall (f :: * -> *) uri uri' opt opt' pkg pkg'.
Applicative f =>
(uri -> f uri')
-> (opt -> f opt')
-> (pkg -> f pkg')
-> Project uri opt pkg
-> f (Project uri' opt' pkg')
triverseProject forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Empty project.
emptyProject :: Project c b a
emptyProject :: forall c b a. Project c b a
emptyProject = forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project [] [] [] [] [] Bool
False forall a. Maybe a
Nothing Optimization
OptimizationOn [] []

-- | @since 0.2.1
instance (NFData c, NFData b, NFData a) => NFData (Project c b a) where
    rnf :: Project c b a -> ()
rnf (Project [a]
x1 [b]
x2 [c]
x3 [[Char]]
x4 [[Char]]
x5 Bool
x6 Maybe Int
x7 Optimization
x8 [SourceRepositoryPackage Maybe]
x9 [PrettyField ()]
x10) =
        forall a. NFData a => a -> ()
rnf [a]
x1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [b]
x2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [c]
x3 seq :: forall a b. a -> b -> b
`seq`
        forall a. NFData a => a -> ()
rnf [[Char]]
x4 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [[Char]]
x5 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Bool
x6 seq :: forall a b. a -> b -> b
`seq`
        forall a. NFData a => a -> ()
rnf Maybe Int
x7 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Optimization
x8 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [SourceRepositoryPackage Maybe]
x9 seq :: forall a b. a -> b -> b
`seq`
        forall a. (a -> ()) -> [a] -> ()
rnfList forall x. NFData x => PrettyField x -> ()
rnfPrettyField [PrettyField ()]
x10
      where
        rnfList :: (a -> ()) -> [a] -> ()
        rnfList :: forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
_ []     = ()
        rnfList a -> ()
f (a
x:[a]
xs) = a -> ()
f a
x seq :: forall a b. a -> b -> b
`seq` forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
f [a]
xs

        rnfPrettyField :: NFData x => C.PrettyField x -> ()
        rnfPrettyField :: forall x. NFData x => PrettyField x -> ()
rnfPrettyField PrettyField x
C.PrettyEmpty = ()
        rnfPrettyField (C.PrettyField x
ann FieldName
fn Doc
d) =
            forall a. NFData a => a -> ()
rnf x
ann seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf FieldName
fn seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Doc
d
        rnfPrettyField (C.PrettySection x
ann FieldName
fn [Doc]
ds [PrettyField x]
fs) =
            forall a. NFData a => a -> ()
rnf x
ann seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf FieldName
fn seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Doc]
ds seq :: forall a b. a -> b -> b
`seq` forall a. (a -> ()) -> [a] -> ()
rnfList forall x. NFData x => PrettyField x -> ()
rnfPrettyField [PrettyField x]
fs

-------------------------------------------------------------------------------
-- Initial  parsing
-------------------------------------------------------------------------------

-- | High level convenience function to read and elaborate @cabal.project@ files
--
-- May throw 'IOException' when file doesn't exist, 'ParseError'
-- on parse errors, or 'ResolveError' on package resolution error.
--
readProject :: FilePath -> IO (Project URI Void (FilePath, C.GenericPackageDescription))
readProject :: [Char] -> IO (Project URI Void ([Char], GenericPackageDescription))
readProject [Char]
fp = do
    FieldName
contents <- [Char] -> IO FieldName
BS.readFile [Char]
fp
    Project Void [Char] [Char]
prj0 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
parseProject [Char]
fp FieldName
contents)
    Project URI Void [Char]
prj1 <- [Char]
-> Project Void [Char] [Char]
-> IO (Either ResolveError (Project URI Void [Char]))
resolveProject [Char]
fp Project Void [Char] [Char]
prj0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return
    forall uri opt.
Project uri opt [Char]
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt ([Char], GenericPackageDescription)))
readPackagesOfProject Project URI Void [Char]
prj1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Parse project file. Extracts only few fields.
--
-- >>> fmap prjPackages $ parseProject "cabal.project" "packages: foo bar/*.cabal"
-- Right ["foo","bar/*.cabal"]
--
parseProject :: FilePath -> ByteString -> Either (ParseError NonEmpty) (Project Void String String)
parseProject :: [Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
parseProject = forall a.
([Field Position] -> ParseResult a)
-> [Char] -> FieldName -> Either (ParseError NonEmpty) a
parseWith forall a b. (a -> b) -> a -> b
$ \[Field Position]
fields0 -> do
    let (Fields Position
fields1, [[Section Position]]
sections) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields0
    let fields2 :: Fields Position
fields2  = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\FieldName
k [NamelessField Position]
_ -> FieldName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldName]
knownFields) Fields Position
fields1
    forall {t :: * -> *} {a}.
Foldable t =>
[Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void [Char] [Char])
parse [Field Position]
fields0 Fields Position
fields2 [[Section Position]]
sections
  where
    knownFields :: [FieldName]
knownFields = forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar []

    parse :: [Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void [Char] [Char])
parse [Field a]
otherFields Fields Position
fields t [Section Position]
sections = do
        let prettyOtherFields :: [PrettyField ()]
prettyOtherFields = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall ann. [Field ann] -> [PrettyField ann]
C.fromParsecFields forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall ann. Field ann -> Bool
otherFieldName [Field a]
otherFields
        Project Void [Char] [Char]
prj <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
prettyOtherFields
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. a -> (a -> b) -> b
(&) Project Void [Char] [Char]
prj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Section Position
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
parseSec (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Section Position]
sections)

    -- Special case for source-repository-package. If you add another such
    -- special case, make sure to update otherFieldName appropriately.
    parseSec :: C.Section C.Position -> C.ParseResult (Project Void String String -> Project Void String String)
    parseSec :: Section Position
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
parseSec (C.MkSection (C.Name Position
_pos FieldName
name) [] [Field Position]
fields) | FieldName
name forall a. Eq a => a -> a -> Bool
== FieldName
sourceRepoSectionName = do
        let fields' :: Fields Position
fields' = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields
        SourceRepoList
repos <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields' forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (List NoCommaFSep FilePathNT [Char]), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut SourceRepoList
repos))

    parseSec Section Position
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id

-- | Returns 'True' if a field should be a part of 'prjOtherFields'. This
-- excludes any field that is a part of 'grammar' as well as
-- @source-repository-package@ (see 'parseProject', which has a special case
-- for it).
otherFieldName :: C.Field ann -> Bool
otherFieldName :: forall ann. Field ann -> Bool
otherFieldName (C.Field (C.Name ann
_ FieldName
fn) [FieldLine ann]
_)     = FieldName
fn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList ([PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [])
otherFieldName (C.Section (C.Name ann
_ FieldName
fn) [SectionArg ann]
_ [Field ann]
_) = FieldName
fn forall a. Eq a => a -> a -> Bool
/= FieldName
sourceRepoSectionName

-- | This contains a subset of the fields in the @cabal.project@ grammar that
-- are distinguished by a 'Project'. Note that this does not /not/ contain
-- @source-repository-package@, as that is handled separately in 'parseProject'.
grammar :: [C.PrettyField ()] -> C.ParsecFieldGrammar (Project Void String String) (Project Void String String)
grammar :: [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
otherFields = forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"packages"          (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"optional-packages" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"constraints"       (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas)   forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjConstraintsL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"allow-newer"       (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas)   forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjAllowNewerL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
C.booleanFieldDef  FieldName
"reorder-goals"                                         forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool
False
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
C.optionalFieldAla FieldName
"max-backjumps"     Int -> Int'
Int'                                forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
C.optionalFieldDef FieldName
"optimization"                                          forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization
OptimizationOn
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [PrettyField ()]
otherFields

sourceRepoSectionName :: C.FieldName
sourceRepoSectionName :: FieldName
sourceRepoSectionName = FieldName
"source-repository-package"

-------------------------------------------------------------------------------
-- Lenses
-------------------------------------------------------------------------------

prjPackagesL :: Functor f => LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL [pkg] -> f [pkg]
f Project uri opt pkg
prj = [pkg] -> f [pkg]
f (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[pkg]
x -> Project uri opt pkg
prj { prjPackages :: [pkg]
prjPackages = [pkg]
x }

prjOptPackagesL :: Functor f => LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL [opt] -> f [opt]
f Project uri opt pkg
prj = [opt] -> f [opt]
f (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[opt]
x -> Project uri opt pkg
prj { prjOptPackages :: [opt]
prjOptPackages = [opt]
x }

prjConstraintsL :: Functor f => LensLike' f (Project uri opt pkg) [String]
prjConstraintsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjConstraintsL [[Char]] -> f [[Char]]
f Project uri opt pkg
prj = [[Char]] -> f [[Char]]
f (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjConstraints :: [[Char]]
prjConstraints = [[Char]]
x }

prjAllowNewerL :: Functor f => LensLike' f (Project uri opt pkg) [String]
prjAllowNewerL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjAllowNewerL [[Char]] -> f [[Char]]
f Project uri opt pkg
prj = [[Char]] -> f [[Char]]
f (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjAllowNewer :: [[Char]]
prjAllowNewer = [[Char]]
x }

prjReorderGoalsL :: Functor f => LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool -> f Bool
f Project uri opt pkg
prj = Bool -> f Bool
f (forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
x -> Project uri opt pkg
prj { prjReorderGoals :: Bool
prjReorderGoals = Bool
x }

prjMaxBackjumpsL :: Functor f => LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL Maybe Int -> f (Maybe Int)
f Project uri opt pkg
prj = Maybe Int -> f (Maybe Int)
f (forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Int
x -> Project uri opt pkg
prj { prjMaxBackjumps :: Maybe Int
prjMaxBackjumps = Maybe Int
x }

prjOptimizationL :: Functor f => LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization -> f Optimization
f Project uri opt pkg
prj = Optimization -> f Optimization
f (forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Optimization
x -> Project uri opt pkg
prj { prjOptimization :: Optimization
prjOptimization = Optimization
x }

prjSourceReposL :: Functor f => LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL [SourceRepositoryPackage Maybe]
-> f [SourceRepositoryPackage Maybe]
f Project uri opt pkg
prj = [SourceRepositoryPackage Maybe]
-> f [SourceRepositoryPackage Maybe]
f (forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[SourceRepositoryPackage Maybe]
x -> Project uri opt pkg
prj { prjSourceRepos :: [SourceRepositoryPackage Maybe]
prjSourceRepos = [SourceRepositoryPackage Maybe]
x }

-------------------------------------------------------------------------------
-- Resolving
-------------------------------------------------------------------------------

-- | A 'resolveProject' error.
newtype ResolveError = BadPackageLocation String
  deriving Int -> ResolveError -> ShowS
[ResolveError] -> ShowS
ResolveError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResolveError] -> ShowS
$cshowList :: [ResolveError] -> ShowS
show :: ResolveError -> [Char]
$cshow :: ResolveError -> [Char]
showsPrec :: Int -> ResolveError -> ShowS
$cshowsPrec :: Int -> ResolveError -> ShowS
Show

instance Exception ResolveError where
    displayException :: ResolveError -> [Char]
displayException = ResolveError -> [Char]
renderResolveError

-- | Pretty print 'ResolveError'.
renderResolveError :: ResolveError -> String
renderResolveError :: ResolveError -> [Char]
renderResolveError (BadPackageLocation [Char]
s) = [Char]
"Bad package location: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
s

-- | Resolve project package locations.
--
-- Separate 'URI' packages, glob @packages@ and @optional-packages@
-- into individual fields.
--
-- The result 'prjPackages' 'FilePath's will be relative to the
-- directory of the project file.
--
resolveProject
    :: FilePath                                        -- ^ filename of project file
    -> Project Void String String                      -- ^ parsed project file
    -> IO (Either ResolveError (Project URI Void FilePath))  -- ^ resolved project
resolveProject :: [Char]
-> Project Void [Char] [Char]
-> IO (Either ResolveError (Project URI Void [Char]))
resolveProject [Char]
filePath Project Void [Char] [Char]
prj = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    Project Void [Either URI [Char]] [Either URI [Char]]
prj' <- forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findOptProjectPackage [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findProjectPackage Project Void [Char] [Char]
prj
    let ([URI]
uris,  [[Char]]
pkgs)  = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
    let ([URI]
uris', [[Char]]
pkgs') = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
    forall (m :: * -> *) a. Monad m => a -> m a
return Project Void [Either URI [Char]] [Either URI [Char]]
prj'
        { prjPackages :: [[Char]]
prjPackages    = [[Char]]
pkgs forall a. [a] -> [a] -> [a]
++ [[Char]]
pkgs'
        , prjOptPackages :: [Void]
prjOptPackages = []
        , prjUriPackages :: [URI]
prjUriPackages = [URI]
uris forall a. [a] -> [a] -> [a]
++ [URI]
uris'
        }
  where
    rootdir :: [Char]
rootdir = ShowS
takeDirectory [Char]
filePath
    addroot :: ShowS
addroot [Char]
p = ShowS
normalise ([Char]
rootdir [Char] -> ShowS
</> [Char]
p)

    findProjectPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
    findProjectPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findProjectPackage [Char]
pkglocstr = do
        [Either URI [Char]]
mfp <- [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
               [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
               forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall {a}. a -> [a]
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) ([Char] -> Maybe URI
parseURI [Char]
pkglocstr))
        case [Either URI [Char]]
mfp of
            [] -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ [Char] -> ResolveError
BadPackageLocation [Char]
pkglocstr
            [Either URI [Char]]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return [Either URI [Char]]
mfp

    singleton :: a -> [a]
singleton a
x = [a
x]

    findOptProjectPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
    findOptProjectPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findOptProjectPackage [Char]
pkglocstr =
        [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
        [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr

    checkIsSingleFilePackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
    checkIsSingleFilePackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr = do
        let abspath :: [Char]
abspath = ShowS
addroot [Char]
pkglocstr
        Bool
isFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
abspath
        Bool
isDir  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist [Char]
abspath
        if | Bool
isFile, Just Either URI [Char]
p <- [Char] -> Maybe (Either URI [Char])
checkFile [Char]
abspath -> forall (m :: * -> *) a. Monad m => a -> m a
return [Either URI [Char]
p]
           | Bool
isDir                               -> FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob ([Char] -> FilePathGlob
globStarDotCabal [Char]
pkglocstr)
           | Bool
otherwise                           -> forall (m :: * -> *) a. Monad m => a -> m a
return []

    -- if it looks like glob, glob
    checkisFileGlobPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
    checkisFileGlobPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr = case forall a. Parsec a => [Char] -> Either [Char] a
C.eitherParsec [Char]
pkglocstr of
        Right FilePathGlob
g -> FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob FilePathGlob
g
        Left [Char]
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return []

    checkGlob :: FilePathGlob -> ExceptT ResolveError IO [Either URI FilePath]
    checkGlob :: FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob FilePathGlob
glob = do
        [[Char]]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> FilePathGlob -> IO [[Char]]
matchFileGlob [Char]
rootdir FilePathGlob
glob
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Char] -> Maybe (Either URI [Char])
checkFile [[Char]]
files

    checkFile :: FilePath -> Maybe (Either URI FilePath)
    checkFile :: [Char] -> Maybe (Either URI [Char])
checkFile [Char]
abspath
        | [Char]
".cabal"  forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Char]
abspath
        | [Char]
".tar.gz" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI [Char]
"file:" forall a. Maybe a
Nothing [Char]
abspath [Char]
"" [Char]
""
        | Bool
otherwise                      = forall a. Maybe a
Nothing

    -- A glob to find all the cabal files in a directory.
    --
    -- For a directory @some/dir/@, this is a glob of the form @some/dir/\*.cabal@.
    -- The directory part can be either absolute or relative.
    --
    globStarDotCabal :: FilePath -> FilePathGlob
    globStarDotCabal :: [Char] -> FilePathGlob
globStarDotCabal [Char]
dir =
        FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob
          (if [Char] -> Bool
isAbsolute [Char]
dir then [Char] -> FilePathRoot
FilePathRoot [Char]
root else FilePathRoot
FilePathRelative)
          (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[Char]
d -> Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir [[Char] -> GlobPiece
Literal [Char]
d])
                 (Glob -> FilePathGlobRel
GlobFile [GlobPiece
WildCard, [Char] -> GlobPiece
Literal [Char]
".cabal"]) [[Char]]
dirComponents)
      where
        ([Char]
root, [[Char]]
dirComponents) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [[Char]]
splitDirectories ([Char] -> ([Char], [Char])
splitDrive [Char]
dir)

    mplusMaybeT :: Monad m => m [a] -> m [a] -> m [a]
    mplusMaybeT :: forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
mplusMaybeT m [a]
ma m [a]
mb = do
        [a]
mx <- m [a]
ma
        case [a]
mx of
            [] -> m [a]
mb
            [a]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs

-------------------------------------------------------------------------------
-- Read package files
-------------------------------------------------------------------------------

-- | Read and parse the cabal files of packages in the 'Project'.
--
-- May throw 'IOException'.
--
readPackagesOfProject :: Project uri opt FilePath -> IO (Either (ParseError NonEmpty) (Project uri opt (FilePath, C.GenericPackageDescription)))
readPackagesOfProject :: forall uri opt.
Project uri opt [Char]
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt ([Char], GenericPackageDescription)))
readPackagesOfProject Project uri opt [Char]
prj = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Project uri opt [Char]
prj forall a b. (a -> b) -> a -> b
$ \[Char]
fp -> do
    FieldName
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO FieldName
BS.readFile [Char]
fp
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (\GenericPackageDescription
gpd -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fp, GenericPackageDescription
gpd)) ([Char]
-> FieldName
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage [Char]
fp FieldName
contents)