{-# 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')
import Data.List.NonEmpty           (NonEmpty)
import Data.Traversable             (for)
import Data.Void                    (Void)
import Distribution.Compat.Lens     (LensLike', over)
import GHC.Generics                 (Generic)
import Network.URI                  (URI, parseURI)
import System.Directory             (doesDirectoryExist, doesFileExist)
import System.FilePath              (takeDirectory, takeExtension, (</>))
import Text.ParserCombinators.ReadP (readP_to_S)

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
<&> :: f a -> (a -> b) -> f b
(<&>) = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
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
    { Project uri opt pkg -> [pkg]
prjPackages     :: [pkg]  -- ^ packages field
    , Project uri opt pkg -> [opt]
prjOptPackages  :: [opt]  -- ^ optional packages
    , Project uri opt pkg -> [uri]
prjUriPackages  :: [uri]  -- ^ URI packages, filled in by 'resolveProject'
    , Project uri opt pkg -> [String]
prjConstraints  :: [String] -- ^ constaints, parsed as 'String's.
    , Project uri opt pkg -> [String]
prjAllowNewer   :: [String] -- ^ allow-newer, parsed as 'String's.
    , Project uri opt pkg -> Bool
prjReorderGoals :: Bool
    , Project uri opt pkg -> Maybe Int
prjMaxBackjumps :: Maybe Int
    , Project uri opt pkg -> Optimization
prjOptimization :: Optimization
    , Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos  :: [SourceRepositoryPackage Maybe]
    , Project uri opt pkg -> [PrettyField ()]
prjOtherFields  :: [C.PrettyField ()] -- ^ other fields
    }
  deriving (a -> Project uri opt b -> Project uri opt a
(a -> b) -> Project uri opt a -> Project uri opt b
(forall a b. (a -> b) -> Project uri opt a -> Project uri opt b)
-> (forall a b. a -> Project uri opt b -> Project uri opt a)
-> Functor (Project uri opt)
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
<$ :: 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 :: (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, Project uri opt a -> Bool
(a -> m) -> Project uri opt a -> m
(a -> b -> b) -> b -> Project uri opt a -> b
(forall m. Monoid m => Project uri opt m -> m)
-> (forall m a. Monoid m => (a -> m) -> Project uri opt a -> m)
-> (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 a b. (a -> b -> b) -> b -> Project uri opt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Project uri opt a -> b)
-> (forall b a. (b -> a -> b) -> b -> Project uri opt a -> b)
-> (forall a. (a -> a -> a) -> Project uri opt a -> a)
-> (forall a. (a -> a -> a) -> Project uri opt a -> a)
-> (forall a. Project uri opt a -> [a])
-> (forall a. Project uri opt a -> Bool)
-> (forall a. Project uri opt a -> Int)
-> (forall a. Eq a => a -> Project uri opt a -> Bool)
-> (forall a. Ord a => Project uri opt a -> a)
-> (forall a. Ord a => Project uri opt a -> a)
-> (forall a. Num a => Project uri opt a -> a)
-> (forall a. Num a => Project uri opt a -> a)
-> Foldable (Project uri opt)
forall a. Eq a => a -> Project uri opt a -> Bool
forall a. Num a => Project uri opt a -> a
forall a. Ord a => Project uri opt a -> a
forall m. Monoid m => Project uri opt m -> m
forall a. Project uri opt a -> Bool
forall a. Project uri opt a -> Int
forall a. Project uri opt a -> [a]
forall a. (a -> a -> a) -> Project uri opt a -> a
forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
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 a. Project uri opt a -> Bool
forall uri opt a. Project uri opt a -> Int
forall uri opt a. Project uri opt a -> [a]
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 :: Project uri opt a -> a
$cproduct :: forall uri opt a. Num a => Project uri opt a -> a
sum :: Project uri opt a -> a
$csum :: forall uri opt a. Num a => Project uri opt a -> a
minimum :: Project uri opt a -> a
$cminimum :: forall uri opt a. Ord a => Project uri opt a -> a
maximum :: Project uri opt a -> a
$cmaximum :: forall uri opt a. Ord a => Project uri opt a -> a
elem :: a -> Project uri opt a -> Bool
$celem :: forall uri opt a. Eq a => a -> Project uri opt a -> Bool
length :: Project uri opt a -> Int
$clength :: forall uri opt a. Project uri opt a -> Int
null :: Project uri opt a -> Bool
$cnull :: forall uri opt a. Project uri opt a -> Bool
toList :: Project uri opt a -> [a]
$ctoList :: forall uri opt a. Project uri opt a -> [a]
foldl1 :: (a -> a -> a) -> Project uri opt a -> a
$cfoldl1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldr1 :: (a -> a -> a) -> Project uri opt a -> a
$cfoldr1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldl' :: (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 :: (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' :: (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 :: (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' :: (a -> m) -> Project uri opt a -> m
$cfoldMap' :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
foldMap :: (a -> m) -> Project uri opt a -> m
$cfoldMap :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
fold :: Project uri opt m -> m
$cfold :: forall uri opt m. Monoid m => Project uri opt m -> m
Foldable, Functor (Project uri opt)
Foldable (Project uri opt)
Functor (Project uri opt)
-> Foldable (Project uri opt)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Project uri opt a -> f (Project uri opt b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Project uri opt (f a) -> f (Project uri opt a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Project uri opt a -> m (Project uri opt b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Project uri opt (m a) -> m (Project uri opt a))
-> Traversable (Project uri opt)
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
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 (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
forall (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
sequence :: 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 :: (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 :: 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 :: (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)
$cp2Traversable :: forall uri opt. Foldable (Project uri opt)
$cp1Traversable :: forall uri opt. Functor (Project uri opt)
Traversable, (forall x. Project uri opt pkg -> Rep (Project uri opt pkg) x)
-> (forall x. Rep (Project uri opt pkg) x -> Project uri opt pkg)
-> Generic (Project uri opt pkg)
forall x. Rep (Project uri opt pkg) x -> Project uri opt pkg
forall x. Project uri opt pkg -> Rep (Project uri opt pkg) x
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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ (Project uri opt pkg -> [pkg]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [pkg]
forall uri opt a. Project uri opt a -> [a]
prjPackages
        , (Project uri opt pkg -> [opt]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [opt]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages
        , (Project uri opt pkg -> [uri]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [uri]
forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages
        , (Project uri opt pkg -> [String]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [String]
forall uri opt pkg. Project uri opt pkg -> [String]
prjConstraints
        , (Project uri opt pkg -> [String]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [String]
forall uri opt pkg. Project uri opt pkg -> [String]
prjAllowNewer
        , (Project uri opt pkg -> Bool) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> Bool
forall uri opt a. Project uri opt a -> Bool
prjReorderGoals
        , (Project uri opt pkg -> Maybe Int) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> Maybe Int
forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps
        , (Project uri opt pkg -> Optimization) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> Optimization
forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization
        , (Project uri opt pkg -> [SourceRepositoryPackage Maybe]) -> Bool
forall a. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [SourceRepositoryPackage Maybe]
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Project uri opt pkg -> a
f Project uri opt pkg
y

instance Bifunctor (Project c) where bimap :: (a -> b) -> (c -> d) -> Project c a c -> Project c b d
bimap = (a -> b) -> (c -> d) -> Project c a c -> Project c b d
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 :: (a -> m) -> (b -> m) -> Project c a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Project c a b -> m
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 :: (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 })
        ([uri'] -> [opt'] -> [pkg'] -> Project uri' opt' pkg')
-> f [uri'] -> f ([opt'] -> [pkg'] -> Project uri' opt' pkg')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (uri -> f uri') -> [uri] -> f [uri']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse uri -> f uri'
f (Project uri opt pkg -> [uri]
forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
        f ([opt'] -> [pkg'] -> Project uri' opt' pkg')
-> f [opt'] -> f ([pkg'] -> Project uri' opt' pkg')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (opt -> f opt') -> [opt] -> f [opt']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse opt -> f opt'
g (Project uri opt pkg -> [opt]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
        f ([pkg'] -> Project uri' opt' pkg')
-> f [pkg'] -> f (Project uri' opt' pkg')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (pkg -> f pkg') -> [pkg] -> f [pkg']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse pkg -> f pkg'
h (Project uri opt pkg -> [pkg]
forall uri opt a. Project uri opt a -> [a]
prjPackages Project uri opt pkg
prj)

instance Bitraversable (Project uri) where
    bitraverse :: (a -> f c) -> (b -> f d) -> Project uri a b -> f (Project uri c d)
bitraverse = (uri -> f uri)
-> (a -> f c)
-> (b -> f d)
-> Project uri a b
-> f (Project uri c d)
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
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Empty project.
emptyProject :: Project c b a
emptyProject :: Project c b a
emptyProject = [a]
-> [b]
-> [c]
-> [String]
-> [String]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project c b a
forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [String]
-> [String]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project [] [] [] [] [] Bool
False Maybe Int
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 [String]
x4 [String]
x5 Bool
x6 Maybe Int
x7 Optimization
x8 [SourceRepositoryPackage Maybe]
x9 [PrettyField ()]
x10) =
        [a] -> ()
forall a. NFData a => a -> ()
rnf [a]
x1 () -> () -> ()
`seq` [b] -> ()
forall a. NFData a => a -> ()
rnf [b]
x2 () -> () -> ()
`seq` [c] -> ()
forall a. NFData a => a -> ()
rnf [c]
x3 () -> () -> ()
`seq`
        [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
x4 () -> () -> ()
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
x5 () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
x6 () -> () -> ()
`seq`
        Maybe Int -> ()
forall a. NFData a => a -> ()
rnf Maybe Int
x7 () -> () -> ()
`seq` Optimization -> ()
forall a. NFData a => a -> ()
rnf Optimization
x8 () -> () -> ()
`seq` [SourceRepositoryPackage Maybe] -> ()
forall a. NFData a => a -> ()
rnf [SourceRepositoryPackage Maybe]
x9 () -> () -> ()
`seq`
        (PrettyField () -> ()) -> [PrettyField ()] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList PrettyField () -> ()
forall x. NFData x => PrettyField x -> ()
rnfPrettyField [PrettyField ()]
x10
      where
        rnfList :: (a -> ()) -> [a] -> ()
        rnfList :: (a -> ()) -> [a] -> ()
rnfList a -> ()
_ []     = ()
        rnfList a -> ()
f (a
x:[a]
xs) = a -> ()
f a
x () -> () -> ()
`seq` (a -> ()) -> [a] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
f [a]
xs

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

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

-- | High level conviniene 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 :: String -> IO (Project URI Void (String, GenericPackageDescription))
readProject String
fp = do
    FieldName
contents <- String -> IO FieldName
BS.readFile String
fp
    Project Void String String
prj0 <- (ParseError NonEmpty -> IO (Project Void String String))
-> (Project Void String String -> IO (Project Void String String))
-> Either (ParseError NonEmpty) (Project Void String String)
-> IO (Project Void String String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty -> IO (Project Void String String)
forall e a. Exception e => e -> IO a
throwIO Project Void String String -> IO (Project Void String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> FieldName
-> Either (ParseError NonEmpty) (Project Void String String)
parseProject String
fp FieldName
contents)
    Project URI Void String
prj1 <- String
-> Project Void String String
-> IO (Either ResolveError (Project URI Void String))
resolveProject String
fp Project Void String String
prj0 IO (Either ResolveError (Project URI Void String))
-> (Either ResolveError (Project URI Void String)
    -> IO (Project URI Void String))
-> IO (Project URI Void String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ResolveError -> IO (Project URI Void String))
-> (Project URI Void String -> IO (Project URI Void String))
-> Either ResolveError (Project URI Void String)
-> IO (Project URI Void String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ResolveError -> IO (Project URI Void String)
forall e a. Exception e => e -> IO a
throwIO Project URI Void String -> IO (Project URI Void String)
forall (m :: * -> *) a. Monad m => a -> m a
return
    Project URI Void String
-> IO
     (Either
        (ParseError NonEmpty)
        (Project URI Void (String, GenericPackageDescription)))
forall uri opt.
Project uri opt String
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt (String, GenericPackageDescription)))
readPackagesOfProject Project URI Void String
prj1 IO
  (Either
     (ParseError NonEmpty)
     (Project URI Void (String, GenericPackageDescription)))
-> (Either
      (ParseError NonEmpty)
      (Project URI Void (String, GenericPackageDescription))
    -> IO (Project URI Void (String, GenericPackageDescription)))
-> IO (Project URI Void (String, GenericPackageDescription))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseError NonEmpty
 -> IO (Project URI Void (String, GenericPackageDescription)))
-> (Project URI Void (String, GenericPackageDescription)
    -> IO (Project URI Void (String, GenericPackageDescription)))
-> Either
     (ParseError NonEmpty)
     (Project URI Void (String, GenericPackageDescription))
-> IO (Project URI Void (String, GenericPackageDescription))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty
-> IO (Project URI Void (String, GenericPackageDescription))
forall e a. Exception e => e -> IO a
throwIO Project URI Void (String, GenericPackageDescription)
-> IO (Project URI Void (String, GenericPackageDescription))
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 :: String
-> FieldName
-> Either (ParseError NonEmpty) (Project Void String String)
parseProject = ([Field Position] -> ParseResult (Project Void String String))
-> String
-> FieldName
-> Either (ParseError NonEmpty) (Project Void String String)
forall a.
([Field Position] -> ParseResult a)
-> String -> FieldName -> Either (ParseError NonEmpty) a
parseWith (([Field Position] -> ParseResult (Project Void String String))
 -> String
 -> FieldName
 -> Either (ParseError NonEmpty) (Project Void String String))
-> ([Field Position] -> ParseResult (Project Void String String))
-> String
-> FieldName
-> Either (ParseError NonEmpty) (Project Void String String)
forall a b. (a -> b) -> a -> b
$ \[Field Position]
fields0 -> do
    let (Fields Position
fields1, [[Section Position]]
sections) = [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields0
    let fields2 :: Fields Position
fields2  = (FieldName -> [NamelessField Position] -> Bool)
-> Fields Position -> Fields Position
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\FieldName
k [NamelessField Position]
_ -> FieldName
k FieldName -> [FieldName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldName]
knownFields) Fields Position
fields1
    [Field Position]
-> Fields Position
-> [[Section Position]]
-> ParseResult (Project Void String String)
forall (t :: * -> *) a.
Foldable t =>
[Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void String String)
parse [Field Position]
fields0 Fields Position
fields2 [[Section Position]]
sections
  where
    knownFields :: [FieldName]
knownFields = ParsecFieldGrammar
  (Project Void String String) (Project Void String String)
-> [FieldName]
forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList (ParsecFieldGrammar
   (Project Void String String) (Project Void String String)
 -> [FieldName])
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
-> [FieldName]
forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
grammar []

    parse :: [Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void String String)
parse [Field a]
otherFields Fields Position
fields t [Section Position]
sections = do
        let prettyOtherFields :: [PrettyField ()]
prettyOtherFields = (PrettyField a -> PrettyField ())
-> [PrettyField a] -> [PrettyField ()]
forall a b. (a -> b) -> [a] -> [b]
map PrettyField a -> PrettyField ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([PrettyField a] -> [PrettyField ()])
-> [PrettyField a] -> [PrettyField ()]
forall a b. (a -> b) -> a -> b
$ [Field a] -> [PrettyField a]
forall ann. [Field ann] -> [PrettyField ann]
C.fromParsecFields ([Field a] -> [PrettyField a]) -> [Field a] -> [PrettyField a]
forall a b. (a -> b) -> a -> b
$ (Field a -> Bool) -> [Field a] -> [Field a]
forall a. (a -> Bool) -> [a] -> [a]
filter Field a -> Bool
forall ann. Field ann -> Bool
otherFieldName [Field a]
otherFields
        Project Void String String
prj <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
-> ParseResult (Project Void String String)
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields (ParsecFieldGrammar
   (Project Void String String) (Project Void String String)
 -> ParseResult (Project Void String String))
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
-> ParseResult (Project Void String String)
forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
grammar [PrettyField ()]
prettyOtherFields
        (Project Void String String
 -> (Project Void String String -> Project Void String String)
 -> Project Void String String)
-> Project Void String String
-> [Project Void String String -> Project Void String String]
-> Project Void String String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Project Void String String
-> (Project Void String String -> Project Void String String)
-> Project Void String String
forall a b. a -> (a -> b) -> b
(&) Project Void String String
prj ([Project Void String String -> Project Void String String]
 -> Project Void String String)
-> ParseResult
     [Project Void String String -> Project Void String String]
-> ParseResult (Project Void String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Section Position
 -> ParseResult
      (Project Void String String -> Project Void String String))
-> [Section Position]
-> ParseResult
     [Project Void String String -> Project Void String String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Section Position
-> ParseResult
     (Project Void String String -> Project Void String String)
parseSec (t [Section Position] -> [Section Position]
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 String String -> Project Void String String)
parseSec (C.MkSection (C.Name Position
_pos FieldName
name) [] [Field Position]
fields) | FieldName
name FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
sourceRepoSectionName = do
        let fields' :: Fields Position
fields' = (Fields Position, [[Section Position]]) -> Fields Position
forall a b. (a, b) -> a
fst ((Fields Position, [[Section Position]]) -> Fields Position)
-> (Fields Position, [[Section Position]]) -> Fields Position
forall a b. (a -> b) -> a -> b
$ [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields
        SourceRepoList
repos <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar SourceRepoList SourceRepoList
-> ParseResult SourceRepoList
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields' ParsecFieldGrammar SourceRepoList SourceRepoList
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
 c (List NoCommaFSep FilePathNT String), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar
        (Project Void String String -> Project Void String String)
-> ParseResult
     (Project Void String String -> Project Void String String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Project Void String String -> Project Void String String)
 -> ParseResult
      (Project Void String String -> Project Void String String))
-> (Project Void String String -> Project Void String String)
-> ParseResult
     (Project Void String String -> Project Void String String)
forall a b. (a -> b) -> a -> b
$ ASetter
  (Project Void String String)
  (Project Void String String)
  [SourceRepositoryPackage Maybe]
  [SourceRepositoryPackage Maybe]
-> ([SourceRepositoryPackage Maybe]
    -> [SourceRepositoryPackage Maybe])
-> Project Void String String
-> Project Void String String
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Project Void String String)
  (Project Void String String)
  [SourceRepositoryPackage Maybe]
  [SourceRepositoryPackage Maybe]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL ([SourceRepositoryPackage Maybe]
-> [SourceRepositoryPackage Maybe]
-> [SourceRepositoryPackage Maybe]
forall a. [a] -> [a] -> [a]
++ NonEmpty (SourceRepositoryPackage Maybe)
-> [SourceRepositoryPackage Maybe]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut SourceRepoList
repos))

    parseSec Section Position
_ = (Project Void String String -> Project Void String String)
-> ParseResult
     (Project Void String String -> Project Void String String)
forall (m :: * -> *) a. Monad m => a -> m a
return Project Void String String -> Project Void String String
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 :: Field ann -> Bool
otherFieldName (C.Field (C.Name ann
_ FieldName
fn) [FieldLine ann]
_)     = FieldName
fn FieldName -> [FieldName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ParsecFieldGrammar
  (Project Void String String) (Project Void String String)
-> [FieldName]
forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList ([PrettyField ()]
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
grammar [])
otherFieldName (C.Section (C.Name ann
_ FieldName
fn) [SectionArg ann]
_ [Field ann]
_) = FieldName
fn FieldName -> FieldName -> Bool
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 String String) (Project Void String String)
grammar [PrettyField ()]
otherFields = [String]
-> [String]
-> [Void]
-> [String]
-> [String]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project Void String String
forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [String]
-> [String]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project
    ([String]
 -> [String]
 -> [Void]
 -> [String]
 -> [String]
 -> Bool
 -> Maybe Int
 -> Optimization
 -> [SourceRepositoryPackage Maybe]
 -> [PrettyField ()]
 -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [String]
-> ParsecFieldGrammar
     (Project Void String String)
     ([String]
      -> [Void]
      -> [String]
      -> [String]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([String] -> List FSep PackageLocation String)
-> ALens' (Project Void String String) [String]
-> ParsecFieldGrammar (Project Void String String) [String]
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"          (FSep
-> (String -> PackageLocation)
-> [String]
-> List FSep PackageLocation String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep String -> PackageLocation
PackageLocation) ALens' (Project Void String String) [String]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL
    ParsecFieldGrammar
  (Project Void String String)
  ([String]
   -> [Void]
   -> [String]
   -> [String]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [String]
-> ParsecFieldGrammar
     (Project Void String String)
     ([Void]
      -> [String]
      -> [String]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List FSep PackageLocation String)
-> ALens' (Project Void String String) [String]
-> ParsecFieldGrammar (Project Void String String) [String]
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" (FSep
-> (String -> PackageLocation)
-> [String]
-> List FSep PackageLocation String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep String -> PackageLocation
PackageLocation) ALens' (Project Void String String) [String]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL
    ParsecFieldGrammar
  (Project Void String String)
  ([Void]
   -> [String]
   -> [String]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [Void]
-> ParsecFieldGrammar
     (Project Void String String)
     ([String]
      -> [String]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Void] -> ParsecFieldGrammar (Project Void String String) [Void]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ParsecFieldGrammar
  (Project Void String String)
  ([String]
   -> [String]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [String]
-> ParsecFieldGrammar
     (Project Void String String)
     ([String]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List CommaVCat NoCommas String)
-> ALens' (Project Void String String) [String]
-> ParsecFieldGrammar (Project Void String String) [String]
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"       (CommaVCat
-> (String -> NoCommas)
-> [String]
-> List CommaVCat NoCommas String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat String -> NoCommas
NoCommas)   ALens' (Project Void String String) [String]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [String]
prjConstraintsL
    ParsecFieldGrammar
  (Project Void String String)
  ([String]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [String]
-> ParsecFieldGrammar
     (Project Void String String)
     (Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([String] -> List CommaVCat NoCommas String)
-> ALens' (Project Void String String) [String]
-> ParsecFieldGrammar (Project Void String String) [String]
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"       (CommaVCat
-> (String -> NoCommas)
-> [String]
-> List CommaVCat NoCommas String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat String -> NoCommas
NoCommas)   ALens' (Project Void String String) [String]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [String]
prjAllowNewerL
    ParsecFieldGrammar
  (Project Void String String)
  (Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) Bool
-> ParsecFieldGrammar
     (Project Void String String)
     (Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' (Project Void String String) Bool
-> Bool
-> ParsecFieldGrammar (Project Void String String) Bool
forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
C.booleanFieldDef  FieldName
"reorder-goals"                                         ALens' (Project Void String String) Bool
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool
False
    ParsecFieldGrammar
  (Project Void String String)
  (Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) (Maybe Int)
-> ParsecFieldGrammar
     (Project Void String String)
     (Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (Int -> Int')
-> ALens' (Project Void String String) (Maybe Int)
-> ParsecFieldGrammar (Project Void String String) (Maybe Int)
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'                                ALens' (Project Void String String) (Maybe Int)
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL
    ParsecFieldGrammar
  (Project Void String String)
  (Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) Optimization
-> ParsecFieldGrammar
     (Project Void String String)
     ([SourceRepositoryPackage Maybe]
      -> [PrettyField ()] -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' (Project Void String String) Optimization
-> Optimization
-> ParsecFieldGrammar (Project Void String String) Optimization
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"                                          ALens' (Project Void String String) Optimization
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization
OptimizationOn
    ParsecFieldGrammar
  (Project Void String String)
  ([SourceRepositoryPackage Maybe]
   -> [PrettyField ()] -> Project Void String String)
-> ParsecFieldGrammar
     (Project Void String String) [SourceRepositoryPackage Maybe]
-> ParsecFieldGrammar
     (Project Void String String)
     ([PrettyField ()] -> Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SourceRepositoryPackage Maybe]
-> ParsecFieldGrammar
     (Project Void String String) [SourceRepositoryPackage Maybe]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ParsecFieldGrammar
  (Project Void String String)
  ([PrettyField ()] -> Project Void String String)
-> ParsecFieldGrammar (Project Void String String) [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void String String) (Project Void String String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PrettyField ()]
-> ParsecFieldGrammar (Project Void String String) [PrettyField ()]
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 :: LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL [pkg] -> f [pkg]
f Project uri opt pkg
prj = [pkg] -> f [pkg]
f (Project uri opt pkg -> [pkg]
forall uri opt a. Project uri opt a -> [a]
prjPackages Project uri opt pkg
prj) f [pkg]
-> ([pkg] -> Project uri opt pkg) -> f (Project uri opt pkg)
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 :: LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL [opt] -> f [opt]
f Project uri opt pkg
prj = [opt] -> f [opt]
f (Project uri opt pkg -> [opt]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj) f [opt]
-> ([opt] -> Project uri opt pkg) -> f (Project uri opt pkg)
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 :: LensLike' f (Project uri opt pkg) [String]
prjConstraintsL [String] -> f [String]
f Project uri opt pkg
prj = [String] -> f [String]
f (Project uri opt pkg -> [String]
forall uri opt pkg. Project uri opt pkg -> [String]
prjConstraints Project uri opt pkg
prj) f [String]
-> ([String] -> Project uri opt pkg) -> f (Project uri opt pkg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[String]
x -> Project uri opt pkg
prj { prjConstraints :: [String]
prjConstraints = [String]
x }

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

prjReorderGoalsL :: Functor f => LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL :: LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool -> f Bool
f Project uri opt pkg
prj = Bool -> f Bool
f (Project uri opt pkg -> Bool
forall uri opt a. Project uri opt a -> Bool
prjReorderGoals Project uri opt pkg
prj) f Bool -> (Bool -> Project uri opt pkg) -> f (Project uri opt pkg)
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 :: 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 (Project uri opt pkg -> Maybe Int
forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj) f (Maybe Int)
-> (Maybe Int -> Project uri opt pkg) -> f (Project uri opt pkg)
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 :: LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization -> f Optimization
f Project uri opt pkg
prj = Optimization -> f Optimization
f (Project uri opt pkg -> Optimization
forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj) f Optimization
-> (Optimization -> Project uri opt pkg) -> f (Project uri opt pkg)
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 :: 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 (Project uri opt pkg -> [SourceRepositoryPackage Maybe]
forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj) f [SourceRepositoryPackage Maybe]
-> ([SourceRepositoryPackage Maybe] -> Project uri opt pkg)
-> f (Project uri opt pkg)
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 -> String
(Int -> ResolveError -> ShowS)
-> (ResolveError -> String)
-> ([ResolveError] -> ShowS)
-> Show ResolveError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolveError] -> ShowS
$cshowList :: [ResolveError] -> ShowS
show :: ResolveError -> String
$cshow :: ResolveError -> String
showsPrec :: Int -> ResolveError -> ShowS
$cshowsPrec :: Int -> ResolveError -> ShowS
Show

instance Exception ResolveError where
    displayException :: ResolveError -> String
displayException = ResolveError -> String
renderResolveError

-- | Pretty print 'ResolveError'.
renderResolveError :: ResolveError -> String
renderResolveError :: ResolveError -> String
renderResolveError (BadPackageLocation String
s) = String
"Bad package location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
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 :: String
-> Project Void String String
-> IO (Either ResolveError (Project URI Void String))
resolveProject String
filePath Project Void String String
prj = ExceptT ResolveError IO (Project URI Void String)
-> IO (Either ResolveError (Project URI Void String))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ResolveError IO (Project URI Void String)
 -> IO (Either ResolveError (Project URI Void String)))
-> ExceptT ResolveError IO (Project URI Void String)
-> IO (Either ResolveError (Project URI Void String))
forall a b. (a -> b) -> a -> b
$ do
    Project Void [String] [Either URI String]
prj' <- (String -> ExceptT ResolveError IO [String])
-> (String -> ExceptT ResolveError IO [Either URI String])
-> Project Void String String
-> ExceptT
     ResolveError IO (Project Void [String] [Either URI String])
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 String -> ExceptT ResolveError IO [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
findOptProjectPackage String -> ExceptT ResolveError IO [Either URI String]
findProjectPackage Project Void String String
prj
    let ([URI]
uris, [String]
pkgs) = [Either URI String] -> ([URI], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either URI String] -> ([URI], [String]))
-> [Either URI String] -> ([URI], [String])
forall a b. (a -> b) -> a -> b
$ [[Either URI String]] -> [Either URI String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either URI String]] -> [Either URI String])
-> [[Either URI String]] -> [Either URI String]
forall a b. (a -> b) -> a -> b
$ Project Void [String] [Either URI String] -> [[Either URI String]]
forall uri opt a. Project uri opt a -> [a]
prjPackages Project Void [String] [Either URI String]
prj'
    Project URI Void String
-> ExceptT ResolveError IO (Project URI Void String)
forall (m :: * -> *) a. Monad m => a -> m a
return Project Void [String] [Either URI String]
prj'
        { prjPackages :: [String]
prjPackages    = [String]
pkgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Project Void [String] [Either URI String] -> [[String]]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project Void [String] [Either URI String]
prj')
        , prjOptPackages :: [Void]
prjOptPackages = []
        , prjUriPackages :: [URI]
prjUriPackages = [URI]
uris
        }
  where
    rootdir :: String
rootdir = ShowS
takeDirectory String
filePath

    findProjectPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
    findProjectPackage :: String -> ExceptT ResolveError IO [Either URI String]
findProjectPackage String
pkglocstr = do
        Maybe [Either URI String]
mfp <- (String -> Either URI String)
-> ExceptT ResolveError IO (Maybe [String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
forall (f :: * -> *) (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f, Functor f) =>
(a -> b) -> f (f (f a)) -> f (f (f b))
fmap3 String -> Either URI String
forall a b. b -> Either a b
Right (String -> ExceptT ResolveError IO (Maybe [String])
forall (m :: * -> *). MonadIO m => String -> m (Maybe [String])
checkisFileGlobPackage String
pkglocstr) ExceptT ResolveError IO (Maybe [Either URI String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`mplusMaybeT`
               (String -> Either URI String)
-> ExceptT ResolveError IO (Maybe [String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
forall (f :: * -> *) (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f, Functor f) =>
(a -> b) -> f (f (f a)) -> f (f (f b))
fmap3 String -> Either URI String
forall a b. b -> Either a b
Right (String -> ExceptT ResolveError IO (Maybe [String])
forall (m :: * -> *). MonadIO m => String -> m (Maybe [String])
checkIsSingleFilePackage String
pkglocstr) ExceptT ResolveError IO (Maybe [Either URI String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
-> ExceptT ResolveError IO (Maybe [Either URI String])
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`mplusMaybeT`
               (URI -> [Either URI String])
-> ExceptT ResolveError IO (Maybe URI)
-> ExceptT ResolveError IO (Maybe [Either URI String])
forall (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 (\URI
uri -> [URI -> Either URI String
forall a b. a -> Either a b
Left URI
uri]) (Maybe URI -> ExceptT ResolveError IO (Maybe URI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URI -> ExceptT ResolveError IO (Maybe URI))
-> Maybe URI -> ExceptT ResolveError IO (Maybe URI)
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI String
pkglocstr)
        ExceptT ResolveError IO [Either URI String]
-> ([Either URI String]
    -> ExceptT ResolveError IO [Either URI String])
-> Maybe [Either URI String]
-> ExceptT ResolveError IO [Either URI String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ResolveError -> ExceptT ResolveError IO [Either URI String]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ResolveError -> ExceptT ResolveError IO [Either URI String])
-> ResolveError -> ExceptT ResolveError IO [Either URI String]
forall a b. (a -> b) -> a -> b
$ String -> ResolveError
BadPackageLocation String
pkglocstr) [Either URI String] -> ExceptT ResolveError IO [Either URI String]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Either URI String]
mfp

    fmap2 :: (a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f = (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
    fmap3 :: (a -> b) -> f (f (f a)) -> f (f (f b))
fmap3 a -> b
f = (f (f a) -> f (f b)) -> f (f (f a)) -> f (f (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))

    findOptProjectPackage :: String -> m [String]
findOptProjectPackage String
pkglocstr = do
        Maybe [String]
mfp <- String -> m (Maybe [String])
forall (m :: * -> *). MonadIO m => String -> m (Maybe [String])
checkisFileGlobPackage String
pkglocstr m (Maybe [String]) -> m (Maybe [String]) -> m (Maybe [String])
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`mplusMaybeT`
               String -> m (Maybe [String])
forall (m :: * -> *). MonadIO m => String -> m (Maybe [String])
checkIsSingleFilePackage String
pkglocstr
        m [String]
-> ([String] -> m [String]) -> Maybe [String] -> m [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []) [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
mfp

    checkIsSingleFilePackage :: String -> m (Maybe [String])
checkIsSingleFilePackage String
pkglocstr = do
        let abspath :: String
abspath = String
rootdir String -> ShowS
</> String
pkglocstr
        Bool
isFile <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
abspath
        Bool
isDir  <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
abspath
        if | Bool
isFile Bool -> Bool -> Bool
&& ShowS
takeExtension String
pkglocstr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal" -> Maybe [String] -> m (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
abspath])
           | Bool
isDir -> String -> m (Maybe [String])
forall (m :: * -> *). MonadIO m => String -> m (Maybe [String])
checkisFileGlobPackage (String
pkglocstr String -> ShowS
</> String
"*.cabal")
           | Bool
otherwise -> Maybe [String] -> m (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing

    -- if it looks like glob, glob
    checkisFileGlobPackage :: String -> m (Maybe [String])
checkisFileGlobPackage String
pkglocstr =
        case ((FilePathGlobRel, String) -> Bool)
-> [(FilePathGlobRel, String)] -> [(FilePathGlobRel, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((FilePathGlobRel, String) -> String)
-> (FilePathGlobRel, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePathGlobRel, String) -> String
forall a b. (a, b) -> b
snd) ([(FilePathGlobRel, String)] -> [(FilePathGlobRel, String)])
-> [(FilePathGlobRel, String)] -> [(FilePathGlobRel, String)]
forall a b. (a -> b) -> a -> b
$ ReadP FilePathGlobRel -> ReadS FilePathGlobRel
forall a. ReadP a -> ReadS a
readP_to_S ReadP FilePathGlobRel
parseFilePathGlobRel String
pkglocstr of
            [(FilePathGlobRel
g, String
"")] -> do
                [String]
files <- IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> FilePathGlobRel -> IO [String]
forall (m :: * -> *).
MonadIO m =>
String -> FilePathGlobRel -> m [String]
expandRelGlob String
rootdir FilePathGlobRel
g
                let files' :: [String]
files' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal") (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension) [String]
files
                -- if nothing is matched, skip.
                if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files' then Maybe [String] -> m (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing else Maybe [String] -> m (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
files')
            [(FilePathGlobRel, String)]
_         -> Maybe [String] -> m (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [String]
forall a. Maybe a
Nothing

    mplusMaybeT :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
    mplusMaybeT :: m (Maybe a) -> m (Maybe a) -> m (Maybe a)
mplusMaybeT m (Maybe a)
ma m (Maybe a)
mb = do
        Maybe a
mx <- m (Maybe a)
ma
        case Maybe a
mx of
            Maybe a
Nothing -> m (Maybe a)
mb
            Just a
x  -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)

-------------------------------------------------------------------------------
-- 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 :: Project uri opt String
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt (String, GenericPackageDescription)))
readPackagesOfProject Project uri opt String
prj = ExceptT
  (ParseError NonEmpty)
  IO
  (Project uri opt (String, GenericPackageDescription))
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt (String, GenericPackageDescription)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (ParseError NonEmpty)
   IO
   (Project uri opt (String, GenericPackageDescription))
 -> IO
      (Either
         (ParseError NonEmpty)
         (Project uri opt (String, GenericPackageDescription))))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt (String, GenericPackageDescription))
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt (String, GenericPackageDescription)))
forall a b. (a -> b) -> a -> b
$ Project uri opt String
-> (String
    -> ExceptT
         (ParseError NonEmpty) IO (String, GenericPackageDescription))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt (String, GenericPackageDescription))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Project uri opt String
prj ((String
  -> ExceptT
       (ParseError NonEmpty) IO (String, GenericPackageDescription))
 -> ExceptT
      (ParseError NonEmpty)
      IO
      (Project uri opt (String, GenericPackageDescription)))
-> (String
    -> ExceptT
         (ParseError NonEmpty) IO (String, GenericPackageDescription))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt (String, GenericPackageDescription))
forall a b. (a -> b) -> a -> b
$ \String
fp -> do
    FieldName
contents <- IO FieldName -> ExceptT (ParseError NonEmpty) IO FieldName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FieldName -> ExceptT (ParseError NonEmpty) IO FieldName)
-> IO FieldName -> ExceptT (ParseError NonEmpty) IO FieldName
forall a b. (a -> b) -> a -> b
$ String -> IO FieldName
BS.readFile String
fp
    (ParseError NonEmpty
 -> ExceptT
      (ParseError NonEmpty) IO (String, GenericPackageDescription))
-> (GenericPackageDescription
    -> ExceptT
         (ParseError NonEmpty) IO (String, GenericPackageDescription))
-> Either (ParseError NonEmpty) GenericPackageDescription
-> ExceptT
     (ParseError NonEmpty) IO (String, GenericPackageDescription)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty
-> ExceptT
     (ParseError NonEmpty) IO (String, GenericPackageDescription)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (\GenericPackageDescription
gpd -> (String, GenericPackageDescription)
-> ExceptT
     (ParseError NonEmpty) IO (String, GenericPackageDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fp, GenericPackageDescription
gpd)) (String
-> FieldName
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage String
fp FieldName
contents)