{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module Cabal.Project (
Project (..),
triverseProject,
emptyProject,
readProject,
parseProject,
resolveProject,
ResolveError (..),
renderResolveError,
readPackagesOfProject
) where
import Control.DeepSeq (NFData (..))
import Control.Exception (Exception (..), throwIO)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bimapDefault)
import Data.ByteString (ByteString)
import Data.Either (partitionEithers)
import Data.Foldable (toList)
import Data.Function ((&))
import Data.Functor (void)
import Data.List (foldl', isSuffixOf)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (mapMaybe)
import Data.Traversable (for)
import Data.Void (Void)
import Distribution.Compat.Lens (LensLike', over)
import GHC.Generics (Generic)
import Network.URI (URI (URI), parseURI)
import System.Directory (doesDirectoryExist, doesFileExist)
import System.FilePath (isAbsolute, normalise, splitDirectories, splitDrive, takeDirectory, (</>))
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as M
import qualified Distribution.CabalSpecVersion as C
import qualified Distribution.FieldGrammar as C
import qualified Distribution.Fields as C
import qualified Distribution.PackageDescription as C
import qualified Distribution.Parsec as C
import Cabal.Internal.Glob
import Cabal.Internal.Newtypes
import Cabal.Optimization
import Cabal.Package
import Cabal.Parse
import Cabal.SourceRepo
infixl 1 <&>
(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
data Project uri opt pkg = Project
{ forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages :: [pkg]
, forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages :: [opt]
, forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages :: [uri]
, forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints :: [String]
, forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer :: [String]
, 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 ()]
}
deriving (forall a b. a -> Project uri opt b -> Project uri opt a
forall a b. (a -> b) -> Project uri opt a -> Project uri opt b
forall uri opt a b. a -> Project uri opt b -> Project uri opt a
forall uri opt a b.
(a -> b) -> Project uri opt a -> Project uri opt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Project uri opt b -> Project uri opt a
$c<$ :: forall uri opt a b. a -> Project uri opt b -> Project uri opt a
fmap :: forall a b. (a -> b) -> Project uri opt a -> Project uri opt b
$cfmap :: forall uri opt a b.
(a -> b) -> Project uri opt a -> Project uri opt b
Functor, forall a. Project uri opt a -> Bool
forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
forall uri opt a. Eq a => a -> Project uri opt a -> Bool
forall uri opt a. Num a => Project uri opt a -> a
forall uri opt a. Ord a => Project uri opt a -> a
forall uri opt m. Monoid m => Project uri opt m -> m
forall uri opt pkg. Project uri opt pkg -> Bool
forall uri opt a. Project uri opt a -> Int
forall uri opt pkg. Project uri opt pkg -> [pkg]
forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
forall uri opt a b. (a -> b -> b) -> b -> Project uri opt a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Project uri opt a -> a
$cproduct :: forall uri opt a. Num a => Project uri opt a -> a
sum :: forall a. Num a => Project uri opt a -> a
$csum :: forall uri opt a. Num a => Project uri opt a -> a
minimum :: forall a. Ord a => Project uri opt a -> a
$cminimum :: forall uri opt a. Ord a => Project uri opt a -> a
maximum :: forall a. Ord a => Project uri opt a -> a
$cmaximum :: forall uri opt a. Ord a => Project uri opt a -> a
elem :: forall a. Eq a => a -> Project uri opt a -> Bool
$celem :: forall uri opt a. Eq a => a -> Project uri opt a -> Bool
length :: forall a. Project uri opt a -> Int
$clength :: forall uri opt a. Project uri opt a -> Int
null :: forall a. Project uri opt a -> Bool
$cnull :: forall uri opt pkg. Project uri opt pkg -> Bool
toList :: forall a. Project uri opt a -> [a]
$ctoList :: forall uri opt pkg. Project uri opt pkg -> [pkg]
foldl1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$cfoldl1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldr1 :: forall a. (a -> a -> a) -> Project uri opt a -> a
$cfoldr1 :: forall uri opt a. (a -> a -> a) -> Project uri opt a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
$cfoldl' :: forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Project uri opt a -> b
$cfoldl :: forall uri opt b a. (b -> a -> b) -> b -> Project uri opt a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
$cfoldr' :: forall uri opt a b. (a -> b -> b) -> b -> Project uri opt a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Project uri opt a -> b
$cfoldr :: forall uri opt a b. (a -> b -> b) -> b -> Project uri opt a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
$cfoldMap' :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Project uri opt a -> m
$cfoldMap :: forall uri opt m a. Monoid m => (a -> m) -> Project uri opt a -> m
fold :: forall m. Monoid m => Project uri opt m -> m
$cfold :: forall uri opt m. Monoid m => Project uri opt m -> m
Foldable, forall uri opt. Functor (Project uri opt)
forall uri opt. Foldable (Project uri opt)
forall uri opt (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
forall uri opt (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
forall uri opt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
forall uri opt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
$csequence :: forall uri opt (m :: * -> *) a.
Monad m =>
Project uri opt (m a) -> m (Project uri opt a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
$cmapM :: forall uri opt (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Project uri opt a -> m (Project uri opt b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
$csequenceA :: forall uri opt (f :: * -> *) a.
Applicative f =>
Project uri opt (f a) -> f (Project uri opt a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
$ctraverse :: forall uri opt (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Project uri opt a -> f (Project uri opt b)
Traversable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall uri opt pkg x.
Rep (Project uri opt pkg) x -> Project uri opt pkg
forall uri opt pkg x.
Project uri opt pkg -> Rep (Project uri opt pkg) x
$cto :: forall uri opt pkg x.
Rep (Project uri opt pkg) x -> Project uri opt pkg
$cfrom :: forall uri opt pkg x.
Project uri opt pkg -> Rep (Project uri opt pkg) x
Generic)
instance (Eq uri, Eq opt, Eq pkg) => Eq (Project uri opt pkg) where
Project uri opt pkg
x == :: Project uri opt pkg -> Project uri opt pkg -> Bool
== Project uri opt pkg
y = forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization
, forall {a}. Eq a => (Project uri opt pkg -> a) -> Bool
eqOn forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos
]
where
eqOn :: (Project uri opt pkg -> a) -> Bool
eqOn Project uri opt pkg -> a
f = Project uri opt pkg -> a
f Project uri opt pkg
x forall a. Eq a => a -> a -> Bool
== Project uri opt pkg -> a
f Project uri opt pkg
y
instance (Show uri, Show opt, Show pkg) => Show (Project uri opt pkg) where
showsPrec :: Int -> Project uri opt pkg -> ShowS
showsPrec Int
p Project uri opt pkg
prj =
Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
( [Char] -> ShowS
showString [Char]
"Project{prjPackages = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptPackages = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjUriPackages = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjConstraints = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjAllowNewer = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjReorderGoals = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjMaxBackjumps = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjOptimization = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
", prjSourceRepos = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
)
instance Bifunctor (Project c) where bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Project c a c -> Project c b d
bimap = forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Bifoldable (Project c) where bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Project c a b -> m
bifoldMap = forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
triverseProject
:: Applicative f
=> (uri -> f uri')
-> (opt -> f opt')
-> (pkg -> f pkg')
-> Project uri opt pkg -> f (Project uri' opt' pkg')
triverseProject :: forall (f :: * -> *) uri uri' opt opt' pkg pkg'.
Applicative f =>
(uri -> f uri')
-> (opt -> f opt')
-> (pkg -> f pkg')
-> Project uri opt pkg
-> f (Project uri' opt' pkg')
triverseProject uri -> f uri'
f opt -> f opt'
g pkg -> f pkg'
h Project uri opt pkg
prj =
(\[uri']
c [opt']
b [pkg']
a -> Project uri opt pkg
prj { prjPackages :: [pkg']
prjPackages = [pkg']
a, prjOptPackages :: [opt']
prjOptPackages = [opt']
b, prjUriPackages :: [uri']
prjUriPackages = [uri']
c })
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse uri -> f uri'
f (forall uri opt pkg. Project uri opt pkg -> [uri]
prjUriPackages Project uri opt pkg
prj)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse opt -> f opt'
g (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse pkg -> f pkg'
h (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj)
instance Bitraversable (Project uri) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Project uri a b -> f (Project uri c d)
bitraverse = forall (f :: * -> *) uri uri' opt opt' pkg pkg'.
Applicative f =>
(uri -> f uri')
-> (opt -> f opt')
-> (pkg -> f pkg')
-> Project uri opt pkg
-> f (Project uri' opt' pkg')
triverseProject forall (f :: * -> *) a. Applicative f => a -> f a
pure
emptyProject :: Project c b a
emptyProject :: forall c b a. Project c b a
emptyProject = forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project [] [] [] [] [] Bool
False forall a. Maybe a
Nothing Optimization
OptimizationOn [] []
instance (NFData c, NFData b, NFData a) => NFData (Project c b a) where
rnf :: Project c b a -> ()
rnf (Project [a]
x1 [b]
x2 [c]
x3 [[Char]]
x4 [[Char]]
x5 Bool
x6 Maybe Int
x7 Optimization
x8 [SourceRepositoryPackage Maybe]
x9 [PrettyField ()]
x10) =
forall a. NFData a => a -> ()
rnf [a]
x1 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [b]
x2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [c]
x3 seq :: forall a b. a -> b -> b
`seq`
forall a. NFData a => a -> ()
rnf [[Char]]
x4 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [[Char]]
x5 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Bool
x6 seq :: forall a b. a -> b -> b
`seq`
forall a. NFData a => a -> ()
rnf Maybe Int
x7 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Optimization
x8 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [SourceRepositoryPackage Maybe]
x9 seq :: forall a b. a -> b -> b
`seq`
forall a. (a -> ()) -> [a] -> ()
rnfList forall x. NFData x => PrettyField x -> ()
rnfPrettyField [PrettyField ()]
x10
where
rnfList :: (a -> ()) -> [a] -> ()
rnfList :: forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
_ [] = ()
rnfList a -> ()
f (a
x:[a]
xs) = a -> ()
f a
x seq :: forall a b. a -> b -> b
`seq` forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
f [a]
xs
rnfPrettyField :: NFData x => C.PrettyField x -> ()
rnfPrettyField :: forall x. NFData x => PrettyField x -> ()
rnfPrettyField PrettyField x
C.PrettyEmpty = ()
rnfPrettyField (C.PrettyField x
ann FieldName
fn Doc
d) =
forall a. NFData a => a -> ()
rnf x
ann seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf FieldName
fn seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Doc
d
rnfPrettyField (C.PrettySection x
ann FieldName
fn [Doc]
ds [PrettyField x]
fs) =
forall a. NFData a => a -> ()
rnf x
ann seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf FieldName
fn seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Doc]
ds seq :: forall a b. a -> b -> b
`seq` forall a. (a -> ()) -> [a] -> ()
rnfList forall x. NFData x => PrettyField x -> ()
rnfPrettyField [PrettyField x]
fs
readProject :: FilePath -> IO (Project URI Void (FilePath, C.GenericPackageDescription))
readProject :: [Char] -> IO (Project URI Void ([Char], GenericPackageDescription))
readProject [Char]
fp = do
FieldName
contents <- [Char] -> IO FieldName
BS.readFile [Char]
fp
Project Void [Char] [Char]
prj0 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
parseProject [Char]
fp FieldName
contents)
Project URI Void [Char]
prj1 <- [Char]
-> Project Void [Char] [Char]
-> IO (Either ResolveError (Project URI Void [Char]))
resolveProject [Char]
fp Project Void [Char] [Char]
prj0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return
forall uri opt.
Project uri opt [Char]
-> IO
(Either
(ParseError NonEmpty)
(Project uri opt ([Char], GenericPackageDescription)))
readPackagesOfProject Project URI Void [Char]
prj1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return
parseProject :: FilePath -> ByteString -> Either (ParseError NonEmpty) (Project Void String String)
parseProject :: [Char]
-> FieldName
-> Either (ParseError NonEmpty) (Project Void [Char] [Char])
parseProject = forall a.
([Field Position] -> ParseResult a)
-> [Char] -> FieldName -> Either (ParseError NonEmpty) a
parseWith forall a b. (a -> b) -> a -> b
$ \[Field Position]
fields0 -> do
let (Fields Position
fields1, [[Section Position]]
sections) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields0
let fields2 :: Fields Position
fields2 = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\FieldName
k [NamelessField Position]
_ -> FieldName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldName]
knownFields) Fields Position
fields1
forall {t :: * -> *} {a}.
Foldable t =>
[Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void [Char] [Char])
parse [Field Position]
fields0 Fields Position
fields2 [[Section Position]]
sections
where
knownFields :: [FieldName]
knownFields = forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
(Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar []
parse :: [Field a]
-> Fields Position
-> t [Section Position]
-> ParseResult (Project Void [Char] [Char])
parse [Field a]
otherFields Fields Position
fields t [Section Position]
sections = do
let prettyOtherFields :: [PrettyField ()]
prettyOtherFields = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall ann. [Field ann] -> [PrettyField ann]
C.fromParsecFields forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall ann. Field ann -> Bool
otherFieldName [Field a]
otherFields
Project Void [Char] [Char]
prj <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields forall a b. (a -> b) -> a -> b
$ [PrettyField ()]
-> ParsecFieldGrammar
(Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
prettyOtherFields
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. a -> (a -> b) -> b
(&) Project Void [Char] [Char]
prj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Section Position
-> ParseResult
(Project Void [Char] [Char] -> Project Void [Char] [Char])
parseSec (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Section Position]
sections)
parseSec :: C.Section C.Position -> C.ParseResult (Project Void String String -> Project Void String String)
parseSec :: Section Position
-> ParseResult
(Project Void [Char] [Char] -> Project Void [Char] [Char])
parseSec (C.MkSection (C.Name Position
_pos FieldName
name) [] [Field Position]
fields) | FieldName
name forall a. Eq a => a -> a -> Bool
== FieldName
sourceRepoSectionName = do
let fields' :: Fields Position
fields' = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall ann. [Field ann] -> (Fields ann, [[Section ann]])
C.partitionFields [Field Position]
fields
SourceRepoList
repos <- forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
C.parseFieldGrammar CabalSpecVersion
C.cabalSpecLatest Fields Position
fields' forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepoList),
c (List NoCommaFSep FilePathNT [Char]), c (Identity RepoType)) =>
g SourceRepoList SourceRepoList
sourceRepositoryPackageGrammar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL (forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut SourceRepoList
repos))
parseSec Section Position
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
otherFieldName :: C.Field ann -> Bool
otherFieldName :: forall ann. Field ann -> Bool
otherFieldName (C.Field (C.Name ann
_ FieldName
fn) [FieldLine ann]
_) = FieldName
fn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall s a. ParsecFieldGrammar s a -> [FieldName]
C.fieldGrammarKnownFieldList ([PrettyField ()]
-> ParsecFieldGrammar
(Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [])
otherFieldName (C.Section (C.Name ann
_ FieldName
fn) [SectionArg ann]
_ [Field ann]
_) = FieldName
fn forall a. Eq a => a -> a -> Bool
/= FieldName
sourceRepoSectionName
grammar :: [C.PrettyField ()] -> C.ParsecFieldGrammar (Project Void String String) (Project Void String String)
grammar :: [PrettyField ()]
-> ParsecFieldGrammar
(Project Void [Char] [Char]) (Project Void [Char] [Char])
grammar [PrettyField ()]
otherFields = forall uri opt pkg.
[pkg]
-> [opt]
-> [uri]
-> [[Char]]
-> [[Char]]
-> Bool
-> Maybe Int
-> Optimization
-> [SourceRepositoryPackage Maybe]
-> [PrettyField ()]
-> Project uri opt pkg
Project
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"packages" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"optional-packages" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep [Char] -> PackageLocation
PackageLocation) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"constraints" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjConstraintsL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
C.monoidalFieldAla FieldName
"allow-newer" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' CommaVCat
C.CommaVCat [Char] -> NoCommas
NoCommas) forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjAllowNewerL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
C.booleanFieldDef FieldName
"reorder-goals" forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool
False
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
C.optionalFieldAla FieldName
"max-backjumps" Int -> Int'
Int' forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
C.optionalFieldDef FieldName
"optimization" forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization
OptimizationOn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [PrettyField ()]
otherFields
sourceRepoSectionName :: C.FieldName
sourceRepoSectionName :: FieldName
sourceRepoSectionName = FieldName
"source-repository-package"
prjPackagesL :: Functor f => LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [pkg]
prjPackagesL [pkg] -> f [pkg]
f Project uri opt pkg
prj = [pkg] -> f [pkg]
f (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[pkg]
x -> Project uri opt pkg
prj { prjPackages :: [pkg]
prjPackages = [pkg]
x }
prjOptPackagesL :: Functor f => LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [opt]
prjOptPackagesL [opt] -> f [opt]
f Project uri opt pkg
prj = [opt] -> f [opt]
f (forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[opt]
x -> Project uri opt pkg
prj { prjOptPackages :: [opt]
prjOptPackages = [opt]
x }
prjConstraintsL :: Functor f => LensLike' f (Project uri opt pkg) [String]
prjConstraintsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjConstraintsL [[Char]] -> f [[Char]]
f Project uri opt pkg
prj = [[Char]] -> f [[Char]]
f (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjConstraints Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjConstraints :: [[Char]]
prjConstraints = [[Char]]
x }
prjAllowNewerL :: Functor f => LensLike' f (Project uri opt pkg) [String]
prjAllowNewerL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [[Char]]
prjAllowNewerL [[Char]] -> f [[Char]]
f Project uri opt pkg
prj = [[Char]] -> f [[Char]]
f (forall uri opt pkg. Project uri opt pkg -> [[Char]]
prjAllowNewer Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[[Char]]
x -> Project uri opt pkg
prj { prjAllowNewer :: [[Char]]
prjAllowNewer = [[Char]]
x }
prjReorderGoalsL :: Functor f => LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Bool
prjReorderGoalsL Bool -> f Bool
f Project uri opt pkg
prj = Bool -> f Bool
f (forall uri opt pkg. Project uri opt pkg -> Bool
prjReorderGoals Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
x -> Project uri opt pkg
prj { prjReorderGoals :: Bool
prjReorderGoals = Bool
x }
prjMaxBackjumpsL :: Functor f => LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) (Maybe Int)
prjMaxBackjumpsL Maybe Int -> f (Maybe Int)
f Project uri opt pkg
prj = Maybe Int -> f (Maybe Int)
f (forall uri opt pkg. Project uri opt pkg -> Maybe Int
prjMaxBackjumps Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Int
x -> Project uri opt pkg
prj { prjMaxBackjumps :: Maybe Int
prjMaxBackjumps = Maybe Int
x }
prjOptimizationL :: Functor f => LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) Optimization
prjOptimizationL Optimization -> f Optimization
f Project uri opt pkg
prj = Optimization -> f Optimization
f (forall uri opt pkg. Project uri opt pkg -> Optimization
prjOptimization Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Optimization
x -> Project uri opt pkg
prj { prjOptimization :: Optimization
prjOptimization = Optimization
x }
prjSourceReposL :: Functor f => LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL :: forall (f :: * -> *) uri opt pkg.
Functor f =>
LensLike' f (Project uri opt pkg) [SourceRepositoryPackage Maybe]
prjSourceReposL [SourceRepositoryPackage Maybe]
-> f [SourceRepositoryPackage Maybe]
f Project uri opt pkg
prj = [SourceRepositoryPackage Maybe]
-> f [SourceRepositoryPackage Maybe]
f (forall uri opt pkg.
Project uri opt pkg -> [SourceRepositoryPackage Maybe]
prjSourceRepos Project uri opt pkg
prj) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[SourceRepositoryPackage Maybe]
x -> Project uri opt pkg
prj { prjSourceRepos :: [SourceRepositoryPackage Maybe]
prjSourceRepos = [SourceRepositoryPackage Maybe]
x }
newtype ResolveError = BadPackageLocation String
deriving Int -> ResolveError -> ShowS
[ResolveError] -> ShowS
ResolveError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResolveError] -> ShowS
$cshowList :: [ResolveError] -> ShowS
show :: ResolveError -> [Char]
$cshow :: ResolveError -> [Char]
showsPrec :: Int -> ResolveError -> ShowS
$cshowsPrec :: Int -> ResolveError -> ShowS
Show
instance Exception ResolveError where
displayException :: ResolveError -> [Char]
displayException = ResolveError -> [Char]
renderResolveError
renderResolveError :: ResolveError -> String
renderResolveError :: ResolveError -> [Char]
renderResolveError (BadPackageLocation [Char]
s) = [Char]
"Bad package location: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
s
resolveProject
:: FilePath
-> Project Void String String
-> IO (Either ResolveError (Project URI Void FilePath))
resolveProject :: [Char]
-> Project Void [Char] [Char]
-> IO (Either ResolveError (Project URI Void [Char]))
resolveProject [Char]
filePath Project Void [Char] [Char]
prj = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
Project Void [Either URI [Char]] [Either URI [Char]]
prj' <- forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findOptProjectPackage [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findProjectPackage Project Void [Char] [Char]
prj
let ([URI]
uris, [[Char]]
pkgs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
let ([URI]
uris', [[Char]]
pkgs') = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall uri opt pkg. Project uri opt pkg -> [opt]
prjOptPackages Project Void [Either URI [Char]] [Either URI [Char]]
prj'
forall (m :: * -> *) a. Monad m => a -> m a
return Project Void [Either URI [Char]] [Either URI [Char]]
prj'
{ prjPackages :: [[Char]]
prjPackages = [[Char]]
pkgs forall a. [a] -> [a] -> [a]
++ [[Char]]
pkgs'
, prjOptPackages :: [Void]
prjOptPackages = []
, prjUriPackages :: [URI]
prjUriPackages = [URI]
uris forall a. [a] -> [a] -> [a]
++ [URI]
uris'
}
where
rootdir :: [Char]
rootdir = ShowS
takeDirectory [Char]
filePath
addroot :: ShowS
addroot [Char]
p = ShowS
normalise ([Char]
rootdir [Char] -> ShowS
</> [Char]
p)
findProjectPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
findProjectPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findProjectPackage [Char]
pkglocstr = do
[Either URI [Char]]
mfp <- [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
[Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall {a}. a -> [a]
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) ([Char] -> Maybe URI
parseURI [Char]
pkglocstr))
case [Either URI [Char]]
mfp of
[] -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ [Char] -> ResolveError
BadPackageLocation [Char]
pkglocstr
[Either URI [Char]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Either URI [Char]]
mfp
singleton :: a -> [a]
singleton a
x = [a
x]
findOptProjectPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
findOptProjectPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
findOptProjectPackage [Char]
pkglocstr =
[Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
`mplusMaybeT`
[Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr
checkIsSingleFilePackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
checkIsSingleFilePackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkIsSingleFilePackage [Char]
pkglocstr = do
let abspath :: [Char]
abspath = ShowS
addroot [Char]
pkglocstr
Bool
isFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
abspath
Bool
isDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist [Char]
abspath
if | Bool
isFile, Just Either URI [Char]
p <- [Char] -> Maybe (Either URI [Char])
checkFile [Char]
abspath -> forall (m :: * -> *) a. Monad m => a -> m a
return [Either URI [Char]
p]
| Bool
isDir -> FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob ([Char] -> FilePathGlob
globStarDotCabal [Char]
pkglocstr)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return []
checkisFileGlobPackage :: String -> ExceptT ResolveError IO [Either URI FilePath]
checkisFileGlobPackage :: [Char] -> ExceptT ResolveError IO [Either URI [Char]]
checkisFileGlobPackage [Char]
pkglocstr = case forall a. Parsec a => [Char] -> Either [Char] a
C.eitherParsec [Char]
pkglocstr of
Right FilePathGlob
g -> FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob FilePathGlob
g
Left [Char]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
checkGlob :: FilePathGlob -> ExceptT ResolveError IO [Either URI FilePath]
checkGlob :: FilePathGlob -> ExceptT ResolveError IO [Either URI [Char]]
checkGlob FilePathGlob
glob = do
[[Char]]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> FilePathGlob -> IO [[Char]]
matchFileGlob [Char]
rootdir FilePathGlob
glob
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Char] -> Maybe (Either URI [Char])
checkFile [[Char]]
files
checkFile :: FilePath -> Maybe (Either URI FilePath)
checkFile :: [Char] -> Maybe (Either URI [Char])
checkFile [Char]
abspath
| [Char]
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Char]
abspath
| [Char]
".tar.gz" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
abspath = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI [Char]
"file:" forall a. Maybe a
Nothing [Char]
abspath [Char]
"" [Char]
""
| Bool
otherwise = forall a. Maybe a
Nothing
globStarDotCabal :: FilePath -> FilePathGlob
globStarDotCabal :: [Char] -> FilePathGlob
globStarDotCabal [Char]
dir =
FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob
(if [Char] -> Bool
isAbsolute [Char]
dir then [Char] -> FilePathRoot
FilePathRoot [Char]
root else FilePathRoot
FilePathRelative)
(forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[Char]
d -> Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir [[Char] -> GlobPiece
Literal [Char]
d])
(Glob -> FilePathGlobRel
GlobFile [GlobPiece
WildCard, [Char] -> GlobPiece
Literal [Char]
".cabal"]) [[Char]]
dirComponents)
where
([Char]
root, [[Char]]
dirComponents) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [[Char]]
splitDirectories ([Char] -> ([Char], [Char])
splitDrive [Char]
dir)
mplusMaybeT :: Monad m => m [a] -> m [a] -> m [a]
mplusMaybeT :: forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
mplusMaybeT m [a]
ma m [a]
mb = do
[a]
mx <- m [a]
ma
case [a]
mx of
[] -> m [a]
mb
[a]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
readPackagesOfProject :: Project uri opt FilePath -> IO (Either (ParseError NonEmpty) (Project uri opt (FilePath, C.GenericPackageDescription)))
readPackagesOfProject :: forall uri opt.
Project uri opt [Char]
-> IO
(Either
(ParseError NonEmpty)
(Project uri opt ([Char], GenericPackageDescription)))
readPackagesOfProject Project uri opt [Char]
prj = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Project uri opt [Char]
prj forall a b. (a -> b) -> a -> b
$ \[Char]
fp -> do
FieldName
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO FieldName
BS.readFile [Char]
fp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (\GenericPackageDescription
gpd -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
fp, GenericPackageDescription
gpd)) ([Char]
-> FieldName
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage [Char]
fp FieldName
contents)