{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Distribution.Client.Add (
CommonStanza (..),
Config (..),
parseCabalFile,
resolveComponent,
validateDependency,
executeConfig,
validateChanges,
) where
import Control.Monad.Error.Class (MonadError, throwError)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as B
import Data.ByteString.Internal (isSpaceChar8)
import Data.List qualified as L
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Set (Set)
import Data.Set qualified as S
import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV1_0))
import Distribution.Fields (
Field (..),
FieldLine (..),
Name (..),
SectionArg (..),
readFields,
)
import Distribution.PackageDescription (
ComponentName (..),
Dependency,
GenericPackageDescription (..),
LibraryName (..),
PackageDescription (..),
componentNameStanza,
componentNameString,
unUnqualComponentName,
)
import Distribution.PackageDescription.Parsec (
parseGenericPackageDescription,
parseGenericPackageDescriptionMaybe,
runParseResult,
)
import Distribution.Parsec (Position (..), eitherParsec, showPError)
newtype CommonStanza = CommonStanza {CommonStanza -> ByteString
unCommonStanza :: ByteString}
deriving (CommonStanza -> CommonStanza -> Bool
(CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool) -> Eq CommonStanza
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonStanza -> CommonStanza -> Bool
== :: CommonStanza -> CommonStanza -> Bool
$c/= :: CommonStanza -> CommonStanza -> Bool
/= :: CommonStanza -> CommonStanza -> Bool
Eq, Eq CommonStanza
Eq CommonStanza =>
(CommonStanza -> CommonStanza -> Ordering)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> CommonStanza)
-> (CommonStanza -> CommonStanza -> CommonStanza)
-> Ord CommonStanza
CommonStanza -> CommonStanza -> Bool
CommonStanza -> CommonStanza -> Ordering
CommonStanza -> CommonStanza -> CommonStanza
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommonStanza -> CommonStanza -> Ordering
compare :: CommonStanza -> CommonStanza -> Ordering
$c< :: CommonStanza -> CommonStanza -> Bool
< :: CommonStanza -> CommonStanza -> Bool
$c<= :: CommonStanza -> CommonStanza -> Bool
<= :: CommonStanza -> CommonStanza -> Bool
$c> :: CommonStanza -> CommonStanza -> Bool
> :: CommonStanza -> CommonStanza -> Bool
$c>= :: CommonStanza -> CommonStanza -> Bool
>= :: CommonStanza -> CommonStanza -> Bool
$cmax :: CommonStanza -> CommonStanza -> CommonStanza
max :: CommonStanza -> CommonStanza -> CommonStanza
$cmin :: CommonStanza -> CommonStanza -> CommonStanza
min :: CommonStanza -> CommonStanza -> CommonStanza
Ord, Int -> CommonStanza -> ShowS
[CommonStanza] -> ShowS
CommonStanza -> String
(Int -> CommonStanza -> ShowS)
-> (CommonStanza -> String)
-> ([CommonStanza] -> ShowS)
-> Show CommonStanza
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonStanza -> ShowS
showsPrec :: Int -> CommonStanza -> ShowS
$cshow :: CommonStanza -> String
show :: CommonStanza -> String
$cshowList :: [CommonStanza] -> ShowS
showList :: [CommonStanza] -> ShowS
Show)
data Config = Config
{ Config -> ByteString
cnfOrigContents :: !ByteString
, Config -> [Field Position]
cnfFields :: ![Field Position]
, Config -> Either CommonStanza ComponentName
cnfComponent :: !(Either CommonStanza ComponentName)
, Config -> NonEmpty ByteString
cnfDependencies :: !(NonEmpty ByteString)
}
deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)
extractComponentNames :: GenericPackageDescription -> Set ComponentName
GenericPackageDescription {[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
[PackageFlag]
Maybe (CondTree ConfVar [Dependency] Library)
Maybe Version
PackageDescription
packageDescription :: PackageDescription
gpdScannedVersion :: Maybe Version
genPackageFlags :: [PackageFlag]
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
packageDescription :: GenericPackageDescription -> PackageDescription
gpdScannedVersion :: GenericPackageDescription -> Maybe Version
genPackageFlags :: GenericPackageDescription -> [PackageFlag]
condLibrary :: GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condSubLibraries :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condForeignLibs :: GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
condExecutables :: GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condTestSuites :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condBenchmarks :: GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
..} =
(CondTree ConfVar [Dependency] Library -> Set ComponentName)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set ComponentName
-> CondTree ConfVar [Dependency] Library -> Set ComponentName
forall a b. a -> b -> a
const (Set ComponentName
-> CondTree ConfVar [Dependency] Library -> Set ComponentName)
-> Set ComponentName
-> CondTree ConfVar [Dependency] Library
-> Set ComponentName
forall a b. (a -> b) -> a -> b
$ ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ComponentName -> Set ComponentName
forall a b. (a -> b) -> a -> b
$ LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
Set ComponentName -> Set ComponentName -> Set ComponentName
forall a. Semigroup a => a -> a -> a
<> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Set ComponentName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Set ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> LibraryName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> LibraryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
Set ComponentName -> Set ComponentName -> Set ComponentName
forall a. Semigroup a => a -> a -> a
<> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Set ComponentName)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Set ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> ComponentName
CFLibName (UnqualComponentName -> ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs
Set ComponentName -> Set ComponentName -> Set ComponentName
forall a. Semigroup a => a -> a -> a
<> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Set ComponentName)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Set ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> ComponentName
CExeName (UnqualComponentName -> ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables
Set ComponentName -> Set ComponentName -> Set ComponentName
forall a. Semigroup a => a -> a -> a
<> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Set ComponentName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Set ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> ComponentName
CTestName (UnqualComponentName -> ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
Set ComponentName -> Set ComponentName -> Set ComponentName
forall a. Semigroup a => a -> a -> a
<> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Set ComponentName)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Set ComponentName
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ComponentName -> Set ComponentName
forall a. a -> Set a
S.singleton (ComponentName -> Set ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Set ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> ComponentName
CBenchName (UnqualComponentName -> ComponentName)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> UnqualComponentName
forall a b. (a, b) -> a
fst) [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
extractCommonStanzas :: [Field ann] -> Set CommonStanza
= (Field ann -> Set CommonStanza) -> [Field ann] -> Set CommonStanza
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Field ann -> Set CommonStanza
forall {ann}. Field ann -> Set CommonStanza
go
where
go :: Field ann -> Set CommonStanza
go = \case
Section (Name ann
_ ByteString
"common") [SecArgName ann
_pos ByteString
sectionArg] [Field ann]
_subFields ->
CommonStanza -> Set CommonStanza
forall a. a -> Set a
S.singleton (CommonStanza -> Set CommonStanza)
-> CommonStanza -> Set CommonStanza
forall a b. (a -> b) -> a -> b
$ ByteString -> CommonStanza
CommonStanza ByteString
sectionArg
Section (Name ann
_ ByteString
"common") [SecArgStr ann
_pos ByteString
sectionArg] [Field ann]
_subFields ->
CommonStanza -> Set CommonStanza
forall a. a -> Set a
S.singleton (CommonStanza -> Set CommonStanza)
-> CommonStanza -> Set CommonStanza
forall a b. (a -> b) -> a -> b
$ ByteString -> CommonStanza
CommonStanza ByteString
sectionArg
Field ann
_ -> Set CommonStanza
forall a. Monoid a => a
mempty
data Resolution a = NotFound | Resolved a | Ambiguous
deriving ((forall a b. (a -> b) -> Resolution a -> Resolution b)
-> (forall a b. a -> Resolution b -> Resolution a)
-> Functor Resolution
forall a b. a -> Resolution b -> Resolution a
forall a b. (a -> b) -> Resolution a -> Resolution b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Resolution a -> Resolution b
fmap :: forall a b. (a -> b) -> Resolution a -> Resolution b
$c<$ :: forall a b. a -> Resolution b -> Resolution a
<$ :: forall a b. a -> Resolution b -> Resolution a
Functor)
instance Semigroup (Resolution a) where
a :: Resolution a
a@Resolved {} <> :: Resolution a -> Resolution a -> Resolution a
<> Resolution a
_ = Resolution a
a
Resolution a
_ <> a :: Resolution a
a@Resolved {} = Resolution a
a
Resolution a
Ambiguous <> Resolution a
_ = Resolution a
forall a. Resolution a
Ambiguous
Resolution a
_ <> Resolution a
Ambiguous = Resolution a
forall a. Resolution a
Ambiguous
Resolution a
NotFound <> Resolution a
NotFound = Resolution a
forall a. Resolution a
NotFound
resolveMainLib :: Set ComponentName -> Resolution ComponentName
resolveMainLib :: Set ComponentName -> Resolution ComponentName
resolveMainLib Set ComponentName
knownNames
| LibraryName -> ComponentName
CLibName LibraryName
LMainLibName ComponentName -> Set ComponentName -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set ComponentName
knownNames = ComponentName -> Resolution ComponentName
forall a. a -> Resolution a
Resolved (ComponentName -> Resolution ComponentName)
-> ComponentName -> Resolution ComponentName
forall a b. (a -> b) -> a -> b
$ LibraryName -> ComponentName
CLibName LibraryName
LMainLibName
| Bool
otherwise = Resolution ComponentName
forall a. Resolution a
NotFound
resolveDefaultComponent :: Set ComponentName -> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent :: Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ComponentName -> Bool
predicate =
case (ComponentName -> Bool) -> [ComponentName] -> [ComponentName]
forall a. (a -> Bool) -> [a] -> [a]
filter ComponentName -> Bool
predicate (Set ComponentName -> [ComponentName]
forall a. Set a -> [a]
S.toList Set ComponentName
knownNames) of
[] -> Resolution ComponentName
forall a. Resolution a
NotFound
[ComponentName
x] -> ComponentName -> Resolution ComponentName
forall a. a -> Resolution a
Resolved ComponentName
x
[ComponentName]
_ -> Resolution ComponentName
forall a. Resolution a
Ambiguous
isCLibName :: ComponentName -> Bool
isCLibName :: ComponentName -> Bool
isCLibName = \case
CLibName {} -> Bool
True
ComponentName
_ -> Bool
False
isCFLibName :: ComponentName -> Bool
isCFLibName :: ComponentName -> Bool
isCFLibName = \case
CFLibName {} -> Bool
True
ComponentName
_ -> Bool
False
isCExeName :: ComponentName -> Bool
isCExeName :: ComponentName -> Bool
isCExeName = \case
CExeName {} -> Bool
True
ComponentName
_ -> Bool
False
isCTestName :: ComponentName -> Bool
isCTestName :: ComponentName -> Bool
isCTestName = \case
CTestName {} -> Bool
True
ComponentName
_ -> Bool
False
isCBenchName :: ComponentName -> Bool
isCBenchName :: ComponentName -> Bool
isCBenchName = \case
CBenchName {} -> Bool
True
ComponentName
_ -> Bool
False
resolveToComponentName :: Set ComponentName -> Maybe String -> Resolution ComponentName
resolveToComponentName :: Set ComponentName -> Maybe String -> Resolution ComponentName
resolveToComponentName Set ComponentName
knownNames = \case
Maybe String
Nothing -> case Set ComponentName -> Maybe (ComponentName, Set ComponentName)
forall a. Set a -> Maybe (a, Set a)
S.minView Set ComponentName
knownNames of
Just (ComponentName
knownName, Set ComponentName
rest)
| Set ComponentName -> Bool
forall a. Set a -> Bool
S.null Set ComponentName
rest -> ComponentName -> Resolution ComponentName
forall a. a -> Resolution a
Resolved ComponentName
knownName
Maybe (ComponentName, Set ComponentName)
_ -> Set ComponentName -> Resolution ComponentName
resolveMainLib Set ComponentName
knownNames
Just String
name
| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"lib", String
"library"] ->
Set ComponentName -> Resolution ComponentName
resolveMainLib Set ComponentName
knownNames
| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"flib", String
"foreign-library"] ->
Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ComponentName -> Bool
isCFLibName
| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"exe", String
"executable"] ->
Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ComponentName -> Bool
isCExeName
| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"tst", String
"test", String
"test-suite"] ->
Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ComponentName -> Bool
isCTestName
| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"bench", String
"benchmark"] ->
Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ComponentName -> Bool
isCBenchName
| Bool
otherwise ->
Set ComponentName
-> (ComponentName -> Bool) -> Resolution ComponentName
resolveDefaultComponent Set ComponentName
knownNames ((ComponentName -> Bool) -> Resolution ComponentName)
-> (ComponentName -> Bool) -> Resolution ComponentName
forall a b. (a -> b) -> a -> b
$ \ComponentName
x -> case ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
x of
Maybe UnqualComponentName
Nothing -> Bool
False
Just UnqualComponentName
xs -> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name
specialComponents :: Set ComponentName -> Set String
specialComponents :: Set ComponentName -> Set String
specialComponents Set ComponentName
knownNames =
[String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$
(String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
isResolvable [String
"lib", String
"flib", String
"exe", String
"test", String
"bench"]
where
isResolvable :: String -> Maybe String
isResolvable String
xs = case Set ComponentName -> Maybe String -> Resolution ComponentName
resolveToComponentName Set ComponentName
knownNames (String -> Maybe String
forall a. a -> Maybe a
Just String
xs) of
Resolved {} -> String -> Maybe String
forall a. a -> Maybe a
Just String
xs
Resolution ComponentName
_ -> Maybe String
forall a. Maybe a
Nothing
resolveToCommonStanza :: Set CommonStanza -> Maybe String -> Resolution CommonStanza
resolveToCommonStanza :: Set CommonStanza -> Maybe String -> Resolution CommonStanza
resolveToCommonStanza Set CommonStanza
knownNames (Just (ByteString -> CommonStanza
CommonStanza (ByteString -> CommonStanza)
-> (String -> ByteString) -> String -> CommonStanza
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack -> CommonStanza
name))
| CommonStanza -> Set CommonStanza -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member CommonStanza
name Set CommonStanza
knownNames = CommonStanza -> Resolution CommonStanza
forall a. a -> Resolution a
Resolved CommonStanza
name
resolveToCommonStanza Set CommonStanza
_ Maybe String
_ = Resolution CommonStanza
forall a. Resolution a
NotFound
isSection :: Field ann -> Bool
isSection :: forall ann. Field ann -> Bool
isSection = \case
Field {} -> Bool
False
Section {} -> Bool
True
parseCabalFile
:: MonadError String m
=> FilePath
-> ByteString
-> m ([Field Position], GenericPackageDescription)
parseCabalFile :: forall (m :: * -> *).
MonadError String m =>
String
-> ByteString -> m ([Field Position], GenericPackageDescription)
parseCabalFile String
fileName ByteString
contents = do
let legacyErr :: String
legacyErr = String
"Legacy, unsectioned Cabal files are unsupported"
errorWithCtx :: String -> m a
errorWithCtx String
msg =
String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
String
"Cannot parse input Cabal file "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fileName
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" because:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
[Field Position]
fields <- case ByteString -> Either ParseError [Field Position]
readFields ByteString
contents of
Left ParseError
err -> String -> m [Field Position]
forall {m :: * -> *} {a}. MonadError String m => String -> m a
errorWithCtx (String -> m [Field Position]) -> String -> m [Field Position]
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
Right [Field Position]
fs
| (Field Position -> Bool) -> [Field Position] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Field Position -> Bool
forall ann. Field ann -> Bool
isSection [Field Position]
fs -> [Field Position] -> m [Field Position]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Field Position]
fs
| Bool
otherwise -> String -> m [Field Position]
forall {m :: * -> *} {a}. MonadError String m => String -> m a
errorWithCtx String
legacyErr
GenericPackageDescription
packDescr <- case ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a, b) -> b
snd (([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription)
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
-> Either
(Maybe Version, NonEmpty PError) GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
contents of
Left (Maybe Version
_, NonEmpty PError
err) ->
String -> m GenericPackageDescription
forall {m :: * -> *} {a}. MonadError String m => String -> m a
errorWithCtx (String -> m GenericPackageDescription)
-> String -> m GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ [String] -> String
L.unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PError -> String) -> [PError] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> PError -> String
showPError String
fileName) ([PError] -> [String]) -> [PError] -> [String]
forall a b. (a -> b) -> a -> b
$ NonEmpty PError -> [PError]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PError
err
Right GenericPackageDescription {packageDescription :: GenericPackageDescription -> PackageDescription
packageDescription = PackageDescription {specVersion :: PackageDescription -> CabalSpecVersion
specVersion = CabalSpecVersion
CabalSpecV1_0}} ->
String -> m GenericPackageDescription
forall {m :: * -> *} {a}. MonadError String m => String -> m a
errorWithCtx String
legacyErr
Right GenericPackageDescription
pd -> GenericPackageDescription -> m GenericPackageDescription
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenericPackageDescription
pd
([Field Position], GenericPackageDescription)
-> m ([Field Position], GenericPackageDescription)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Field Position]
fields, GenericPackageDescription
packDescr)
resolveComponent
:: MonadError String m
=> FilePath
-> ([Field Position], GenericPackageDescription)
-> Maybe String
-> m (Either CommonStanza ComponentName)
resolveComponent :: forall (m :: * -> *).
MonadError String m =>
String
-> ([Field Position], GenericPackageDescription)
-> Maybe String
-> m (Either CommonStanza ComponentName)
resolveComponent
String
fileName
([Field Position] -> Set CommonStanza
forall ann. [Field ann] -> Set CommonStanza
extractCommonStanzas -> Set CommonStanza
commonStanzas, GenericPackageDescription -> Set ComponentName
extractComponentNames -> Set ComponentName
componentNames)
Maybe String
component = case Resolution (Either CommonStanza ComponentName)
resolution of
Resolution (Either CommonStanza ComponentName)
NotFound -> String -> m (Either CommonStanza ComponentName)
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (Either CommonStanza ComponentName))
-> String -> m (Either CommonStanza ComponentName)
forall a b. (a -> b) -> a -> b
$ case Maybe String
component of
Maybe String
Nothing ->
String
"Default target component not found in "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fileName
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
knownTargetsHint
Just String
cmp ->
String
"Target component '"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmp
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' not found in "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fileName
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
knownTargetsHint
Resolved Either CommonStanza ComponentName
cmp -> Either CommonStanza ComponentName
-> m (Either CommonStanza ComponentName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either CommonStanza ComponentName
cmp
Resolution (Either CommonStanza ComponentName)
Ambiguous ->
String -> m (Either CommonStanza ComponentName)
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (Either CommonStanza ComponentName))
-> String -> m (Either CommonStanza ComponentName)
forall a b. (a -> b) -> a -> b
$
String
"Target component is ambiguous.\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
knownTargetsHint
where
allTargets :: Set String
allTargets =
[String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ((ComponentName -> Maybe String) -> [ComponentName] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((UnqualComponentName -> String)
-> Maybe UnqualComponentName -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnqualComponentName -> String
unUnqualComponentName (Maybe UnqualComponentName -> Maybe String)
-> (ComponentName -> Maybe UnqualComponentName)
-> ComponentName
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> Maybe UnqualComponentName
componentNameString) (Set ComponentName -> [ComponentName]
forall a. Set a -> [a]
S.toList Set ComponentName
componentNames))
Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> (CommonStanza -> String) -> Set CommonStanza -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (ByteString -> String
B.unpack (ByteString -> String)
-> (CommonStanza -> ByteString) -> CommonStanza -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonStanza -> ByteString
unCommonStanza) Set CommonStanza
commonStanzas
Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> Set ComponentName -> Set String
specialComponents Set ComponentName
componentNames
knownTargetsHint :: String
knownTargetsHint =
String
"Specify one with -c: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " (Set String -> [String]
forall a. Set a -> [a]
S.toList Set String
allTargets)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
resolution :: Resolution (Either CommonStanza ComponentName)
resolution =
(ComponentName -> Either CommonStanza ComponentName)
-> Resolution ComponentName
-> Resolution (Either CommonStanza ComponentName)
forall a b. (a -> b) -> Resolution a -> Resolution b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComponentName -> Either CommonStanza ComponentName
forall a b. b -> Either a b
Right (Set ComponentName -> Maybe String -> Resolution ComponentName
resolveToComponentName Set ComponentName
componentNames Maybe String
component)
Resolution (Either CommonStanza ComponentName)
-> Resolution (Either CommonStanza ComponentName)
-> Resolution (Either CommonStanza ComponentName)
forall a. Semigroup a => a -> a -> a
<> (CommonStanza -> Either CommonStanza ComponentName)
-> Resolution CommonStanza
-> Resolution (Either CommonStanza ComponentName)
forall a b. (a -> b) -> Resolution a -> Resolution b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommonStanza -> Either CommonStanza ComponentName
forall a b. a -> Either a b
Left (Set CommonStanza -> Maybe String -> Resolution CommonStanza
resolveToCommonStanza Set CommonStanza
commonStanzas Maybe String
component)
validateDependency
:: MonadError String m
=> String
-> m ByteString
validateDependency :: forall (m :: * -> *). MonadError String m => String -> m ByteString
validateDependency String
d = case String -> Either String Dependency
forall a. Parsec a => String -> Either String a
eitherParsec String
d of
Right (Dependency
_ :: Dependency) -> ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
d
Left String
err ->
String -> m ByteString
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$
String
"Cannot parse the specified dependency '"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' because:\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
splitAtPosition :: Position -> ByteString -> (ByteString, ByteString)
splitAtPosition :: Position -> ByteString -> (ByteString, ByteString)
splitAtPosition (Position Int
line Int
row) ByteString
bs
| Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
bs
| Bool
otherwise = case Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
L.drop (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [Int]
nls of
[] -> (ByteString
bs, ByteString
forall a. Monoid a => a
mempty)
Int
nl : [Int]
_ -> Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
nl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
row) ByteString
bs
where
nls :: [Int]
nls = Char -> ByteString -> [Int]
B.elemIndices Char
'\n' ByteString
bs
splitAtPositionLine :: Position -> ByteString -> (ByteString, ByteString)
splitAtPositionLine :: Position -> ByteString -> (ByteString, ByteString)
splitAtPositionLine (Position Int
line Int
_row) = Position -> ByteString -> (ByteString, ByteString)
splitAtPosition (Int -> Int -> Position
Position Int
line Int
1)
isComponent :: Either CommonStanza ComponentName -> Field a -> Bool
isComponent :: forall a. Either CommonStanza ComponentName -> Field a -> Bool
isComponent (Right ComponentName
cmp) = \case
Section (Name a
_ ByteString
"library") [] [Field a]
_subFields
| ComponentName
cmp ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName ->
Bool
True
Section (Name a
_ ByteString
sectionName) [SecArgName a
_pos ByteString
sectionArg] [Field a]
_subFields
| ByteString
sectionName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B.pack (ComponentName -> String
componentNameStanza ComponentName
cmp) ->
Bool
True
Section (Name a
_ ByteString
sectionName) [SecArgStr a
_pos ByteString
sectionArg] [Field a]
_subFields
| ByteString
sectionName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B.pack (ComponentName -> String
componentNameStanza ComponentName
cmp) ->
Bool
True
Field a
_ -> Bool
False
isComponent (Left (CommonStanza ByteString
commonName)) = \case
Section (Name a
_ ByteString
"common") [SecArgName a
_pos ByteString
sectionArg] [Field a]
_subFields ->
ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
commonName
Section (Name a
_ ByteString
"common") [SecArgStr a
_pos ByteString
sectionArg] [Field a]
_subFields ->
ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
commonName
Field a
_ -> Bool
False
findNonImportField :: [Field Position] -> Maybe Position
findNonImportField :: [Field Position] -> Maybe Position
findNonImportField (Section Name Position
_ [SectionArg Position]
_ [Field Position]
subFields : [Field Position]
rest) =
case (Field Position -> Bool) -> [Field Position] -> [Field Position]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Field Position -> Bool) -> Field Position -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field Position -> Bool
forall ann. Field ann -> Bool
isImportField) [Field Position]
subFields of
Field Position
fld : [Field Position]
_ -> Position -> Maybe Position
forall a. a -> Maybe a
Just (Position -> Maybe Position) -> Position -> Maybe Position
forall a b. (a -> b) -> a -> b
$ Field Position -> Position
forall ann. Field ann -> ann
getFieldNameAnn Field Position
fld
[] -> case [Field Position]
rest of
Field Position
fld : [Field Position]
_ -> case Field Position -> Position
forall ann. Field ann -> ann
getFieldNameAnn Field Position
fld of
Position Int
line Int
_ -> Position -> Maybe Position
forall a. a -> Maybe a
Just (Int -> Int -> Position
Position Int
line Int
defaultRow)
[] -> Position -> Maybe Position
forall a. a -> Maybe a
Just (Int -> Int -> Position
Position Int
forall a. Bounded a => a
maxBound Int
defaultRow)
where
defaultRow :: Int
defaultRow = case [Field Position] -> [Field Position]
forall a. [a] -> [a]
reverse [Field Position]
subFields of
[] -> Int
3
Field Position
fld : [Field Position]
_ -> case Field Position -> Position
forall ann. Field ann -> ann
getFieldNameAnn Field Position
fld of
Position Int
_ Int
row -> Int
row
findNonImportField [Field Position]
_ = Maybe Position
forall a. Maybe a
Nothing
isImportField :: Field a -> Bool
isImportField :: forall ann. Field ann -> Bool
isImportField = \case
Field (Name a
_ ByteString
fieldName) [FieldLine a]
_ -> ByteString
fieldName ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"import"
Section {} -> Bool
False
getFieldNameAnn :: Field ann -> ann
getFieldNameAnn :: forall ann. Field ann -> ann
getFieldNameAnn = \case
Field (Name ann
ann ByteString
_) [FieldLine ann]
_ -> ann
ann
Section (Name ann
ann ByteString
_) [SectionArg ann]
_ [Field ann]
_ -> ann
ann
isBuildDependsField :: Field ann -> Bool
isBuildDependsField :: forall ann. Field ann -> Bool
isBuildDependsField = \case
Field (Name ann
_ ByteString
"build-depends") [FieldLine ann]
_ -> Bool
True
Field ann
_ -> Bool
False
detectLeadingComma :: ByteString -> Maybe ByteString
detectLeadingComma :: ByteString -> Maybe ByteString
detectLeadingComma ByteString
xs = case ByteString -> Maybe (Char, ByteString)
B.uncons ByteString
xs of
Just (Char
',', ByteString
ys) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> ByteString
B.cons Char
',' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
ys
Maybe (Char, ByteString)
_ -> Maybe ByteString
forall a. Maybe a
Nothing
dropRepeatingSpaces :: ByteString -> ByteString
dropRepeatingSpaces :: ByteString -> ByteString
dropRepeatingSpaces ByteString
xs = case ByteString -> Maybe (Char, ByteString)
B.uncons ByteString
xs of
Just (Char
' ', ByteString
ys) -> Char -> ByteString -> ByteString
B.cons Char
' ' ((Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ByteString
ys)
Maybe (Char, ByteString)
_ -> ByteString
xs
fancyAlgorithm :: Config -> Maybe ByteString
fancyAlgorithm :: Config -> Maybe ByteString
fancyAlgorithm Config {[Field Position]
cnfFields :: Config -> [Field Position]
cnfFields :: [Field Position]
cnfFields, Either CommonStanza ComponentName
cnfComponent :: Config -> Either CommonStanza ComponentName
cnfComponent :: Either CommonStanza ComponentName
cnfComponent, ByteString
cnfOrigContents :: Config -> ByteString
cnfOrigContents :: ByteString
cnfOrigContents, NonEmpty ByteString
cnfDependencies :: Config -> NonEmpty ByteString
cnfDependencies :: NonEmpty ByteString
cnfDependencies} = do
Field Position
component <- (Field Position -> Bool)
-> [Field Position] -> Maybe (Field Position)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Either CommonStanza ComponentName -> Field Position -> Bool
forall a. Either CommonStanza ComponentName -> Field a -> Bool
isComponent Either CommonStanza ComponentName
cnfComponent) [Field Position]
cnfFields
Section Name Position
_ [SectionArg Position]
_ [Field Position]
subFields <- Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field Position
component
Field Position
buildDependsField <- (Field Position -> Bool)
-> [Field Position] -> Maybe (Field Position)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Field Position -> Bool
forall ann. Field ann -> Bool
isBuildDependsField [Field Position]
subFields
Field Name Position
_ (FieldLine Position
firstDepPos ByteString
_dep : [FieldLine Position]
restDeps) <- Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field Position
buildDependsField
let secondDepPos :: Maybe Position
secondDepPos = case [FieldLine Position]
restDeps of
FieldLine Position
pos ByteString
_dep : [FieldLine Position]
_ -> Position -> Maybe Position
forall a. a -> Maybe a
Just Position
pos
[FieldLine Position]
_ -> Maybe Position
forall a. Maybe a
Nothing
fillerPred :: Char -> Bool
fillerPred Char
c = Char -> Bool
isSpaceChar8 Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','
let ((Char -> Bool) -> ByteString -> ByteString
B.takeWhileEnd Char -> Bool
fillerPred -> ByteString
pref, (Char -> Bool) -> ByteString -> ByteString
B.takeWhile Char -> Bool
fillerPred -> ByteString
suff) =
Position -> ByteString -> (ByteString, ByteString)
splitAtPosition Position
firstDepPos ByteString
cnfOrigContents
prefSuff :: ByteString
prefSuff = ByteString
pref ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
suff
(ByteString
afterLast, ByteString
inBetween, ByteString
beforeFirst) = case Maybe Position
secondDepPos of
Maybe Position
Nothing ->
( if (Char -> Bool) -> ByteString -> Bool
B.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
prefSuff then ByteString
pref' else ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pref'
, if (Char -> Bool) -> ByteString -> Bool
B.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
prefSuff then ByteString
prefSuff' else ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
prefSuff'
, ByteString
suff
)
where
prefSuff' :: ByteString
prefSuff' = ByteString -> ByteString
dropRepeatingSpaces ByteString
prefSuff
pref' :: ByteString
pref' = ByteString -> ByteString
dropRepeatingSpaces ByteString
pref
Just Position
pos ->
( if (Char -> Bool) -> ByteString -> Bool
B.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') ByteString
suff then ByteString
pref1 else ByteString
prefSuff1
, ByteString
prefSuff1
, ByteString
suff
)
where
prefSuff1 :: ByteString
prefSuff1 = ByteString
pref1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
suff1
((Char -> Bool) -> ByteString -> ByteString
B.takeWhileEnd Char -> Bool
fillerPred -> ByteString
pref1, (Char -> Bool) -> ByteString -> ByteString
B.takeWhile Char -> Bool
fillerPred -> ByteString
suff1) =
Position -> ByteString -> (ByteString, ByteString)
splitAtPosition Position
pos ByteString
cnfOrigContents
let (ByteString
beforeFirstDep, ByteString
afterFirstDep) = Position -> ByteString -> (ByteString, ByteString)
splitAtPosition Position
firstDepPos ByteString
cnfOrigContents
newBuildDeps :: ByteString
newBuildDeps = ByteString
beforeFirst ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
inBetween (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ByteString
cnfDependencies) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
afterLast
let ret :: ByteString
ret = ByteString
beforeFirstDep ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
newBuildDeps ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
afterFirstDep
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
ret
niceAlgorithm :: Config -> Maybe ByteString
niceAlgorithm :: Config -> Maybe ByteString
niceAlgorithm Config {[Field Position]
cnfFields :: Config -> [Field Position]
cnfFields :: [Field Position]
cnfFields, Either CommonStanza ComponentName
cnfComponent :: Config -> Either CommonStanza ComponentName
cnfComponent :: Either CommonStanza ComponentName
cnfComponent, ByteString
cnfOrigContents :: Config -> ByteString
cnfOrigContents :: ByteString
cnfOrigContents, NonEmpty ByteString
cnfDependencies :: Config -> NonEmpty ByteString
cnfDependencies :: NonEmpty ByteString
cnfDependencies} = do
Field Position
component <- (Field Position -> Bool)
-> [Field Position] -> Maybe (Field Position)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Either CommonStanza ComponentName -> Field Position -> Bool
forall a. Either CommonStanza ComponentName -> Field a -> Bool
isComponent Either CommonStanza ComponentName
cnfComponent) [Field Position]
cnfFields
Section Name Position
_ [SectionArg Position]
_ [Field Position]
subFields <- Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field Position
component
Field Position
buildDependsField <- (Field Position -> Bool)
-> [Field Position] -> Maybe (Field Position)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Field Position -> Bool
forall ann. Field ann -> Bool
isBuildDependsField [Field Position]
subFields
Field Name Position
_ (FieldLine Position
pos ByteString
_dep : [FieldLine Position]
_) <- Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field Position
buildDependsField
let (ByteString
before, ByteString
after) = Position -> ByteString -> (ByteString, ByteString)
splitAtPosition Position
pos ByteString
cnfOrigContents
(ByteString
_, ByteString
buildDepsHeader) = Position -> ByteString -> (ByteString, ByteString)
splitAtPosition (Field Position -> Position
forall ann. Field ann -> ann
getFieldNameAnn Field Position
buildDependsField) ByteString
before
filler :: ByteString
filler = ByteString -> ByteString
dropRepeatingSpaces (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') ByteString
buildDepsHeader
leadingCommaStyle :: Maybe ByteString
leadingCommaStyle = ByteString -> Maybe ByteString
detectLeadingComma ByteString
after
filler' :: ByteString
filler' = ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
filler) (ByteString
filler <>) Maybe ByteString
leadingCommaStyle
newBuildDeps :: ByteString
newBuildDeps =
ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
leadingCommaStyle
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
filler' (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ByteString
cnfDependencies)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (if Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust Maybe ByteString
leadingCommaStyle then ByteString
filler else ByteString
filler')
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
ByteString
before ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
newBuildDeps ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
after
roughAlgorithm :: Config -> Maybe ByteString
roughAlgorithm :: Config -> Maybe ByteString
roughAlgorithm Config {[Field Position]
cnfFields :: Config -> [Field Position]
cnfFields :: [Field Position]
cnfFields, Either CommonStanza ComponentName
cnfComponent :: Config -> Either CommonStanza ComponentName
cnfComponent :: Either CommonStanza ComponentName
cnfComponent, ByteString
cnfOrigContents :: Config -> ByteString
cnfOrigContents :: ByteString
cnfOrigContents, NonEmpty ByteString
cnfDependencies :: Config -> NonEmpty ByteString
cnfDependencies :: NonEmpty ByteString
cnfDependencies} = do
let componentAndRest :: [Field Position]
componentAndRest = (Field Position -> Bool) -> [Field Position] -> [Field Position]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile (Bool -> Bool
not (Bool -> Bool)
-> (Field Position -> Bool) -> Field Position -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CommonStanza ComponentName -> Field Position -> Bool
forall a. Either CommonStanza ComponentName -> Field a -> Bool
isComponent Either CommonStanza ComponentName
cnfComponent) [Field Position]
cnfFields
pos :: Position
pos@(Position Int
_ Int
row) <- [Field Position] -> Maybe Position
findNonImportField [Field Position]
componentAndRest
let (ByteString
before, ByteString
after) = Position -> ByteString -> (ByteString, ByteString)
splitAtPositionLine Position
pos ByteString
cnfOrigContents
lineEnding' :: ByteString
lineEnding' = (Char -> Bool) -> ByteString -> ByteString
B.takeWhileEnd Char -> Bool
isSpaceChar8 ByteString
before
lineEnding :: ByteString
lineEnding = if ByteString -> Bool
B.null ByteString
lineEnding' then ByteString
"\n" else ByteString
lineEnding'
needsNewlineBefore :: Bool
needsNewlineBefore = Bool
-> ((ByteString, Char) -> Bool) -> Maybe (ByteString, Char) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (Char -> Bool)
-> ((ByteString, Char) -> Char) -> (ByteString, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Char) -> Char
forall a b. (a, b) -> b
snd) (ByteString -> Maybe (ByteString, Char)
B.unsnoc ByteString
before)
buildDeps :: ByteString
buildDeps =
(if Bool
needsNewlineBefore then ByteString
lineEnding else ByteString
"")
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
B.replicate (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
' '
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"build-depends: "
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
", " (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ByteString
cnfDependencies)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lineEnding
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
ByteString
before ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
buildDeps ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
after
executeConfig
:: (Either CommonStanza ComponentName -> ByteString -> Bool)
-> Config
-> Maybe ByteString
executeConfig :: (Either CommonStanza ComponentName -> ByteString -> Bool)
-> Config -> Maybe ByteString
executeConfig Either CommonStanza ComponentName -> ByteString -> Bool
validator cnf :: Config
cnf@Config {Either CommonStanza ComponentName
cnfComponent :: Config -> Either CommonStanza ComponentName
cnfComponent :: Either CommonStanza ComponentName
cnfComponent} =
(ByteString -> Bool) -> [ByteString] -> Maybe ByteString
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Either CommonStanza ComponentName -> ByteString -> Bool
validator Either CommonStanza ComponentName
cnfComponent) ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$
((Config -> Maybe ByteString) -> Maybe ByteString)
-> [Config -> Maybe ByteString] -> [ByteString]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Config -> Maybe ByteString) -> Config -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Config
cnf) [Config -> Maybe ByteString
fancyAlgorithm, Config -> Maybe ByteString
niceAlgorithm, Config -> Maybe ByteString
roughAlgorithm]
validateChanges
:: GenericPackageDescription
-> Either CommonStanza ComponentName
-> ByteString
-> Bool
validateChanges :: GenericPackageDescription
-> Either CommonStanza ComponentName -> ByteString -> Bool
validateChanges GenericPackageDescription
origPackDesc (Left CommonStanza
_commonStanza) ByteString
newContents =
case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
newContents of
Maybe GenericPackageDescription
Nothing -> Bool
False
Just GenericPackageDescription
newPackDesc ->
GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
origPackDesc PackageDescription -> PackageDescription -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
newPackDesc
Bool -> Bool -> Bool
&& GenericPackageDescription -> Maybe Version
gpdScannedVersion GenericPackageDescription
origPackDesc Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> Maybe Version
gpdScannedVersion GenericPackageDescription
newPackDesc
Bool -> Bool -> Bool
&& GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
origPackDesc [PackageFlag] -> [PackageFlag] -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
newPackDesc
validateChanges GenericPackageDescription
origPackDesc (Right ComponentName
component) ByteString
newContents =
case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
newContents of
Maybe GenericPackageDescription
Nothing -> Bool
False
Just GenericPackageDescription
newPackDesc ->
GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
origPackDesc PackageDescription -> PackageDescription -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
newPackDesc
Bool -> Bool -> Bool
&& GenericPackageDescription -> Maybe Version
gpdScannedVersion GenericPackageDescription
origPackDesc Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> Maybe Version
gpdScannedVersion GenericPackageDescription
newPackDesc
Bool -> Bool -> Bool
&& GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
origPackDesc [PackageFlag] -> [PackageFlag] -> Bool
forall a. Eq a => a -> a -> Bool
== GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
newPackDesc
Bool -> Bool -> Bool
&& Bool
mainLibMatch
Bool -> Bool -> Bool
&& Bool
subLibsMatch
Bool -> Bool -> Bool
&& Bool
foreignLibsMatch
Bool -> Bool -> Bool
&& Bool
executablesMatch
Bool -> Bool -> Bool
&& Bool
testsMatch
Bool -> Bool -> Bool
&& Bool
benchmarksMatch
where
mainLibMatch :: Bool
mainLibMatch = case (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
origPackDesc, GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
newPackDesc) of
(Maybe (CondTree ConfVar [Dependency] Library)
Nothing, Maybe (CondTree ConfVar [Dependency] Library)
Nothing) -> Bool
True
(Just CondTree ConfVar [Dependency] Library
x, Just CondTree ConfVar [Dependency] Library
y) -> ComponentName
component ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName Bool -> Bool -> Bool
|| CondTree ConfVar [Dependency] Library
x CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library -> Bool
forall a. Eq a => a -> a -> Bool
== CondTree ConfVar [Dependency] Library
y
(Maybe (CondTree ConfVar [Dependency] Library),
Maybe (CondTree ConfVar [Dependency] Library))
_ -> Bool
False
subLibsMatch :: Bool
subLibsMatch = [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
ys Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Bool)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Bool
forall {b}.
Eq b =>
(UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
xs [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
ys)
where
xs :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
xs = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
origPackDesc
ys :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
ys = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
newPackDesc
predicate :: (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate (UnqualComponentName, b)
x (UnqualComponentName, b)
y = (UnqualComponentName, b)
x (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b)
y Bool -> Bool -> Bool
|| ComponentName -> Bool
isCLibName ComponentName
component Bool -> Bool -> Bool
&& (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
y Bool -> Bool -> Bool
&& ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
component Maybe UnqualComponentName -> Maybe UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just ((UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x)
foreignLibsMatch :: Bool
foreignLibsMatch = [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
ys Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Bool)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Bool
forall {b}.
Eq b =>
(UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
xs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
ys)
where
xs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
xs = GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
origPackDesc
ys :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
ys = GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs GenericPackageDescription
newPackDesc
predicate :: (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate (UnqualComponentName, b)
x (UnqualComponentName, b)
y = (UnqualComponentName, b)
x (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b)
y Bool -> Bool -> Bool
|| ComponentName -> Bool
isCFLibName ComponentName
component Bool -> Bool -> Bool
&& (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
y Bool -> Bool -> Bool
&& ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
component Maybe UnqualComponentName -> Maybe UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just ((UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x)
executablesMatch :: Bool
executablesMatch = [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
ys Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Bool)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Bool
forall {b}.
Eq b =>
(UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
xs [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
ys)
where
xs :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
xs = GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
origPackDesc
ys :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
ys = GenericPackageDescription
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
newPackDesc
predicate :: (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate (UnqualComponentName, b)
x (UnqualComponentName, b)
y = (UnqualComponentName, b)
x (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b)
y Bool -> Bool -> Bool
|| ComponentName -> Bool
isCExeName ComponentName
component Bool -> Bool -> Bool
&& (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
y Bool -> Bool -> Bool
&& ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
component Maybe UnqualComponentName -> Maybe UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just ((UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x)
testsMatch :: Bool
testsMatch = [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
ys Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Bool)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Bool
forall {b}.
Eq b =>
(UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
xs [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
ys)
where
xs :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
xs = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
origPackDesc
ys :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
ys = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
newPackDesc
predicate :: (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate (UnqualComponentName, b)
x (UnqualComponentName, b)
y = (UnqualComponentName, b)
x (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b)
y Bool -> Bool -> Bool
|| ComponentName -> Bool
isCTestName ComponentName
component Bool -> Bool -> Bool
&& (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
y Bool -> Bool -> Bool
&& ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
component Maybe UnqualComponentName -> Maybe UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just ((UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x)
benchmarksMatch :: Bool
benchmarksMatch = [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
ys Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Bool)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Bool
forall {b}.
Eq b =>
(UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
xs [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
ys)
where
xs :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
xs = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
origPackDesc
ys :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
ys = GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
newPackDesc
predicate :: (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
predicate (UnqualComponentName, b)
x (UnqualComponentName, b)
y = (UnqualComponentName, b)
x (UnqualComponentName, b) -> (UnqualComponentName, b) -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b)
y Bool -> Bool -> Bool
|| ComponentName -> Bool
isCBenchName ComponentName
component Bool -> Bool -> Bool
&& (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x UnqualComponentName -> UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== (UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
y Bool -> Bool -> Bool
&& ComponentName -> Maybe UnqualComponentName
componentNameString ComponentName
component Maybe UnqualComponentName -> Maybe UnqualComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just ((UnqualComponentName, b) -> UnqualComponentName
forall a b. (a, b) -> a
fst (UnqualComponentName, b)
x)