{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Copyright:   (c) 2023 Bodigrim
-- License:     BSD-3-Clause
--
-- Building blocks of @cabal-add@ executable,
-- probably not terribly useful on their own.
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)

-- | Just a newtype wrapper, since @Cabal-syntax@ does not provide any.
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)

-- | An input for 'executeConfig'.
data Config = Config
  { Config -> ByteString
cnfOrigContents :: !ByteString
  -- ^ Original Cabal file (with quirks patched,
  -- see "Distribution.PackageDescription.Quirks"),
  -- must be in sync with 'cnfFields'.
  , Config -> [Field Position]
cnfFields :: ![Field Position]
  -- ^ Parsed (by 'readFields') representation of the Cabal file,
  -- must be in sync with 'cnfOrigContents'.
  , Config -> Either CommonStanza ComponentName
cnfComponent :: !(Either CommonStanza ComponentName)
  -- ^ Which component to update?
  , Config -> NonEmpty ByteString
cnfDependencies :: !(NonEmpty ByteString)
  -- ^ Which dependencies to add?
  }
  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
extractComponentNames :: GenericPackageDescription -> Set ComponentName
extractComponentNames 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
extractCommonStanzas :: forall ann. [Field ann] -> Set CommonStanza
extractCommonStanzas = (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
    -- Cf. Distribution.Simple.BuildTarget.matchComponentKind
    | 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

-- | Parse Cabal file into two representations.
parseCabalFile
  :: MonadError String m
  => FilePath
  -- ^ File name, just for error reporting.
  -> ByteString
  -- ^ Contents of the Cabal file.
  -> m ([Field Position], GenericPackageDescription)
  -- ^ Parsed data.
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)

-- | Resolve a raw component name.
resolveComponent
  :: MonadError String m
  => FilePath
  -- ^ File name, just for error reporting.
  -> ([Field Position], GenericPackageDescription)
  -- ^ Parsed Cabal file, as returned by 'parseCabalFile'.
  -> Maybe String
  -- ^ Component name (default component if 'Nothing').
  -> m (Either CommonStanza ComponentName)
  -- ^ Resolved component.
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)

-- | Validate dependency syntax.
validateDependency
  :: MonadError String m
  => String
  -- ^ Raw dependency to add.
  -> m ByteString
  -- ^ Dependency as '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

-- Both lines and rows are 1-based.
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

-- | Find build-depends section and insert new
-- dependencies at the beginning, trying our best
-- to preserve formatting. This often breaks however
-- if there are comments in between build-depends.
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

  -- This is not really the second dependency:
  -- it's a dependency on the next line.
  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

-- | Find build-depends section and insert new
-- dependencies at the beginning. Very limited effort
-- is put into preserving formatting.
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

-- | Introduce a new build-depends section
-- after the last common stanza import.
-- This is not fancy, but very robust.
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

-- | Main work horse of the module, adding dependencies to a specified component
-- in the Cabal file.
executeConfig
  :: (Either CommonStanza ComponentName -> ByteString -> Bool)
  -- ^ How to validate results? See 'validateChanges'.
  -> Config
  -- ^ Input arguments.
  -> Maybe ByteString
  -- ^ Updated contents, if validated successfully.
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]

-- | Validate that updates did not cause unexpected effects on other sections
-- of the Cabal file.
validateChanges
  :: GenericPackageDescription
  -- ^ Original package description.
  -> Either CommonStanza ComponentName
  -- ^ Which component was supposed to be updated?
  -> ByteString
  -- ^ Update Cabal file.
  -> Bool
  -- ^ Was the update successful?
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)