{-# 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
(<&>) = ((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 a b. (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
    { 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 -> 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
$cfmap :: forall uri opt a b.
(a -> b) -> Project uri opt a -> Project uri opt b
fmap :: forall a b. (a -> b) -> Project uri opt a -> Project uri opt b
$c<$ :: forall uri opt a b. a -> Project uri opt b -> Project uri opt a
<$ :: forall a b. a -> Project uri opt b -> Project uri opt a
Functor, (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 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
$cfold :: forall uri opt m. Monoid m => Project uri opt m -> m
fold :: forall m. Monoid m => Project uri opt m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
$cfoldr1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldr1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$cfoldl1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldl1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$ctoList :: forall uri opt pkg. Project uri opt pkg -> [pkg]
toList :: forall a. Project uri opt a -> [a]
$cnull :: forall uri opt pkg. Project uri opt pkg -> Bool
null :: forall a. Project uri opt a -> Bool
$clength :: forall uri opt a. Project uri opt a -> Int
length :: forall a. Project uri opt a -> Int
$celem :: forall uri opt a. Eq a => a -> Project uri opt a -> Bool
elem :: forall a. Eq a => a -> Project uri opt a -> Bool
$cmaximum :: forall uri opt a. Ord a => Project uri opt a -> a
maximum :: forall a. Ord a => Project uri opt a -> a
$cminimum :: forall uri opt a. Ord a => Project uri opt a -> a
minimum :: forall a. Ord a => Project uri opt a -> a
$csum :: forall uri opt a. Num a => Project uri opt a -> a
sum :: forall a. Num a => Project uri opt a -> a
$cproduct :: forall uri opt a. Num a => Project uri opt a -> a
product :: forall a. Num a => Project uri opt a -> a
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)
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)
$ctraverse :: forall uri opt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
$csequenceA :: forall uri opt (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
$cmapM :: forall uri opt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
$csequence :: forall uri opt (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
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
$cfrom :: forall uri opt pkg x.
Project uri opt pkg -> Rep (Project uri opt pkg) x
from :: forall 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
to :: forall x. Rep (Project uri opt pkg) x -> Project uri opt pkg
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 pkg. Project uri opt pkg -> [pkg]
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 -> [[Char]]) -> Bool
forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints
        , (Project uri opt pkg -> [[Char]]) -> Bool
forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
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 pkg. Project uri opt pkg -> 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

-- | 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
            ( [Char] -> ShowS
showString [Char]
"Project{prjPackages = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [pkg] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [pkg]
forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptPackages = "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [opt] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [opt]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjUriPackages = "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [uri] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [uri]
forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjConstraints = "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjAllowNewer = "     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjReorderGoals = "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> Bool
forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjMaxBackjumps = "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> Maybe Int
forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptimization = "   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optimization -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> Optimization
forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjSourceRepos = "    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SourceRepositoryPackage Maybe] -> ShowS
forall a. Show a => a -> ShowS
shows (Project uri opt pkg -> [SourceRepositoryPackage Maybe]
forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj)
            ShowS -> ShowS -> ShowS
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 = (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 :: forall m a b.
Monoid m =>
(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 :: 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 = a, prjOptPackages = b, prjUriPackages = 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. f (a -> b) -> f a -> f b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. f (a -> b) -> f a -> f b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse pkg -> f pkg'
h (Project uri opt pkg -> [pkg]
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 = (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 a. a -> f a
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 = [a]
-> [b]
-> [c]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project c b a
forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> 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 [[Char]]
x4 [[Char]]
x5 Bool
x6 Maybe Int
x7 Optimization
x8 [SourceRepositoryPackage Maybe]
x9 [PrettyField ()]
x10) =
        [a] -> ()
forall a. NFData a => a -> ()
rnf [a]
x1 () -> () -> ()
forall a b. a -> b -> b
`seq` [b] -> ()
forall a. NFData a => a -> ()
rnf [b]
x2 () -> () -> ()
forall a b. a -> b -> b
`seq` [c] -> ()
forall a. NFData a => a -> ()
rnf [c]
x3 () -> () -> ()
forall a b. a -> b -> b
`seq`
        [[Char]] -> ()
forall a. NFData a => a -> ()
rnf [[Char]]
x4 () -> () -> ()
forall a b. a -> b -> b
`seq` [[Char]] -> ()
forall a. NFData a => a -> ()
rnf [[Char]]
x5 () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
x6 () -> () -> ()
forall a b. a -> b -> b
`seq`
        Maybe Int -> ()
forall a. NFData a => a -> ()
rnf Maybe Int
x7 () -> () -> ()
forall a b. a -> b -> b
`seq` Optimization -> ()
forall a. NFData a => a -> ()
rnf Optimization
x8 () -> () -> ()
forall a b. a -> b -> b
`seq` [SourceRepositoryPackage Maybe] -> ()
forall a. NFData a => a -> ()
rnf [SourceRepositoryPackage Maybe]
x9 () -> () -> ()
forall a b. a -> b -> b
`seq`
        (PrettyField () -> ()) -> [PrettyField ()] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList PrettyField () -> ()
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 () -> () -> ()
forall a b. a -> b -> b
`seq` (a -> ()) -> [a] -> ()
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) =
            x -> ()
forall a. NFData a => a -> ()
rnf x
ann () -> () -> ()
forall a b. a -> b -> b
`seq` FieldName -> ()
forall a. NFData a => a -> ()
rnf FieldName
fn () -> () -> ()
forall a b. a -> b -> b
`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 () -> () -> ()
forall a b. a -> b -> b
`seq` FieldName -> ()
forall a. NFData a => a -> ()
rnf FieldName
fn () -> () -> ()
forall a b. a -> b -> b
`seq` [Doc] -> ()
forall a. NFData a => a -> ()
rnf [Doc]
ds () -> () -> ()
forall a b. a -> b -> b
`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 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 <- (ParseError NonEmpty -> IO (Project Void [Char] [Char]))
-> (Project Void [Char] [Char] -> IO (Project Void [Char] [Char]))
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
-> IO (Project Void [Char] [Char])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty -> IO (Project Void [Char] [Char])
forall e a. Exception e => e -> IO a
throwIO Project Void [Char] [Char] -> IO (Project Void [Char] [Char])
forall a. a -> IO a
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 IO (Either ResolveError (Project URI Void [Char]))
-> (Either ResolveError (Project URI Void [Char])
    -> IO (Project URI Void [Char]))
-> IO (Project URI Void [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ResolveError -> IO (Project URI Void [Char]))
-> (Project URI Void [Char] -> IO (Project URI Void [Char]))
-> Either ResolveError (Project URI Void [Char])
-> IO (Project URI Void [Char])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ResolveError -> IO (Project URI Void [Char])
forall e a. Exception e => e -> IO a
throwIO Project URI Void [Char] -> IO (Project URI Void [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Project URI Void [Char]
-> IO
     (Either
        (ParseError NonEmpty)
        (Project URI Void ([Char], GenericPackageDescription)))
forall uri opt.
Project uri opt [Char]
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt ([Char], GenericPackageDescription)))
readPackagesOfProject Project URI Void [Char]
prj1 IO
  (Either
     (ParseError NonEmpty)
     (Project URI Void ([Char], GenericPackageDescription)))
-> (Either
      (ParseError NonEmpty)
      (Project URI Void ([Char], GenericPackageDescription))
    -> IO (Project URI Void ([Char], GenericPackageDescription)))
-> IO (Project URI Void ([Char], GenericPackageDescription))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseError NonEmpty
 -> IO (Project URI Void ([Char], GenericPackageDescription)))
-> (Project URI Void ([Char], GenericPackageDescription)
    -> IO (Project URI Void ([Char], GenericPackageDescription)))
-> Either
     (ParseError NonEmpty)
     (Project URI Void ([Char], GenericPackageDescription))
-> IO (Project URI Void ([Char], GenericPackageDescription))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty
-> IO (Project URI Void ([Char], GenericPackageDescription))
forall e a. Exception e => e -> IO a
throwIO Project URI Void ([Char], GenericPackageDescription)
-> IO (Project URI Void ([Char], GenericPackageDescription))
forall a. a -> IO a
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 = ([Field Position] -> ParseResult (Project Void [Char] [Char]))
-> [Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
forall a.
([Field Position] -> ParseResult a)
-> [Char] -> FieldName -> Either (ParseError NonEmpty) a
parseWith (([Field Position] -> ParseResult (Project Void [Char] [Char]))
 -> [Char]
 -> FieldName
 -> Either (ParseError NonEmpty) (Project Void [Char] [Char]))
-> ([Field Position] -> ParseResult (Project Void [Char] [Char]))
-> [Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
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 a. Eq a => a -> [a] -> 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 [Char] [Char])
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 = ParsecFieldGrammar
  (Project Void [Char] [Char]) (Project Void [Char] [Char])
-> [FieldName]
forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList (ParsecFieldGrammar
   (Project Void [Char] [Char]) (Project Void [Char] [Char])
 -> [FieldName])
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
-> [FieldName]
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 = (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 [Char] [Char]
prj <- CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
-> ParseResult (Project Void [Char] [Char])
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields (ParsecFieldGrammar
   (Project Void [Char] [Char]) (Project Void [Char] [Char])
 -> ParseResult (Project Void [Char] [Char]))
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
-> ParseResult (Project Void [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
prettyOtherFields
        (Project Void [Char] [Char]
 -> (Project Void [Char] [Char] -> Project Void [Char] [Char])
 -> Project Void [Char] [Char])
-> Project Void [Char] [Char]
-> [Project Void [Char] [Char] -> Project Void [Char] [Char]]
-> Project Void [Char] [Char]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Project Void [Char] [Char]
-> (Project Void [Char] [Char] -> Project Void [Char] [Char])
-> Project Void [Char] [Char]
forall a b. a -> (a -> b) -> b
(&) Project Void [Char] [Char]
prj ([Project Void [Char] [Char] -> Project Void [Char] [Char]]
 -> Project Void [Char] [Char])
-> ParseResult
     [Project Void [Char] [Char] -> Project Void [Char] [Char]]
-> ParseResult (Project Void [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Section Position
 -> ParseResult
      (Project Void [Char] [Char] -> Project Void [Char] [Char]))
-> [Section Position]
-> ParseResult
     [Project Void [Char] [Char] -> Project Void [Char] [Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Section Position
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
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 [Char] [Char] -> Project Void [Char] [Char])
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 [Char]), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar
        (Project Void [Char] [Char] -> Project Void [Char] [Char])
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Project Void [Char] [Char] -> Project Void [Char] [Char])
 -> ParseResult
      (Project Void [Char] [Char] -> Project Void [Char] [Char]))
-> (Project Void [Char] [Char] -> Project Void [Char] [Char])
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
forall a b. (a -> b) -> a -> b
$ ASetter
  (Project Void [Char] [Char])
  (Project Void [Char] [Char])
  [SourceRepositoryPackage Maybe]
  [SourceRepositoryPackage Maybe]
-> ([SourceRepositoryPackage Maybe]
    -> [SourceRepositoryPackage Maybe])
-> Project Void [Char] [Char]
-> Project Void [Char] [Char]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Project Void [Char] [Char])
  (Project Void [Char] [Char])
  [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 a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut SourceRepoList
repos))

    parseSec Section Position
_ = (Project Void [Char] [Char] -> Project Void [Char] [Char])
-> ParseResult
     (Project Void [Char] [Char] -> Project Void [Char] [Char])
forall a. a -> ParseResult a
forall (m :: * -> *) a. Monad m => a -> m a
return Project Void [Char] [Char] -> Project Void [Char] [Char]
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 FieldName -> [FieldName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ParsecFieldGrammar
  (Project Void [Char] [Char]) (Project Void [Char] [Char])
-> [FieldName]
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 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 [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
otherFields = [[Char]]
-> [[Char]]
-> [Void]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project Void [Char] [Char]
forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project
    ([[Char]]
 -> [[Char]]
 -> [Void]
 -> [[Char]]
 -> [[Char]]
 -> Bool
 -> Maybe Int
 -> Optimization
 -> [SourceRepositoryPackage Maybe]
 -> [PrettyField ()]
 -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([[Char]]
      -> [Void]
      -> [[Char]]
      -> [[Char]]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([[Char]] -> List FSep PackageLocation [Char])
-> ALens' (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
forall b a s.
(Parsec b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
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
-> ([Char] -> PackageLocation)
-> [[Char]]
-> List FSep PackageLocation [Char]
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) ALens' (Project Void [Char] [Char]) [[Char]]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([[Char]]
   -> [Void]
   -> [[Char]]
   -> [[Char]]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([Void]
      -> [[Char]]
      -> [[Char]]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([[Char]] -> List FSep PackageLocation [Char])
-> ALens' (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
forall b a s.
(Parsec b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
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
-> ([Char] -> PackageLocation)
-> [[Char]]
-> List FSep PackageLocation [Char]
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) ALens' (Project Void [Char] [Char]) [[Char]]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([Void]
   -> [[Char]]
   -> [[Char]]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [Void]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([[Char]]
      -> [[Char]]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Void] -> ParsecFieldGrammar (Project Void [Char] [Char]) [Void]
forall a. a -> ParsecFieldGrammar (Project Void [Char] [Char]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([[Char]]
   -> [[Char]]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([[Char]]
      -> Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([[Char]] -> List CommaVCat NoCommas [Char])
-> ALens' (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
forall b a s.
(Parsec b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
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
-> ([Char] -> NoCommas)
-> [[Char]]
-> List CommaVCat NoCommas [Char]
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas)   ALens' (Project Void [Char] [Char]) [[Char]]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjConstraintsL
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([[Char]]
   -> Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     (Bool
      -> Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([[Char]] -> List CommaVCat NoCommas [Char])
-> ALens' (Project Void [Char] [Char]) [[Char]]
-> ParsecFieldGrammar (Project Void [Char] [Char]) [[Char]]
forall b a s.
(Parsec b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
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
-> ([Char] -> NoCommas)
-> [[Char]]
-> List CommaVCat NoCommas [Char]
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas)   ALens' (Project Void [Char] [Char]) [[Char]]
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjAllowNewerL
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  (Bool
   -> Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) Bool
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     (Maybe Int
      -> Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' (Project Void [Char] [Char]) Bool
-> Bool
-> ParsecFieldGrammar (Project Void [Char] [Char]) Bool
forall s.
FieldName -> ALens' s Bool -> Bool -> ParsecFieldGrammar s 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 [Char] [Char]) Bool
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool
False
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  (Maybe Int
   -> Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) (Maybe Int)
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     (Optimization
      -> [SourceRepositoryPackage Maybe]
      -> [PrettyField ()]
      -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (Int -> Int')
-> ALens' (Project Void [Char] [Char]) (Maybe Int)
-> ParsecFieldGrammar (Project Void [Char] [Char]) (Maybe Int)
forall b a s.
(Parsec b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> ParsecFieldGrammar s (Maybe a)
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 [Char] [Char]) (Maybe Int)
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  (Optimization
   -> [SourceRepositoryPackage Maybe]
   -> [PrettyField ()]
   -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) Optimization
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([SourceRepositoryPackage Maybe]
      -> [PrettyField ()] -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' (Project Void [Char] [Char]) Optimization
-> Optimization
-> ParsecFieldGrammar (Project Void [Char] [Char]) 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 [Char] [Char]) Optimization
forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization
OptimizationOn
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([SourceRepositoryPackage Maybe]
   -> [PrettyField ()] -> Project Void [Char] [Char])
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) [SourceRepositoryPackage Maybe]
-> ParsecFieldGrammar
     (Project Void [Char] [Char])
     ([PrettyField ()] -> Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [SourceRepositoryPackage Maybe]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) [SourceRepositoryPackage Maybe]
forall a. a -> ParsecFieldGrammar (Project Void [Char] [Char]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ParsecFieldGrammar
  (Project Void [Char] [Char])
  ([PrettyField ()] -> Project Void [Char] [Char])
-> ParsecFieldGrammar (Project Void [Char] [Char]) [PrettyField ()]
-> ParsecFieldGrammar
     (Project Void [Char] [Char]) (Project Void [Char] [Char])
forall a b.
ParsecFieldGrammar (Project Void [Char] [Char]) (a -> b)
-> ParsecFieldGrammar (Project Void [Char] [Char]) a
-> ParsecFieldGrammar (Project Void [Char] [Char]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PrettyField ()]
-> ParsecFieldGrammar (Project Void [Char] [Char]) [PrettyField ()]
forall a. a -> ParsecFieldGrammar (Project Void [Char] [Char]) a
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 (Project uri opt pkg -> [pkg]
forall uri opt pkg. Project uri opt pkg -> [pkg]
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 = 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 (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 = 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 (Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj) f [[Char]]
-> ([[Char]] -> Project uri opt pkg) -> f (Project uri opt pkg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjConstraints = 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 (Project uri opt pkg -> [[Char]]
forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj) f [[Char]]
-> ([[Char]] -> Project uri opt pkg) -> f (Project uri opt pkg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjAllowNewer = 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 (Project uri opt pkg -> Bool
forall uri opt pkg. Project uri opt pkg -> 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 = 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 (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 = 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 (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 = 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 (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 = x }

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

-- | A 'resolveProject' error.
newtype ResolveError = BadPackageLocation String
  deriving Int -> ResolveError -> ShowS
[ResolveError] -> ShowS
ResolveError -> [Char]
(Int -> ResolveError -> ShowS)
-> (ResolveError -> [Char])
-> ([ResolveError] -> ShowS)
-> Show ResolveError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolveError -> ShowS
showsPrec :: Int -> ResolveError -> ShowS
$cshow :: ResolveError -> [Char]
show :: ResolveError -> [Char]
$cshowList :: [ResolveError] -> ShowS
showList :: [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: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
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 = ExceptT ResolveError IO (Project URI Void [Char])
-> IO (Either ResolveError (Project URI Void [Char]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ResolveError IO (Project URI Void [Char])
 -> IO (Either ResolveError (Project URI Void [Char])))
-> ExceptT ResolveError IO (Project URI Void [Char])
-> IO (Either ResolveError (Project URI Void [Char]))
forall a b. (a -> b) -> a -> b
$ do
    Project Void [Either URI [Char]] [Either URI [Char]]
prj' <- ([Char] -> ExceptT ResolveError IO [Either URI [Char]])
-> ([Char] -> ExceptT ResolveError IO [Either URI [Char]])
-> Project Void [Char] [Char]
-> ExceptT
     ResolveError
     IO
     (Project Void [Either URI [Char]] [Either URI [Char]])
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Project Void a b -> f (Project Void c d)
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)  = [Either URI [Char]] -> ([URI], [[Char]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either URI [Char]] -> ([URI], [[Char]]))
-> [Either URI [Char]] -> ([URI], [[Char]])
forall a b. (a -> b) -> a -> b
$ [[Either URI [Char]]] -> [Either URI [Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either URI [Char]]] -> [Either URI [Char]])
-> [[Either URI [Char]]] -> [Either URI [Char]]
forall a b. (a -> b) -> a -> b
$ Project Void [Either URI [Char]] [Either URI [Char]]
-> [[Either URI [Char]]]
forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
    let ([URI]
uris', [[Char]]
pkgs') = [Either URI [Char]] -> ([URI], [[Char]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either URI [Char]] -> ([URI], [[Char]]))
-> [Either URI [Char]] -> ([URI], [[Char]])
forall a b. (a -> b) -> a -> b
$ [[Either URI [Char]]] -> [Either URI [Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either URI [Char]]] -> [Either URI [Char]])
-> [[Either URI [Char]]] -> [Either URI [Char]]
forall a b. (a -> b) -> a -> b
$ Project Void [Either URI [Char]] [Either URI [Char]]
-> [[Either URI [Char]]]
forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
    Project URI Void [Char]
-> ExceptT ResolveError IO (Project URI Void [Char])
forall a. a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Project Void [Either URI [Char]] [Either URI [Char]]
prj'
        { prjPackages    = pkgs ++ pkgs'
        , prjOptPackages = []
        , prjUriPackages = uris ++ 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 ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
               [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
               [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either URI [Char]]
-> (URI -> [Either URI [Char]]) -> Maybe URI -> [Either URI [Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Either URI [Char] -> [Either URI [Char]]
forall {a}. a -> [a]
singleton (Either URI [Char] -> [Either URI [Char]])
-> (URI -> Either URI [Char]) -> URI -> [Either URI [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Either URI [Char]
forall a b. a -> Either a b
Left) ([Char] -> Maybe URI
parseURI [Char]
pkglocstr))
        case [Either URI [Char]]
mfp of
            [] -> ResolveError -> ExceptT ResolveError IO [Either URI [Char]]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ResolveError -> ExceptT ResolveError IO [Either URI [Char]])
-> ResolveError -> ExceptT ResolveError IO [Either URI [Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> ResolveError
BadPackageLocation [Char]
pkglocstr
            [Either URI [Char]]
_  -> [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
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 ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
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 <- IO Bool -> ExceptT ResolveError IO Bool
forall a. IO a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT ResolveError IO Bool)
-> IO Bool -> ExceptT ResolveError IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
abspath
        Bool
isDir  <- IO Bool -> ExceptT ResolveError IO Bool
forall a. IO a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT ResolveError IO Bool)
-> IO Bool -> ExceptT ResolveError IO Bool
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 -> [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
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                           -> [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
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 [Char] -> Either [Char] FilePathGlob
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]
_  -> [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
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 <- IO [[Char]] -> ExceptT ResolveError IO [[Char]]
forall a. IO a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> ExceptT ResolveError IO [[Char]])
-> IO [[Char]] -> ExceptT ResolveError IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> FilePathGlob -> IO [[Char]]
matchFileGlob [Char]
rootdir FilePathGlob
glob
        [Either URI [Char]] -> ExceptT ResolveError IO [Either URI [Char]]
forall a. a -> ExceptT ResolveError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either URI [Char]]
 -> ExceptT ResolveError IO [Either URI [Char]])
-> [Either URI [Char]]
-> ExceptT ResolveError IO [Either URI [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe (Either URI [Char]))
-> [[Char]] -> [Either URI [Char]]
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"  [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = Either URI [Char] -> Maybe (Either URI [Char])
forall a. a -> Maybe a
Just (Either URI [Char] -> Maybe (Either URI [Char]))
-> Either URI [Char] -> Maybe (Either URI [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either URI [Char]
forall a b. b -> Either a b
Right [Char]
abspath
        | [Char]
".tar.gz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = Either URI [Char] -> Maybe (Either URI [Char])
forall a. a -> Maybe a
Just (Either URI [Char] -> Maybe (Either URI [Char]))
-> Either URI [Char] -> Maybe (Either URI [Char])
forall a b. (a -> b) -> a -> b
$ URI -> Either URI [Char]
forall a b. a -> Either a b
Left (URI -> Either URI [Char]) -> URI -> Either URI [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI [Char]
"file:" Maybe URIAuth
forall a. Maybe a
Nothing [Char]
abspath [Char]
"" [Char]
""
        | Bool
otherwise                      = Maybe (Either URI [Char])
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)
          (([Char] -> FilePathGlobRel -> FilePathGlobRel)
-> FilePathGlobRel -> [[Char]] -> FilePathGlobRel
forall a b. (a -> b -> b) -> b -> [a] -> b
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) = ([Char] -> [[Char]]) -> ([Char], [Char]) -> ([Char], [[Char]])
forall a b. (a -> b) -> ([Char], a) -> ([Char], b)
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 -> [a] -> m [a]
forall a. a -> m a
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 = ExceptT
  (ParseError NonEmpty)
  IO
  (Project uri opt ([Char], GenericPackageDescription))
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt ([Char], GenericPackageDescription)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (ParseError NonEmpty)
   IO
   (Project uri opt ([Char], GenericPackageDescription))
 -> IO
      (Either
         (ParseError NonEmpty)
         (Project uri opt ([Char], GenericPackageDescription))))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt ([Char], GenericPackageDescription))
-> IO
     (Either
        (ParseError NonEmpty)
        (Project uri opt ([Char], GenericPackageDescription)))
forall a b. (a -> b) -> a -> b
$ Project uri opt [Char]
-> ([Char]
    -> ExceptT
         (ParseError NonEmpty) IO ([Char], GenericPackageDescription))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt ([Char], GenericPackageDescription))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Project uri opt [Char]
prj (([Char]
  -> ExceptT
       (ParseError NonEmpty) IO ([Char], GenericPackageDescription))
 -> ExceptT
      (ParseError NonEmpty)
      IO
      (Project uri opt ([Char], GenericPackageDescription)))
-> ([Char]
    -> ExceptT
         (ParseError NonEmpty) IO ([Char], GenericPackageDescription))
-> ExceptT
     (ParseError NonEmpty)
     IO
     (Project uri opt ([Char], GenericPackageDescription))
forall a b. (a -> b) -> a -> b
$ \[Char]
fp -> do
    FieldName
contents <- IO FieldName -> ExceptT (ParseError NonEmpty) IO FieldName
forall a. IO a -> ExceptT (ParseError NonEmpty) IO a
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
$ [Char] -> IO FieldName
BS.readFile [Char]
fp
    (ParseError NonEmpty
 -> ExceptT
      (ParseError NonEmpty) IO ([Char], GenericPackageDescription))
-> (GenericPackageDescription
    -> ExceptT
         (ParseError NonEmpty) IO ([Char], GenericPackageDescription))
-> Either (ParseError NonEmpty) GenericPackageDescription
-> ExceptT
     (ParseError NonEmpty) IO ([Char], GenericPackageDescription)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty
-> ExceptT
     (ParseError NonEmpty) IO ([Char], GenericPackageDescription)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (\GenericPackageDescription
gpd -> ([Char], GenericPackageDescription)
-> ExceptT
     (ParseError NonEmpty) IO ([Char], GenericPackageDescription)
forall a. a -> ExceptT (ParseError NonEmpty) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fp, GenericPackageDescription
gpd)) ([Char]
-> FieldName
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage [Char]
fp FieldName
contents)