{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}

-- |
-- Module      :  Distribution.Server.Util.CabalRevisions
-- Copyright   :  Duncan Coutts et al.
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Maintainer  :  Andreas Abel
-- Stability   :  provisional
-- Portability :  portable
--
-- Validation and helpers for Cabal revision handling
module Distribution.Server.Util.CabalRevisions
    ( diffCabalRevisions
    , diffCabalRevisions'
    , Change(..)
    , insertRevisionField
    ) where

-- NB: This module avoids to import any hackage-server modules
import Distribution.CabalSpecVersion (CabalSpecVersion(..), cabalSpecLatest, showCabalSpecVersion)
import Distribution.Types.Dependency
import Distribution.Types.ExeDependency
import Distribution.Types.PkgconfigDependency
import Distribution.Types.PkgconfigVersionRange
import Distribution.Types.LegacyExeDependency
import Distribution.Types.UnqualComponentName
import Distribution.Types.CondTree
import Distribution.Types.ForeignLib
import Distribution.Package
import Distribution.Pretty (Pretty (..), prettyShow)
import Distribution.Version
import Distribution.Compiler (CompilerFlavor)
import Distribution.FieldGrammar (prettyFieldGrammar)
import Distribution.Fields.Pretty (PrettyField (..), showFields)
#if MIN_VERSION_Cabal(3,7,0)
import Distribution.Fields.Pretty (pattern NoComment)
#endif
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)
import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar)
import Distribution.PackageDescription.Check
import Distribution.Parsec (showPWarning, showPError, PWarning (..))
import Distribution.Utils.ShortText
import Text.PrettyPrint as Doc
         ((<+>), colon, text, Doc, hsep, punctuate)

import Control.Applicative
import Control.Monad
import Control.Monad.Except  (ExceptT, runExceptT, throwError)
import Control.Monad.Writer (MonadWriter(..), Writer, runWriter)
import Data.Foldable (for_)
import Data.List
         ((\\), deleteBy, intercalate)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Char as Char
import qualified Data.Semigroup as S
import qualified Data.Monoid as M
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy(Proxy))

import qualified Control.Monad.Fail as Fail

-- | Entry point to cabal revision validator
--
-- This takes an original and a revised @.cabal@ decoded as Unicode
-- 'String' and performs validations. Returns either a validation
-- error or a list of detected changes.
diffCabalRevisions :: BS.ByteString -> BS.ByteString -> Either String [Change]
diffCabalRevisions :: FieldName -> FieldName -> Either [Char] [Change]
diffCabalRevisions = Bool -> FieldName -> FieldName -> Either [Char] [Change]
diffCabalRevisions' Bool
True

-- | Like 'diffCabalRevisions' but only optionally check @x-revision@ field modifications.
diffCabalRevisions'
    :: Bool                    -- ^ check @x-revision@
    -> BS.ByteString           -- ^ old revision
    -> BS.ByteString           -- ^ new revision
    -> Either String [Change]
diffCabalRevisions' :: Bool -> FieldName -> FieldName -> Either [Char] [Change]
diffCabalRevisions' Bool
checkXRevision FieldName
oldVersion FieldName
newRevision = CheckM () -> Either [Char] [Change]
runCheck (CheckM () -> Either [Char] [Change])
-> CheckM () -> Either [Char] [Change]
forall a b. (a -> b) -> a -> b
$
    Bool -> Check FieldName
checkCabalFileRevision Bool
checkXRevision FieldName
oldVersion FieldName
newRevision

newtype CheckM a = CheckM { forall a. CheckM a -> ExceptT [Char] (Writer [Change]) a
unCheckM :: ExceptT String (Writer [Change]) a }
    deriving ((forall a b. (a -> b) -> CheckM a -> CheckM b)
-> (forall a b. a -> CheckM b -> CheckM a) -> Functor CheckM
forall a b. a -> CheckM b -> CheckM a
forall a b. (a -> b) -> CheckM a -> CheckM 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) -> CheckM a -> CheckM b
fmap :: forall a b. (a -> b) -> CheckM a -> CheckM b
$c<$ :: forall a b. a -> CheckM b -> CheckM a
<$ :: forall a b. a -> CheckM b -> CheckM a
Functor, Functor CheckM
Functor CheckM =>
(forall a. a -> CheckM a)
-> (forall a b. CheckM (a -> b) -> CheckM a -> CheckM b)
-> (forall a b c.
    (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c)
-> (forall a b. CheckM a -> CheckM b -> CheckM b)
-> (forall a b. CheckM a -> CheckM b -> CheckM a)
-> Applicative CheckM
forall a. a -> CheckM a
forall a b. CheckM a -> CheckM b -> CheckM a
forall a b. CheckM a -> CheckM b -> CheckM b
forall a b. CheckM (a -> b) -> CheckM a -> CheckM b
forall a b c. (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> CheckM a
pure :: forall a. a -> CheckM a
$c<*> :: forall a b. CheckM (a -> b) -> CheckM a -> CheckM b
<*> :: forall a b. CheckM (a -> b) -> CheckM a -> CheckM b
$cliftA2 :: forall a b c. (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c
liftA2 :: forall a b c. (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c
$c*> :: forall a b. CheckM a -> CheckM b -> CheckM b
*> :: forall a b. CheckM a -> CheckM b -> CheckM b
$c<* :: forall a b. CheckM a -> CheckM b -> CheckM a
<* :: forall a b. CheckM a -> CheckM b -> CheckM a
Applicative)

runCheck :: CheckM () -> Either String [Change]
runCheck :: CheckM () -> Either [Char] [Change]
runCheck CheckM ()
c = case Writer [Change] (Either [Char] ()) -> (Either [Char] (), [Change])
forall w a. Writer w a -> (a, w)
runWriter (Writer [Change] (Either [Char] ())
 -> (Either [Char] (), [Change]))
-> (CheckM () -> Writer [Change] (Either [Char] ()))
-> CheckM ()
-> (Either [Char] (), [Change])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT [Char] (Writer [Change]) ()
-> Writer [Change] (Either [Char] ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] (Writer [Change]) ()
 -> Writer [Change] (Either [Char] ()))
-> (CheckM () -> ExceptT [Char] (Writer [Change]) ())
-> CheckM ()
-> Writer [Change] (Either [Char] ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckM () -> ExceptT [Char] (Writer [Change]) ()
forall a. CheckM a -> ExceptT [Char] (Writer [Change]) a
unCheckM (CheckM () -> (Either [Char] (), [Change]))
-> CheckM () -> (Either [Char] (), [Change])
forall a b. (a -> b) -> a -> b
$ CheckM ()
c of
               (Left [Char]
err, [Change]
_      ) -> [Char] -> Either [Char] [Change]
forall a b. a -> Either a b
Left [Char]
err
               (Right (), [Change]
changes)
                 | (Change -> Severity) -> [Change] -> Severity
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Change -> Severity
changeSeverity [Change]
changes Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
/= Severity
Trivial -> [Change] -> Either [Char] [Change]
forall a b. b -> Either a b
Right [Change]
changes
                 | Bool
otherwise ->
                   [Char] -> Either [Char] [Change]
forall a b. a -> Either a b
Left [Char]
"Only trivial changes, don't bother making this revision."

changeSeverity :: Change -> Severity
changeSeverity :: Change -> Severity
changeSeverity (Change Severity
s [Char]
_ [Char]
_ [Char]
_) = Severity
s

instance Monad CheckM where
  return :: forall a. a -> CheckM a
return         = a -> CheckM a
forall a. a -> CheckM a
forall (f :: * -> *) a. Applicative f => a -> f a
Control.Applicative.pure
  CheckM ExceptT [Char] (Writer [Change]) a
m >>= :: forall a b. CheckM a -> (a -> CheckM b) -> CheckM b
>>= a -> CheckM b
f = ExceptT [Char] (Writer [Change]) b -> CheckM b
forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM (ExceptT [Char] (Writer [Change]) a
m ExceptT [Char] (Writer [Change]) a
-> (a -> ExceptT [Char] (Writer [Change]) b)
-> ExceptT [Char] (Writer [Change]) b
forall a b.
ExceptT [Char] (Writer [Change]) a
-> (a -> ExceptT [Char] (Writer [Change]) b)
-> ExceptT [Char] (Writer [Change]) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CheckM b -> ExceptT [Char] (Writer [Change]) b
forall a. CheckM a -> ExceptT [Char] (Writer [Change]) a
unCheckM (CheckM b -> ExceptT [Char] (Writer [Change]) b)
-> (a -> CheckM b) -> a -> ExceptT [Char] (Writer [Change]) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CheckM b
f)

#if !MIN_VERSION_base(4,13,0)
  fail = Fail.fail
#endif

instance Fail.MonadFail CheckM where
  fail :: forall a. [Char] -> CheckM a
fail           = ExceptT [Char] (Writer [Change]) a -> CheckM a
forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM (ExceptT [Char] (Writer [Change]) a -> CheckM a)
-> ([Char] -> ExceptT [Char] (Writer [Change]) a)
-> [Char]
-> CheckM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExceptT [Char] (Writer [Change]) a
forall a. [Char] -> ExceptT [Char] (Writer [Change]) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

-- | If we have only 'Trivial' changes, then there is no point to make
-- a revision. In other words for changes to be accepted, there should
-- be at least one 'Normal' change.
data Severity
    = Normal
    | Trivial
  deriving (Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
/= :: Severity -> Severity -> Bool
Eq, Eq Severity
Eq Severity =>
(Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
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 :: Severity -> Severity -> Ordering
compare :: Severity -> Severity -> Ordering
$c< :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
>= :: Severity -> Severity -> Bool
$cmax :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
min :: Severity -> Severity -> Severity
Ord, Int -> Severity -> [Char] -> [Char]
[Severity] -> [Char] -> [Char]
Severity -> [Char]
(Int -> Severity -> [Char] -> [Char])
-> (Severity -> [Char])
-> ([Severity] -> [Char] -> [Char])
-> Show Severity
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Severity -> [Char] -> [Char]
showsPrec :: Int -> Severity -> [Char] -> [Char]
$cshow :: Severity -> [Char]
show :: Severity -> [Char]
$cshowList :: [Severity] -> [Char] -> [Char]
showList :: [Severity] -> [Char] -> [Char]
Show, Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Severity -> Severity
succ :: Severity -> Severity
$cpred :: Severity -> Severity
pred :: Severity -> Severity
$ctoEnum :: Int -> Severity
toEnum :: Int -> Severity
$cfromEnum :: Severity -> Int
fromEnum :: Severity -> Int
$cenumFrom :: Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
Enum, Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
$cminBound :: Severity
minBound :: Severity
$cmaxBound :: Severity
maxBound :: Severity
Bounded)

instance S.Semigroup Severity where
    Severity
Normal  <> :: Severity -> Severity -> Severity
<> Severity
_ = Severity
Normal
    Severity
Trivial <> Severity
x = Severity
x

-- | "Max" monoid.
instance M.Monoid Severity where
    mempty :: Severity
mempty = Severity
Trivial
    mappend :: Severity -> Severity -> Severity
mappend = Severity -> Severity -> Severity
forall a. Semigroup a => a -> a -> a
(S.<>)

data Change = Change Severity String String String -- severity, what, from, to
  deriving Int -> Change -> [Char] -> [Char]
[Change] -> [Char] -> [Char]
Change -> [Char]
(Int -> Change -> [Char] -> [Char])
-> (Change -> [Char])
-> ([Change] -> [Char] -> [Char])
-> Show Change
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Change -> [Char] -> [Char]
showsPrec :: Int -> Change -> [Char] -> [Char]
$cshow :: Change -> [Char]
show :: Change -> [Char]
$cshowList :: [Change] -> [Char] -> [Char]
showList :: [Change] -> [Char] -> [Char]
Show



logChange :: Change -> CheckM ()
logChange :: Change -> CheckM ()
logChange Change
change = ExceptT [Char] (Writer [Change]) () -> CheckM ()
forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM ([Change] -> ExceptT [Char] (Writer [Change]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Change
change])

type Check a = a -> a -> CheckM ()

checkCabalFileRevision :: Bool -> Check BS.ByteString
checkCabalFileRevision :: Bool -> Check FieldName
checkCabalFileRevision Bool
checkXRevision FieldName
old FieldName
new = do
    (pkg,  warns)  <- FieldName -> CheckM (GenericPackageDescription, [PWarning])
forall {m :: * -> *}.
MonadFail m =>
FieldName -> m (GenericPackageDescription, [PWarning])
parseCabalFile FieldName
old
    (pkg', warns') <- parseCabalFile new

    let pkgid    = GenericPackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
pkg
        filename = PackageIdentifier -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageIdentifier
pkgid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"

    checkGenericPackageDescription checkXRevision pkg pkg'
    checkParserWarnings filename warns warns'
    checkPackageChecks  pkg   pkg'

  where
    parseCabalFile :: FieldName -> m (GenericPackageDescription, [PWarning])
parseCabalFile FieldName
fileContent =
      case 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
$ FieldName -> ParseResult GenericPackageDescription
parseGenericPackageDescription FieldName
fileContent of
        ([PWarning]
warnings,  Right GenericPackageDescription
pkg) -> (GenericPackageDescription, [PWarning])
-> m (GenericPackageDescription, [PWarning])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription
pkg, [PWarning]
warnings)
        ([PWarning]
_warnings, Left (Maybe Version
_mver, NonEmpty PError
errs)) -> do
            NonEmpty PError -> (PError -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty PError
errs ((PError -> m Any) -> m ()) -> (PError -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ \PError
err -> [Char] -> m Any
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> PError -> [Char]
showPError [Char]
"-" PError
err)
            [Char] -> m (GenericPackageDescription, [PWarning])
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"no better error"

    -- new PWarning isn't Eq
    differenceBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
    differenceBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
differenceBy a -> a -> Bool
eq = ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> [a] -> [a]) -> [a] -> a -> [a])
-> (a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy a -> a -> Bool
eq)

    -- things can move, pos can change
    eqPWarning :: PWarning -> PWarning -> Bool
    eqPWarning :: PWarning -> PWarning -> Bool
eqPWarning (PWarning PWarnType
t Position
_pos [Char]
s) (PWarning PWarnType
t' Position
_pos' [Char]
s') =
        PWarnType
t PWarnType -> PWarnType -> Bool
forall a. Eq a => a -> a -> Bool
== PWarnType
t' Bool -> Bool -> Bool
&& [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s'

    checkParserWarnings :: FilePath -> Check [PWarning]
    checkParserWarnings :: [Char] -> Check [PWarning]
checkParserWarnings [Char]
filename [PWarning]
warns [PWarning]
warns' =
      case (PWarning -> PWarning -> Bool)
-> [PWarning] -> [PWarning] -> [PWarning]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
differenceBy PWarning -> PWarning -> Bool
eqPWarning [PWarning]
warns' [PWarning]
warns of
        []       -> () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [PWarning]
newwarns -> [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> CheckM ()) -> [Char] -> CheckM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"New parse warning: "
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines ((PWarning -> [Char]) -> [PWarning] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> PWarning -> [Char]
showPWarning [Char]
filename) [PWarning]
newwarns)

    checkPackageChecks :: Check GenericPackageDescription
    checkPackageChecks :: Check GenericPackageDescription
checkPackageChecks GenericPackageDescription
pkg GenericPackageDescription
pkg' =
      let checks :: [PackageCheck]
checks  = GenericPackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
pkg
-- The API change of checkPackage happened somewhere between 3.10 and 3.12.
#if !MIN_VERSION_Cabal(3,12,0)
                      Nothing
#endif
          checks' :: [PackageCheck]
checks' = GenericPackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
pkg'
#if !MIN_VERSION_Cabal(3,12,0)
                      Nothing
#endif
       in case [PackageCheck]
checks' [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PackageCheck]
checks of
            []        -> () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            [PackageCheck]
newchecks -> [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> CheckM ()) -> [Char] -> CheckM ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ((PackageCheck -> [Char]) -> [PackageCheck] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> [Char]
ppPackageCheck [PackageCheck]
newchecks)
#if !MIN_VERSION_Cabal(3,9,0)
      where ppPackageCheck = explanation
#endif

checkGenericPackageDescription :: Bool -> Check GenericPackageDescription
checkGenericPackageDescription :: Bool -> Check GenericPackageDescription
checkGenericPackageDescription Bool
checkXRevision
    (GenericPackageDescription PackageDescription
descrA Maybe Version
_versionA [PackageFlag]
flagsA Maybe (CondTree ConfVar [Dependency] Library)
libsA [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sublibsA [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibsA [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exesA [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
testsA [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benchsA)
    (GenericPackageDescription PackageDescription
descrB Maybe Version
_versionB [PackageFlag]
flagsB Maybe (CondTree ConfVar [Dependency] Library)
libsB [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sublibsB [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibsB [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exesB [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
testsB [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benchsB) = do

    Bool -> Check PackageDescription
checkPackageDescriptions Bool
checkXRevision PackageDescription
descrA PackageDescription
descrB

    [Char] -> Check PackageFlag -> Check [PackageFlag]
forall a. [Char] -> Check a -> Check [a]
checkList [Char]
"Cannot add or remove flags" Check PackageFlag
checkFlag [PackageFlag]
flagsA [PackageFlag]
flagsB

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] Library)
-> Check
     (Maybe (ComponentName, CondTree ConfVar [Dependency] Library))
forall a. [Char] -> Check a -> Check (Maybe a)
checkMaybe [Char]
"Cannot add or remove library sections"
      ((ComponentName -> Check Library)
-> Check (ComponentName, CondTree ConfVar [Dependency] Library)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check Library
checkLibrary)
      (ComponentName
-> CondTree ConfVar [Dependency] Library
-> (ComponentName, CondTree ConfVar [Dependency] Library)
forall {a} {b}. a -> b -> (a, b)
withComponentName' (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) (CondTree ConfVar [Dependency] Library
 -> (ComponentName, CondTree ConfVar [Dependency] Library))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Maybe (ComponentName, CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree ConfVar [Dependency] Library)
libsA)
      (ComponentName
-> CondTree ConfVar [Dependency] Library
-> (ComponentName, CondTree ConfVar [Dependency] Library)
forall {a} {b}. a -> b -> (a, b)
withComponentName' (LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) (CondTree ConfVar [Dependency] Library
 -> (ComponentName, CondTree ConfVar [Dependency] Library))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Maybe (ComponentName, CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree ConfVar [Dependency] Library)
libsB)

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] Library)
-> Check
     [(UnqualComponentName,
       (ComponentName, CondTree ConfVar [Dependency] Library))]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove sub-library sections"
      ((ComponentName -> Check Library)
-> Check (ComponentName, CondTree ConfVar [Dependency] Library)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check Library
checkLibrary)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Library))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName (LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName)
-> (UnqualComponentName -> LibraryName)
-> UnqualComponentName
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> LibraryName
LSubLibName) ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Library)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Library))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sublibsA)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Library))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName (LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName)
-> (UnqualComponentName -> LibraryName)
-> UnqualComponentName
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> LibraryName
LSubLibName) ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Library)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Library))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
sublibsB)

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Check
     [(UnqualComponentName,
       (ComponentName, CondTree ConfVar [Dependency] ForeignLib))]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove foreign-library sections"
      ((ComponentName -> Check ForeignLib)
-> Check (ComponentName, CondTree ConfVar [Dependency] ForeignLib)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check ForeignLib
checkForeignLib)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] ForeignLib))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CFLibName ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] ForeignLib)))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] ForeignLib))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibsA)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] ForeignLib))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CFLibName ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] ForeignLib)))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] ForeignLib))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
flibsB)

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] Executable)
-> Check
     [(UnqualComponentName,
       (ComponentName, CondTree ConfVar [Dependency] Executable))]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove executable sections"
      ((ComponentName -> Check Executable)
-> Check (ComponentName, CondTree ConfVar [Dependency] Executable)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check Executable
checkExecutable)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Executable))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CExeName ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Executable)))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Executable))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exesA)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Executable))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CExeName ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Executable)))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Executable))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exesB)

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Check
     [(UnqualComponentName,
       (ComponentName, CondTree ConfVar [Dependency] TestSuite))]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove test-suite sections"
      ((ComponentName -> Check TestSuite)
-> Check (ComponentName, CondTree ConfVar [Dependency] TestSuite)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check TestSuite
checkTestSuite)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] TestSuite))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CTestName ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] TestSuite)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] TestSuite))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
testsA)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] TestSuite))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CTestName ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] TestSuite)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] TestSuite))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
testsB)

    [Char]
-> Check (ComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Check
     [(UnqualComponentName,
       (ComponentName, CondTree ConfVar [Dependency] Benchmark))]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove benchmark sections"
      ((ComponentName -> Check Benchmark)
-> Check (ComponentName, CondTree ConfVar [Dependency] Benchmark)
forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check Benchmark
checkBenchmark)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Benchmark))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CBenchName ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Benchmark)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Benchmark))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benchsA)
      ((UnqualComponentName -> ComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName,
    (ComponentName, CondTree ConfVar [Dependency] Benchmark))
forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CBenchName ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> (UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Benchmark)))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName,
     (ComponentName, CondTree ConfVar [Dependency] Benchmark))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benchsB)
  where
    withComponentName :: (t -> a) -> (t, b) -> (t, (a, b))
withComponentName  t -> a
f (t
name, b
condTree) = (t
name, (t -> a
f t
name, b
condTree))
    withComponentName' :: a -> b -> (a, b)
withComponentName' a
f        b
condTree  = (a
f,             b
condTree)


checkFlag :: Check PackageFlag
checkFlag :: Check PackageFlag
checkFlag PackageFlag
flagOld PackageFlag
flagNew = do
    -- This check is applied via 'checkList' and for simplicity we
    -- disallow renaming/reordering flags (even though reordering
    -- would be fine semantically)
    [Char] -> Check FlagName
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change ordering of flags"
              (PackageFlag -> FlagName
flagName PackageFlag
flagOld) (PackageFlag -> FlagName
flagName PackageFlag
flagNew)

    -- Automatic flags' defaults may be changed as they don't make new
    -- configurations reachable by the solver that weren't before
    --
    -- Moreover, automatic flags may be converted into manual flags
    -- but not the other way round.
    --
    -- NB: We always allow to change the flag description as it has
    --     purely informational value
    Bool -> CheckM () -> CheckM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageFlag -> Bool
flagManual PackageFlag
flagOld) (CheckM () -> CheckM ()) -> CheckM () -> CheckM ()
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Check Bool
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the default of a manual flag"
                  (PackageFlag -> Bool
flagDefault PackageFlag
flagOld) (PackageFlag -> Bool
flagDefault PackageFlag
flagNew)

        [Char] -> Check Bool
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change a manual flag into an automatic flag"
                  (PackageFlag -> Bool
flagManual PackageFlag
flagOld) (PackageFlag -> Bool
flagManual PackageFlag
flagNew)

    let fname :: [Char]
fname = FlagName -> [Char]
unFlagName (PackageFlag -> FlagName
flagName PackageFlag
flagOld)

    [Char] -> (Bool -> [Char]) -> Check Bool
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"type of flag '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'")
              (\Bool
b -> if Bool
b then [Char]
"manual" else [Char]
"automatic")
              (PackageFlag -> Bool
flagManual PackageFlag
flagOld) (PackageFlag -> Bool
flagManual PackageFlag
flagNew)

    [Char] -> (Bool -> [Char]) -> Check Bool
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"default of flag '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'") Bool -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow
              (PackageFlag -> Bool
flagDefault PackageFlag
flagOld) (PackageFlag -> Bool
flagDefault PackageFlag
flagNew)

    [Char] -> ([Char] -> [Char]) -> Check [Char]
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"description of flag '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'") [Char] -> [Char]
forall a. a -> a
id
              (PackageFlag -> [Char]
flagDescription PackageFlag
flagOld) (PackageFlag -> [Char]
flagDescription PackageFlag
flagNew)

checkPackageDescriptions :: Bool -> Check PackageDescription
checkPackageDescriptions :: Bool -> Check PackageDescription
checkPackageDescriptions Bool
checkXRevision
  pdA :: PackageDescription
pdA@(PackageDescription
     { specVersion :: PackageDescription -> CabalSpecVersion
specVersion     = CabalSpecVersion
_specVersionA
     , package :: PackageDescription -> PackageIdentifier
package         = PackageIdentifier
packageIdA
     , licenseRaw :: PackageDescription -> Either License License
licenseRaw      = Either License License
licenseRawA
     , licenseFiles :: PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles    = [SymbolicPath PackageDir LicenseFile]
licenseFilesA
     , copyright :: PackageDescription -> ShortText
copyright       = ShortText
copyrightA
     , maintainer :: PackageDescription -> ShortText
maintainer      = ShortText
maintainerA
     , author :: PackageDescription -> ShortText
author          = ShortText
authorA
     , stability :: PackageDescription -> ShortText
stability       = ShortText
stabilityA
     , testedWith :: PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith      = [(CompilerFlavor, VersionRange)]
testedWithA
     , homepage :: PackageDescription -> ShortText
homepage        = ShortText
homepageA
     , pkgUrl :: PackageDescription -> ShortText
pkgUrl          = ShortText
pkgUrlA
     , bugReports :: PackageDescription -> ShortText
bugReports      = ShortText
bugReportsA
     , sourceRepos :: PackageDescription -> [SourceRepo]
sourceRepos     = [SourceRepo]
sourceReposA
     , synopsis :: PackageDescription -> ShortText
synopsis        = ShortText
synopsisA
     , description :: PackageDescription -> ShortText
description     = ShortText
descriptionA
     , category :: PackageDescription -> ShortText
category        = ShortText
categoryA
     , customFieldsPD :: PackageDescription -> [([Char], [Char])]
customFieldsPD  = [([Char], [Char])]
customFieldsPDA
     , buildTypeRaw :: PackageDescription -> Maybe BuildType
buildTypeRaw    = Maybe BuildType
buildTypeRawA
     , setupBuildInfo :: PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo  = Maybe SetupBuildInfo
setupBuildInfoA
     , library :: PackageDescription -> Maybe Library
library         = Maybe Library
_libraryA
     , subLibraries :: PackageDescription -> [Library]
subLibraries    = [Library]
_subLibrariesA
     , executables :: PackageDescription -> [Executable]
executables     = [Executable]
_executablesA
     , foreignLibs :: PackageDescription -> [ForeignLib]
foreignLibs     = [ForeignLib]
_foreignLibsA
     , testSuites :: PackageDescription -> [TestSuite]
testSuites      = [TestSuite]
_testSuitesA
     , benchmarks :: PackageDescription -> [Benchmark]
benchmarks      = [Benchmark]
_benchmarksA
     , dataFiles :: PackageDescription -> [[Char]]
dataFiles       = [[Char]]
dataFilesA
     , dataDir :: PackageDescription -> [Char]
dataDir         = [Char]
dataDirA
     , extraSrcFiles :: PackageDescription -> [[Char]]
extraSrcFiles   = [[Char]]
extraSrcFilesA
     , extraTmpFiles :: PackageDescription -> [[Char]]
extraTmpFiles   = [[Char]]
extraTmpFilesA
     , extraDocFiles :: PackageDescription -> [[Char]]
extraDocFiles   = [[Char]]
extraDocFilesA
     })
  pdB :: PackageDescription
pdB@(PackageDescription
     { specVersion :: PackageDescription -> CabalSpecVersion
specVersion     = CabalSpecVersion
_specVersionB
     , package :: PackageDescription -> PackageIdentifier
package         = PackageIdentifier
packageIdB
     , licenseRaw :: PackageDescription -> Either License License
licenseRaw      = Either License License
licenseRawB
     , licenseFiles :: PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles    = [SymbolicPath PackageDir LicenseFile]
licenseFilesB
     , copyright :: PackageDescription -> ShortText
copyright       = ShortText
copyrightB
     , maintainer :: PackageDescription -> ShortText
maintainer      = ShortText
maintainerB
     , author :: PackageDescription -> ShortText
author          = ShortText
authorB
     , stability :: PackageDescription -> ShortText
stability       = ShortText
stabilityB
     , testedWith :: PackageDescription -> [(CompilerFlavor, VersionRange)]
testedWith      = [(CompilerFlavor, VersionRange)]
testedWithB
     , homepage :: PackageDescription -> ShortText
homepage        = ShortText
homepageB
     , pkgUrl :: PackageDescription -> ShortText
pkgUrl          = ShortText
pkgUrlB
     , bugReports :: PackageDescription -> ShortText
bugReports      = ShortText
bugReportsB
     , sourceRepos :: PackageDescription -> [SourceRepo]
sourceRepos     = [SourceRepo]
sourceReposB
     , synopsis :: PackageDescription -> ShortText
synopsis        = ShortText
synopsisB
     , description :: PackageDescription -> ShortText
description     = ShortText
descriptionB
     , category :: PackageDescription -> ShortText
category        = ShortText
categoryB
     , customFieldsPD :: PackageDescription -> [([Char], [Char])]
customFieldsPD  = [([Char], [Char])]
customFieldsPDB
     , buildTypeRaw :: PackageDescription -> Maybe BuildType
buildTypeRaw    = Maybe BuildType
buildTypeRawB
     , setupBuildInfo :: PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo  = Maybe SetupBuildInfo
setupBuildInfoB
     , library :: PackageDescription -> Maybe Library
library         = Maybe Library
_libraryB
     , subLibraries :: PackageDescription -> [Library]
subLibraries    = [Library]
_subLibrariesB
     , executables :: PackageDescription -> [Executable]
executables     = [Executable]
_executablesB
     , foreignLibs :: PackageDescription -> [ForeignLib]
foreignLibs     = [ForeignLib]
_foreignLibsB
     , testSuites :: PackageDescription -> [TestSuite]
testSuites      = [TestSuite]
_testSuitesB
     , benchmarks :: PackageDescription -> [Benchmark]
benchmarks      = [Benchmark]
_benchmarksB
     , dataFiles :: PackageDescription -> [[Char]]
dataFiles       = [[Char]]
dataFilesB
     , dataDir :: PackageDescription -> [Char]
dataDir         = [Char]
dataDirB
     , extraSrcFiles :: PackageDescription -> [[Char]]
extraSrcFiles   = [[Char]]
extraSrcFilesB
     , extraTmpFiles :: PackageDescription -> [[Char]]
extraTmpFiles   = [[Char]]
extraTmpFilesB
     , extraDocFiles :: PackageDescription -> [[Char]]
extraDocFiles   = [[Char]]
extraDocFilesB
     })
  = do
  [Char] -> Check PackageName
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Don't be silly! You can't change the package name!"
            (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
packageIdA) (PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
packageIdB)
  [Char] -> Check Version
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"You can't change the package version!"
            (PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
packageIdA) (PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
packageIdB)
  [Char]
-> Check
     (Either License License, [SymbolicPath PackageDir LicenseFile])
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the license"
            (Either License License
licenseRawA, [SymbolicPath PackageDir LicenseFile]
licenseFilesA) (Either License License
licenseRawB, [SymbolicPath PackageDir LicenseFile]
licenseFilesB)
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"copyright"  ShortText -> [Char]
fromShortText ShortText
copyrightA ShortText
copyrightB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"maintainer" ShortText -> [Char]
fromShortText ShortText
maintainerA ShortText
maintainerB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"author"     ShortText -> [Char]
fromShortText ShortText
authorA ShortText
authorB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"stability"  ShortText -> [Char]
fromShortText ShortText
stabilityA ShortText
stabilityB
  Severity
-> [Char]
-> ([(CompilerFlavor, VersionRange)] -> [Char])
-> Check [(CompilerFlavor, VersionRange)]
forall a. Eq a => Severity -> [Char] -> (a -> [Char]) -> Check a
changesOk' Severity
Trivial [Char]
"tested-with" (Doc -> [Char]
forall a. Show a => a -> [Char]
show (Doc -> [Char])
-> ([(CompilerFlavor, VersionRange)] -> Doc)
-> [(CompilerFlavor, VersionRange)]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CompilerFlavor, VersionRange)] -> Doc
ppTestedWith) [(CompilerFlavor, VersionRange)]
testedWithA [(CompilerFlavor, VersionRange)]
testedWithB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"homepage" ShortText -> [Char]
fromShortText ShortText
homepageA ShortText
homepageB
  [Char] -> Check ShortText
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"The package-url field is unused, don't bother changing it."
            ShortText
pkgUrlA ShortText
pkgUrlB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"bug-reports" ShortText -> [Char]
fromShortText ShortText
bugReportsA ShortText
bugReportsB
  ([Char] -> (SourceRepo -> [Char]) -> Check SourceRepo)
-> [Char] -> (SourceRepo -> [Char]) -> Check [SourceRepo]
forall a.
([Char] -> (a -> [Char]) -> Check a)
-> [Char] -> (a -> [Char]) -> Check [a]
changesOkList [Char] -> (SourceRepo -> [Char]) -> Check SourceRepo
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"source-repository" ((() -> CommentPosition) -> [PrettyField ()] -> [Char]
forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> [Char]
showFields () -> CommentPosition
forall {p}. p -> CommentPosition
noComment ([PrettyField ()] -> [Char])
-> (SourceRepo -> [PrettyField ()]) -> SourceRepo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrettyField () -> [PrettyField ()] -> [PrettyField ()]
forall a. a -> [a] -> [a]
:[]) (PrettyField () -> [PrettyField ()])
-> (SourceRepo -> PrettyField ()) -> SourceRepo -> [PrettyField ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepo -> PrettyField ()
ppSourceRepo)
            [SourceRepo]
sourceReposA [SourceRepo]
sourceReposB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"synopsis"    ShortText -> [Char]
fromShortText ShortText
synopsisA ShortText
synopsisB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"description" ShortText -> [Char]
fromShortText ShortText
descriptionA ShortText
descriptionB
  [Char] -> (ShortText -> [Char]) -> Check ShortText
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"category"    ShortText -> [Char]
fromShortText ShortText
categoryA ShortText
categoryB
  [Char] -> Check (Maybe BuildType)
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the build-type"
            Maybe BuildType
buildTypeRawA Maybe BuildType
buildTypeRawB
  [Char] -> Check ([[Char]], [Char])
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the data files"
            ([[Char]]
dataFilesA, [Char]
dataDirA) ([[Char]]
dataFilesB, [Char]
dataDirB)
  [Char] -> Check [[Char]]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Changing extra-tmp-files is a bit pointless at this stage"
            [[Char]]
extraTmpFilesA [[Char]]
extraTmpFilesB
  [Char] -> Check [[Char]]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Changing extra-source-files would not make sense!"
            [[Char]]
extraSrcFilesA [[Char]]
extraSrcFilesB
  [Char] -> Check [[Char]]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"You can't change the extra-doc-files."
            [[Char]]
extraDocFilesA [[Char]]
extraDocFilesB

  [Char] -> Check [([Char], [Char])]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change custom/extension fields"
            ((([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
f,[Char]
_) -> [Char]
f [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"x-revision",[Char]
"x-curation"]) [([Char], [Char])]
customFieldsPDA)
            ((([Char], [Char]) -> Bool)
-> [([Char], [Char])] -> [([Char], [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
f,[Char]
_) -> [Char]
f [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"x-revision",[Char]
"x-curation"]) [([Char], [Char])]
customFieldsPDB)

  Check PackageDescription
checkSpecVersionRaw PackageDescription
pdA PackageDescription
pdB
  Check (Maybe SetupBuildInfo)
checkSetupBuildInfo Maybe SetupBuildInfo
setupBuildInfoA Maybe SetupBuildInfo
setupBuildInfoB

  Bool -> CheckM () -> CheckM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkXRevision (CheckM () -> CheckM ()) -> CheckM () -> CheckM ()
forall a b. (a -> b) -> a -> b
$ Check [([Char], [Char])]
checkRevision [([Char], [Char])]
customFieldsPDA [([Char], [Char])]
customFieldsPDB
  Check [([Char], [Char])]
checkCuration [([Char], [Char])]
customFieldsPDA [([Char], [Char])]
customFieldsPDB
  where
#if MIN_VERSION_Cabal(3,7,0)
    noComment :: p -> CommentPosition
noComment p
_ = CommentPosition
NoComment
#else
    noComment _ = []
#endif

checkSpecVersionRaw :: Check PackageDescription
checkSpecVersionRaw :: Check PackageDescription
checkSpecVersionRaw PackageDescription
pdA PackageDescription
pdB
  | CabalSpecVersion -> Bool
range110To120 CabalSpecVersion
specVersionA
  , CabalSpecVersion -> Bool
range110To120 CabalSpecVersion
specVersionB
  = [Char] -> (CabalSpecVersion -> [Char]) -> Check CabalSpecVersion
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"cabal-version" CabalSpecVersion -> [Char]
showCabalSpecVersion CabalSpecVersion
specVersionA CabalSpecVersion
specVersionB

  | Bool
otherwise
  = [Char] -> Check CabalSpecVersion
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the Cabal spec version"
              CabalSpecVersion
specVersionA CabalSpecVersion
specVersionB
  where
    specVersionA :: CabalSpecVersion
specVersionA = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pdA
    specVersionB :: CabalSpecVersion
specVersionB = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pdB

    -- nothing interesting changed within the  Cabal >=1.10 && <1.21 range
    -- therefore we allow to change the spec version within this interval
    range110To120 :: CabalSpecVersion -> Bool
range110To120 CabalSpecVersion
v = CabalSpecVersion
CabalSpecV1_10 CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
v Bool -> Bool -> Bool
&& CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
<= CabalSpecVersion
CabalSpecV1_20

checkRevision :: Check [(String, String)]
checkRevision :: Check [([Char], [Char])]
checkRevision [([Char], [Char])]
customFieldsA [([Char], [Char])]
customFieldsB =
    [Char] -> Check Int
forall a. Eq a => [Char] -> Check a
checkSame ([Char]
"The new x-revision must be " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
expectedRevision)
              Int
newRevision Int
expectedRevision
  where
    oldRevision :: Int
oldRevision = [([Char], [Char])] -> Int
forall {a}. (Eq a, IsString a) => [(a, [Char])] -> Int
getRevision [([Char], [Char])]
customFieldsA
    newRevision :: Int
newRevision = [([Char], [Char])] -> Int
forall {a}. (Eq a, IsString a) => [(a, [Char])] -> Int
getRevision [([Char], [Char])]
customFieldsB
    expectedRevision :: Int
expectedRevision = Int
oldRevision Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

    getRevision :: [(a, [Char])] -> Int
getRevision [(a, [Char])]
customFields =
      case a -> [(a, [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"x-revision" [(a, [Char])]
customFields of
        Just [Char]
s  | [(Int
n,[Char]
"")] <- ReadS Int
forall a. Read a => ReadS a
reads [Char]
s -> Int
n :: Int
        Maybe [Char]
_                             -> Int
0

checkCuration :: Check [(String, String)]
checkCuration :: Check [([Char], [Char])]
checkCuration [([Char], [Char])]
customFieldsA [([Char], [Char])]
customFieldsB =
    [Char] -> Check (Maybe [Char])
checkNotPresent [Char]
"Revised metadata must not contain an x-curation field as revisions necessarily imply curation, and revising an uncurated package adopts it into the curated layer." Maybe [Char]
oldCuration Maybe [Char]
newCuration
  where
    oldCuration :: Maybe [Char]
oldCuration = [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"x-curation" [([Char], [Char])]
customFieldsA
    newCuration :: Maybe [Char]
newCuration = [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"x-curation" [([Char], [Char])]
customFieldsB



checkCondTree :: (ComponentName -> Check a) -> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree :: forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check a
checkElem (ComponentName
componentName, CondTree ConfVar [Dependency] a
condNodeA)
                        (ComponentName
_            , CondTree ConfVar [Dependency] a
condNodeB) =
    CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a -> CheckM ()
checkCondNode CondTree ConfVar [Dependency] a
condNodeA CondTree ConfVar [Dependency] a
condNodeB
  where
    checkCondNode :: CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a -> CheckM ()
checkCondNode (CondNode a
dataA [Dependency]
constraintsA [CondBranch ConfVar [Dependency] a]
componentsA)
                  (CondNode a
dataB [Dependency]
constraintsB [CondBranch ConfVar [Dependency] a]
componentsB) = do
      ComponentName -> Check [Dependency]
forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName [Dependency]
constraintsA [Dependency]
constraintsB
      [Char]
-> Check (CondBranch ConfVar [Dependency] a)
-> Check [CondBranch ConfVar [Dependency] a]
forall a. [Char] -> Check a -> Check [a]
checkList [Char]
"Cannot add or remove 'if' conditionals"
                Check (CondBranch ConfVar [Dependency] a)
checkComponent [CondBranch ConfVar [Dependency] a]
componentsA [CondBranch ConfVar [Dependency] a]
componentsB
      ComponentName -> Check a
checkElem ComponentName
componentName a
dataA a
dataB

    checkComponent :: Check (CondBranch ConfVar [Dependency] a)
checkComponent (CondBranch Condition ConfVar
condA CondTree ConfVar [Dependency] a
ifPartA Maybe (CondTree ConfVar [Dependency] a)
thenPartA)
                   (CondBranch Condition ConfVar
condB CondTree ConfVar [Dependency] a
ifPartB Maybe (CondTree ConfVar [Dependency] a)
thenPartB) = do
      [Char] -> Check (Condition ConfVar)
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the 'if' condition expressions"
                Condition ConfVar
condA Condition ConfVar
condB
      CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a -> CheckM ()
checkCondNode CondTree ConfVar [Dependency] a
ifPartA CondTree ConfVar [Dependency] a
ifPartB
      [Char]
-> (CondTree ConfVar [Dependency] a
    -> CondTree ConfVar [Dependency] a -> CheckM ())
-> Check (Maybe (CondTree ConfVar [Dependency] a))
forall a. [Char] -> Check a -> Check (Maybe a)
checkMaybe [Char]
"Cannot add or remove the 'else' part in conditionals"
                 CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] a -> CheckM ()
checkCondNode Maybe (CondTree ConfVar [Dependency] a)
thenPartA Maybe (CondTree ConfVar [Dependency] a)
thenPartB

checkDependencies :: forall d vr. (Pretty d, IsDependency vr d) => ComponentName -> Check [d]
checkDependencies :: forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName [d]
ds1 [d]
ds2 = do
    [d] -> (d -> CheckM Any) -> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [d]
removed ((d -> CheckM Any) -> CheckM ()) -> (d -> CheckM Any) -> CheckM ()
forall a b. (a -> b) -> a -> b
$ \d
dep -> do
        [Char] -> CheckM Any
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([[Char]] -> [Char]
unwords [ [Char]
"Cannot remove existing", [Char]
depKind, [Char]
"on"
                      , Proxy d -> DepKey d -> [Char]
forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy (d -> DepKey d
forall vr d. IsDependency vr d => d -> DepKey d
depKey d
dep), [Char]
"in", [Char]
cnameStr, [Char]
" component"])

    [d] -> (d -> CheckM ()) -> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [d]
added ((d -> CheckM ()) -> CheckM ()) -> (d -> CheckM ()) -> CheckM ()
forall a b. (a -> b) -> a -> b
$ \d
dep ->
        if d -> Bool
forall vr d. IsDependency vr d => d -> Bool
depInAddWhitelist d
dep
           then Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([[Char]] -> [Char]
unwords [[Char]
"added the", [Char]
cnameStr, [Char]
"component's"
                                                  , [Char]
depKind, [Char]
"on"]) [Char]
"" (d -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow d
dep))
           else [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([[Char]] -> [Char]
unwords [ [Char]
"Cannot add new", [Char]
depKind, [Char]
"on"
                              , Proxy d -> DepKey d -> [Char]
forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy (d -> DepKey d
forall vr d. IsDependency vr d => d -> DepKey d
depKey d
dep)
                              , [Char]
"in", [Char]
cnameStr, [Char]
"component"])

    [(DepKey d, (vr, vr))]
-> ((DepKey d, (vr, vr)) -> CheckM ()) -> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(DepKey d, (vr, vr))]
changed (((DepKey d, (vr, vr)) -> CheckM ()) -> CheckM ())
-> ((DepKey d, (vr, vr)) -> CheckM ()) -> CheckM ()
forall a b. (a -> b) -> a -> b
$ \(DepKey d
depk, (vr
verA, vr
verB)) -> do
        [Char] -> (vr -> [Char]) -> Check vr
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([[Char]] -> [Char]
unwords [[Char]
"the", [Char]
cnameStr, [Char]
"component's", [Char]
depKind, [Char]
"on"
                           , Proxy d -> DepKey d -> [Char]
forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy DepKey d
depk])
                   vr -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow vr
verA vr
verB
  where
    ([d]
removed, [(DepKey d, (vr, vr))]
changed, [d]
added) = [d] -> [d] -> ([d], [(DepKey d, (vr, vr))], [d])
forall vr d.
IsDependency vr d =>
[d] -> [d] -> ([d], [(DepKey d, (vr, vr))], [d])
computeCanonDepChange [d]
ds1 [d]
ds2

    dproxy :: Proxy d
    dproxy :: Proxy d
dproxy = Proxy d
forall {k} (t :: k). Proxy t
Proxy

    cnameStr :: [Char]
cnameStr = ComponentName -> [Char]
showComponentName ComponentName
componentName

    depKind :: [Char]
depKind = Proxy d -> [Char]
forall vr d. IsDependency vr d => Proxy d -> [Char]
depTypeName Proxy d
dproxy [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" dependency"

class (Ord (DepKey d), Pretty vr, Eq vr) => IsDependency vr d | d -> vr where
    type DepKey d

    depTypeName    :: Proxy d -> String
    depKey         :: d -> DepKey d
    depKeyShow     :: Proxy d -> DepKey d -> String
    depVerRg       :: d -> vr
    reconstructDep :: DepKey d -> vr -> d

    depInAddWhitelist :: d -> Bool
    depInAddWhitelist d
_ = Bool
False

    intersectVr :: Proxy d -> vr -> vr -> vr

instance IsDependency VersionRange Dependency where
    type DepKey Dependency = PackageName

    depTypeName :: Proxy Dependency -> [Char]
depTypeName Proxy Dependency
Proxy             = [Char]
"library"
    depKey :: Dependency -> DepKey Dependency
depKey (Dependency PackageName
pkgname VersionRange
_ NonEmptySet LibraryName
_) = PackageName
DepKey Dependency
pkgname
    depKeyShow :: Proxy Dependency -> DepKey Dependency -> [Char]
depKeyShow Proxy Dependency
Proxy              = PackageName -> [Char]
DepKey Dependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow''
    depVerRg :: Dependency -> VersionRange
depVerRg (Dependency PackageName
_ VersionRange
vr NonEmptySet LibraryName
_)  = VersionRange
vr
    reconstructDep :: DepKey Dependency -> VersionRange -> Dependency
reconstructDep                = \DepKey Dependency
n VersionRange
vr -> PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
DepKey Dependency
n VersionRange
vr NonEmptySet LibraryName
mainLibSet

    depInAddWhitelist :: Dependency -> Bool
depInAddWhitelist (Dependency PackageName
pn VersionRange
_ NonEmptySet LibraryName
_) = PackageName
pn PackageName -> [PackageName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    -- Special case: there are some pretty weird broken packages out there, see
    --   https://github.com/haskell/hackage-server/issues/303
    -- which need us to add a new dep on `base`
            [ [Char] -> PackageName
mkPackageName [Char]
"base"

    -- See also https://github.com/haskell/hackage-server/issues/472
    --
    -- this is mostly to allow to add dependencies on `base-orphans == 0`
    -- as otherwise we have no way to express when a package is
    -- incompatible with the recently introduced `base-orphans` package
    -- which started adopting orphan instances; in the long-term we need a
    -- more general approach to this, as otherwise we'll end up adding
    -- ad-hoc exceptions like this one. See e.g.
    --   https://github.com/haskell/cabal/issues/3061
    --
            , [Char] -> PackageName
mkPackageName [Char]
"base-orphans"
            ]

    intersectVr :: Proxy Dependency -> VersionRange -> VersionRange -> VersionRange
intersectVr Proxy Dependency
_ = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges


instance IsDependency VersionRange ExeDependency where
    type DepKey ExeDependency = (PackageName,UnqualComponentName)

    depTypeName :: Proxy ExeDependency -> [Char]
depTypeName Proxy ExeDependency
Proxy                   = [Char]
"tool"
    depKey :: ExeDependency -> DepKey ExeDependency
depKey (ExeDependency PackageName
pkgname UnqualComponentName
cn VersionRange
_) = (PackageName
pkgname,UnqualComponentName
cn)
    depKeyShow :: Proxy ExeDependency -> DepKey ExeDependency -> [Char]
depKeyShow Proxy ExeDependency
Proxy (PackageName
pkgname,UnqualComponentName
cn)       = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"'", PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageName
pkgname, [Char]
":", UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnqualComponentName
cn, [Char]
"'"]
    depVerRg :: ExeDependency -> VersionRange
depVerRg (ExeDependency PackageName
_ UnqualComponentName
_ VersionRange
vr)     = VersionRange
vr
    reconstructDep :: DepKey ExeDependency -> VersionRange -> ExeDependency
reconstructDep (PackageName
pkgname,UnqualComponentName
cn)         = PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
ExeDependency PackageName
pkgname UnqualComponentName
cn

    intersectVr :: Proxy ExeDependency -> VersionRange -> VersionRange -> VersionRange
intersectVr Proxy ExeDependency
_ = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges

instance IsDependency VersionRange LegacyExeDependency where
    type DepKey LegacyExeDependency = String

    depTypeName :: Proxy LegacyExeDependency -> [Char]
depTypeName Proxy LegacyExeDependency
Proxy                      = [Char]
"legacy-tool"
    depKey :: LegacyExeDependency -> DepKey LegacyExeDependency
depKey (LegacyExeDependency [Char]
tname VersionRange
_)   = [Char]
DepKey LegacyExeDependency
tname
    depKeyShow :: Proxy LegacyExeDependency -> DepKey LegacyExeDependency -> [Char]
depKeyShow Proxy LegacyExeDependency
Proxy DepKey LegacyExeDependency
tname                 = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
DepKey LegacyExeDependency
tname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
    depVerRg :: LegacyExeDependency -> VersionRange
depVerRg (LegacyExeDependency [Char]
_ VersionRange
vr)    = VersionRange
vr
    reconstructDep :: DepKey LegacyExeDependency -> VersionRange -> LegacyExeDependency
reconstructDep                         = [Char] -> VersionRange -> LegacyExeDependency
DepKey LegacyExeDependency -> VersionRange -> LegacyExeDependency
LegacyExeDependency

    intersectVr :: Proxy LegacyExeDependency
-> VersionRange -> VersionRange -> VersionRange
intersectVr Proxy LegacyExeDependency
_ = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges

    depInAddWhitelist :: LegacyExeDependency -> Bool
depInAddWhitelist (LegacyExeDependency [Char]
pn VersionRange
_) = [Char]
pn [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    -- list of trusted tools cabal supports w/o explicit build-tools
    -- c.f. Distribution.Simple.BuildToolDepends.desugarBuildTool
    -- and 'knownSuffixHandlers' in "Distribution.Client.Init.Heuristics"
            [ [Char]
"alex"
            , [Char]
"c2hs"
            , [Char]
"cpphs"
            , [Char]
"greencard"
            , [Char]
"happy"
            , [Char]
"hsc2hs"
            ]

instance IsDependency PkgconfigVersionRange PkgconfigDependency where
    type DepKey PkgconfigDependency = PkgconfigName

    depTypeName :: Proxy PkgconfigDependency -> [Char]
depTypeName Proxy PkgconfigDependency
Proxy                      = [Char]
"pkg-config"
    depKey :: PkgconfigDependency -> DepKey PkgconfigDependency
depKey (PkgconfigDependency PkgconfigName
pkgname PkgconfigVersionRange
_) = PkgconfigName
DepKey PkgconfigDependency
pkgname
    depKeyShow :: Proxy PkgconfigDependency -> DepKey PkgconfigDependency -> [Char]
depKeyShow Proxy PkgconfigDependency
Proxy                       = PkgconfigName -> [Char]
DepKey PkgconfigDependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow''
    depVerRg :: PkgconfigDependency -> PkgconfigVersionRange
depVerRg (PkgconfigDependency PkgconfigName
_ PkgconfigVersionRange
vr)    = PkgconfigVersionRange
vr
    reconstructDep :: DepKey PkgconfigDependency
-> PkgconfigVersionRange -> PkgconfigDependency
reconstructDep                         = PkgconfigName -> PkgconfigVersionRange -> PkgconfigDependency
DepKey PkgconfigDependency
-> PkgconfigVersionRange -> PkgconfigDependency
PkgconfigDependency

    intersectVr :: Proxy PkgconfigDependency
-> PkgconfigVersionRange
-> PkgconfigVersionRange
-> PkgconfigVersionRange
intersectVr Proxy PkgconfigDependency
_ = PkgconfigVersionRange
-> PkgconfigVersionRange -> PkgconfigVersionRange
PcIntersectVersionRanges


-- The result tuple represents the 3 canonicalised dependency
-- (removed deps (old ranges), retained deps (old & new ranges), added deps (new ranges))
-- or expressed as set-operations: (A \ B, (A ∩ B), B \ A)
computeCanonDepChange :: forall vr d. IsDependency vr d => [d] -> [d] -> ([d],[(DepKey d,(vr,vr))],[d])
computeCanonDepChange :: forall vr d.
IsDependency vr d =>
[d] -> [d] -> ([d], [(DepKey d, (vr, vr))], [d])
computeCanonDepChange [d]
depsA [d]
depsB
    = ( Map (DepKey d) vr -> [d]
mapToDeps (Map (DepKey d) vr
a Map (DepKey d) vr -> Map (DepKey d) vr -> Map (DepKey d) vr
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map (DepKey d) vr
b)
      , Map (DepKey d) (vr, vr) -> [(DepKey d, (vr, vr))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (DepKey d) (vr, vr) -> [(DepKey d, (vr, vr))])
-> Map (DepKey d) (vr, vr) -> [(DepKey d, (vr, vr))]
forall a b. (a -> b) -> a -> b
$ (vr -> vr -> (vr, vr))
-> Map (DepKey d) vr
-> Map (DepKey d) vr
-> Map (DepKey d) (vr, vr)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map (DepKey d) vr
a Map (DepKey d) vr
b
      , Map (DepKey d) vr -> [d]
mapToDeps (Map (DepKey d) vr
b Map (DepKey d) vr -> Map (DepKey d) vr -> Map (DepKey d) vr
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map (DepKey d) vr
a)
      )
  where
    a :: Map (DepKey d) vr
a = [d] -> Map (DepKey d) vr
depsToMapWithCanonVerRange [d]
depsA
    b :: Map (DepKey d) vr
b = [d] -> Map (DepKey d) vr
depsToMapWithCanonVerRange [d]
depsB

    depsToMapWithCanonVerRange :: [d] -> Map (DepKey d) vr
depsToMapWithCanonVerRange
        = (vr -> vr -> vr) -> [(DepKey d, vr)] -> Map (DepKey d) vr
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((vr -> vr -> vr) -> vr -> vr -> vr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((vr -> vr -> vr) -> vr -> vr -> vr)
-> (vr -> vr -> vr) -> vr -> vr -> vr
forall a b. (a -> b) -> a -> b
$ Proxy d -> vr -> vr -> vr
forall vr d. IsDependency vr d => Proxy d -> vr -> vr -> vr
intersectVr (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)) ([(DepKey d, vr)] -> Map (DepKey d) vr)
-> ([d] -> [(DepKey d, vr)]) -> [d] -> Map (DepKey d) vr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (d -> (DepKey d, vr)) -> [d] -> [(DepKey d, vr)]
forall a b. (a -> b) -> [a] -> [b]
map (\d
d -> (d -> DepKey d
forall vr d. IsDependency vr d => d -> DepKey d
depKey d
d, d -> vr
forall vr d. IsDependency vr d => d -> vr
depVerRg d
d))

    mapToDeps :: Map (DepKey d) vr -> [d]
mapToDeps
        = ((DepKey d, vr) -> d) -> [(DepKey d, vr)] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map (\(DepKey d
pkgname, vr
verrange) -> DepKey d -> vr -> d
forall vr d. IsDependency vr d => DepKey d -> vr -> d
reconstructDep DepKey d
pkgname vr
verrange) ([(DepKey d, vr)] -> [d])
-> (Map (DepKey d) vr -> [(DepKey d, vr)])
-> Map (DepKey d) vr
-> [d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (DepKey d) vr -> [(DepKey d, vr)]
forall k a. Map k a -> [(k, a)]
Map.toList


checkSetupBuildInfo :: Check (Maybe SetupBuildInfo)
checkSetupBuildInfo :: Check (Maybe SetupBuildInfo)
checkSetupBuildInfo Maybe SetupBuildInfo
Nothing  Maybe SetupBuildInfo
Nothing = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSetupBuildInfo (Just SetupBuildInfo
_) Maybe SetupBuildInfo
Nothing =
    [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot remove a 'custom-setup' section"

checkSetupBuildInfo Maybe SetupBuildInfo
Nothing (Just (SetupBuildInfo [Dependency]
setupDependsA Bool
_internalA)) =
    Change -> CheckM ()
logChange (Change -> CheckM ()) -> Change -> CheckM ()
forall a b. (a -> b) -> a -> b
$ Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal
                       [Char]
"added a 'custom-setup' section with 'setup-depends'"
                       [Char]
"[implicit]" ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((Dependency -> [Char]) -> [Dependency] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow [Dependency]
setupDependsA))

checkSetupBuildInfo (Just (SetupBuildInfo [Dependency]
setupDependsA Bool
_internalA))
                    (Just (SetupBuildInfo [Dependency]
setupDependsB Bool
_internalB)) = do
    [Dependency] -> (Dependency -> CheckM ()) -> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Dependency]
removed ((Dependency -> CheckM ()) -> CheckM ())
-> (Dependency -> CheckM ()) -> CheckM ()
forall a b. (a -> b) -> a -> b
$ \Dependency
dep ->
      Change -> CheckM ()
logChange (Change -> CheckM ()) -> Change -> CheckM ()
forall a b. (a -> b) -> a -> b
$ Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal [Char]
"removed 'custom-setup' dependency on" (Dependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Dependency
dep) [Char]
""
    [Dependency] -> (Dependency -> CheckM ()) -> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Dependency]
added ((Dependency -> CheckM ()) -> CheckM ())
-> (Dependency -> CheckM ()) -> CheckM ()
forall a b. (a -> b) -> a -> b
$ \Dependency
dep ->
      Change -> CheckM ()
logChange (Change -> CheckM ()) -> Change -> CheckM ()
forall a b. (a -> b) -> a -> b
$ Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal [Char]
"added 'custom-setup' dependency on" [Char]
"" (Dependency -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Dependency
dep)
    [(PackageName, (VersionRange, VersionRange))]
-> ((PackageName, (VersionRange, VersionRange)) -> CheckM ())
-> CheckM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(PackageName, (VersionRange, VersionRange))]
[(DepKey Dependency, (VersionRange, VersionRange))]
changed (((PackageName, (VersionRange, VersionRange)) -> CheckM ())
 -> CheckM ())
-> ((PackageName, (VersionRange, VersionRange)) -> CheckM ())
-> CheckM ()
forall a b. (a -> b) -> a -> b
$ \(PackageName
pkgn, (VersionRange
verA, VersionRange
verB)) ->
        [Char] -> (VersionRange -> [Char]) -> Check VersionRange
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"the 'custom-setup' dependency on " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow'' PackageName
pkgn)
                  VersionRange -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow VersionRange
verA VersionRange
verB
  where
    ([Dependency]
removed, [(DepKey Dependency, (VersionRange, VersionRange))]
changed, [Dependency]
added) =
      [Dependency]
-> [Dependency]
-> ([Dependency],
    [(DepKey Dependency, (VersionRange, VersionRange))], [Dependency])
forall vr d.
IsDependency vr d =>
[d] -> [d] -> ([d], [(DepKey d, (vr, vr))], [d])
computeCanonDepChange [Dependency]
setupDependsA [Dependency]
setupDependsB

checkLibrary :: ComponentName -> Check Library
checkLibrary :: ComponentName -> Check Library
checkLibrary ComponentName
componentName
             (Library LibraryName
modulesA [ModuleName]
reexportedA [ModuleReexport]
requiredSigsA [ModuleName]
exposedSigsA
                      Bool
exposedA LibraryVisibility
visibilityA BuildInfo
buildInfoA)
             (Library LibraryName
modulesB [ModuleName]
reexportedB [ModuleReexport]
requiredSigsB [ModuleName]
exposedSigsB
                      Bool
exposedB LibraryVisibility
visibilityB BuildInfo
buildInfoB) = do
  [Char] -> Check LibraryName
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the exposed modules" LibraryName
modulesA LibraryName
modulesB
  [Char] -> Check [ModuleName]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the re-exported modules" [ModuleName]
reexportedA [ModuleName]
reexportedB
  [Char] -> Check [ModuleReexport]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the required signatures" [ModuleReexport]
requiredSigsA [ModuleReexport]
requiredSigsB
  [Char] -> Check [ModuleName]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the exposed signatures"  [ModuleName]
exposedSigsA  [ModuleName]
exposedSigsB
  [Char] -> Check Bool
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the package exposed status" Bool
exposedA Bool
exposedB
  [Char] -> Check LibraryVisibility
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the package visibility" LibraryVisibility
visibilityA LibraryVisibility
visibilityB
  ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
buildInfoA BuildInfo
buildInfoB

checkForeignLib :: ComponentName -> Check ForeignLib
checkForeignLib :: ComponentName -> Check ForeignLib
checkForeignLib ComponentName
componentName
             (ForeignLib UnqualComponentName
nameA ForeignLibType
typeA [ForeignLibOption]
optionsA BuildInfo
buildInfoA Maybe LibVersionInfo
verA Maybe Version
verLinuxA [[Char]]
modDefA)
             (ForeignLib UnqualComponentName
nameB ForeignLibType
typeB [ForeignLibOption]
optionsB BuildInfo
buildInfoB Maybe LibVersionInfo
verB Maybe Version
verLinuxB [[Char]]
modDefB) = do
  [Char] -> Check UnqualComponentName
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library name" UnqualComponentName
nameA UnqualComponentName
nameB
  [Char] -> Check ForeignLibType
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library type" ForeignLibType
typeA ForeignLibType
typeB
  [Char] -> Check [ForeignLibOption]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library options" [ForeignLibOption]
optionsA [ForeignLibOption]
optionsB
  [Char] -> Check (Maybe LibVersionInfo)
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library version" Maybe LibVersionInfo
verA Maybe LibVersionInfo
verB
  [Char] -> Check (Maybe Version)
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library version for Linux" Maybe Version
verLinuxA Maybe Version
verLinuxB
  [Char] -> Check [[Char]]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the module definition files" [[Char]]
modDefA [[Char]]
modDefB
  ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
buildInfoA BuildInfo
buildInfoB

checkExecutable :: ComponentName -> Check Executable
checkExecutable :: ComponentName -> Check Executable
checkExecutable ComponentName
componentName
                (Executable UnqualComponentName
_nameA [Char]
pathA ExecutableScope
scopeA BuildInfo
buildInfoA)
                (Executable UnqualComponentName
_nameB [Char]
pathB ExecutableScope
scopeB BuildInfo
buildInfoB) = do
  [Char] -> Check [Char]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change build information" [Char]
pathA [Char]
pathB
  [Char] -> Check ExecutableScope
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change executable scope" ExecutableScope
scopeA ExecutableScope
scopeB
  ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
buildInfoA BuildInfo
buildInfoB

checkTestSuite :: ComponentName -> Check TestSuite
checkTestSuite :: ComponentName -> Check TestSuite
checkTestSuite ComponentName
componentName
#if MIN_VERSION_Cabal(3,7,0)
               (TestSuite UnqualComponentName
_nameA TestSuiteInterface
interfaceA BuildInfo
buildInfoA [[Char]]
testGeneratorsA)
               (TestSuite UnqualComponentName
_nameB TestSuiteInterface
interfaceB BuildInfo
buildInfoB [[Char]]
testGeneratorsB)
#else
               (TestSuite _nameA interfaceA buildInfoA)
               (TestSuite _nameB interfaceB buildInfoB)
#endif
  = do
  [Char] -> Check TestSuiteInterface
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change test-suite type" TestSuiteInterface
interfaceA TestSuiteInterface
interfaceB
  ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
buildInfoA BuildInfo
buildInfoB
#if MIN_VERSION_Cabal(3,7,0)
  -- @test-generators@
  [Char] -> Check [[Char]]
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change test-generators" [[Char]]
testGeneratorsA [[Char]]
testGeneratorsB
#endif

checkBenchmark :: ComponentName -> Check Benchmark
checkBenchmark :: ComponentName -> Check Benchmark
checkBenchmark ComponentName
componentName
               (Benchmark UnqualComponentName
_nameA BenchmarkInterface
interfaceA BuildInfo
buildInfoA)
               (Benchmark UnqualComponentName
_nameB BenchmarkInterface
interfaceB BuildInfo
buildInfoB) = do
  [Char] -> Check BenchmarkInterface
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change benchmark type" BenchmarkInterface
interfaceA BenchmarkInterface
interfaceB
  ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
buildInfoA BuildInfo
buildInfoB

checkBuildInfo :: ComponentName -> Check BuildInfo
checkBuildInfo :: ComponentName -> Check BuildInfo
checkBuildInfo ComponentName
componentName BuildInfo
biA BuildInfo
biB = do
    -- @other-extension@
    [Char] -> (Extension -> [Char]) -> Check (Set Extension)
forall a. Ord a => [Char] -> (a -> [Char]) -> Check (Set a)
changesOkSet ([Char]
"'other-extensions' in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ComponentName -> [Char]
showComponentName ComponentName
componentName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" component")
              Extension -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow
              ([Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList ([Extension] -> Set Extension) -> [Extension] -> Set Extension
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
otherExtensions BuildInfo
biA) ([Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList ([Extension] -> Set Extension) -> [Extension] -> Set Extension
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
otherExtensions BuildInfo
biB)

    -- @buildable@
    [Char] -> (Bool -> [Char]) -> Check Bool
forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"'buildable' in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ComponentName -> [Char]
showComponentName ComponentName
componentName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" component") Bool -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow
              (BuildInfo -> Bool
buildable BuildInfo
biA) (BuildInfo -> Bool
buildable BuildInfo
biB)

    -- @build-tool-depends@
    ComponentName -> Check [ExeDependency]
forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName
        (BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
biA)
        (BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
biB)

    -- @build-tools@
    ComponentName -> Check [LegacyExeDependency]
forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName
        (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
biA)
        (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
biB)

    -- @pkgconfig-depends@
    ComponentName -> Check [PkgconfigDependency]
forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName
        (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends BuildInfo
biA)
        (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends BuildInfo
biB)

    [Char] -> Check BuildInfo
forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change build information (just the dependency version constraints)"
              (BuildInfo
biA { targetBuildDepends = [], otherExtensions = [], buildTools = [], buildToolDepends = [], pkgconfigDepends = [], buildable = True })
              (BuildInfo
biB { targetBuildDepends = [], otherExtensions = [], buildTools = [], buildToolDepends = [], pkgconfigDepends = [], buildable = True })

changesOk' :: Eq a => Severity -> String -> (a -> String) -> Check a
changesOk' :: forall a. Eq a => Severity -> [Char] -> (a -> [Char]) -> Check a
changesOk' Severity
rel [Char]
what a -> [Char]
render a
a a
b
  | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b    = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
rel [Char]
what (a -> [Char]
render a
a) (a -> [Char]
render a
b))

changesOk :: Eq a => String -> (a -> String) -> Check a
changesOk :: forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk = Severity -> [Char] -> (a -> [Char]) -> Check a
forall a. Eq a => Severity -> [Char] -> (a -> [Char]) -> Check a
changesOk' Severity
Normal

changesOkList :: (String -> (a -> String) -> Check a)
              -> String -> (a -> String) -> Check [a]
changesOkList :: forall a.
([Char] -> (a -> [Char]) -> Check a)
-> [Char] -> (a -> [Char]) -> Check [a]
changesOkList [Char] -> (a -> [Char]) -> Check a
changesOkElem [Char]
what a -> [Char]
render = [a] -> [a] -> CheckM ()
go
  where
    go :: [a] -> [a] -> CheckM ()
go []     []     = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (a
a:[a]
_)  []     = Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"removed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what) (a -> [Char]
render a
a) [Char]
"")
    go []     (a
b:[a]
_)  = Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"added "   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what) [Char]
"" (a -> [Char]
render a
b))
    go (a
a:[a]
as) (a
b:[a]
bs) = [Char] -> (a -> [Char]) -> Check a
changesOkElem [Char]
what a -> [Char]
render a
a a
b CheckM () -> CheckM () -> CheckM ()
forall a b. CheckM a -> CheckM b -> CheckM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> [a] -> CheckM ()
go [a]
as [a]
bs

changesOkSet :: Ord a => String -> (a -> String) -> Check (Set.Set a)
changesOkSet :: forall a. Ord a => [Char] -> (a -> [Char]) -> Check (Set a)
changesOkSet [Char]
what a -> [Char]
render Set a
old Set a
new = do
    Bool -> CheckM () -> CheckM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
removed) (CheckM () -> CheckM ()) -> CheckM () -> CheckM ()
forall a b. (a -> b) -> a -> b
$
        Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"removed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what) (Set a -> [Char]
renderSet Set a
removed) [Char]
"")
    Bool -> CheckM () -> CheckM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
added) (CheckM () -> CheckM ()) -> CheckM () -> CheckM ()
forall a b. (a -> b) -> a -> b
$
        Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"added " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what) [Char]
"" (Set a -> [Char]
renderSet Set a
added))
    () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    added :: Set a
added   = Set a
new Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
old
    removed :: Set a
removed = Set a
old Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
new
    renderSet :: Set a -> [Char]
renderSet = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> (Set a -> [[Char]]) -> Set a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
render ([a] -> [[Char]]) -> (Set a -> [a]) -> Set a -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList


-- | Single-quote-wrapping 'prettyShow'
prettyShow'' :: Pretty a => a -> String
prettyShow'' :: forall a. Pretty a => a -> [Char]
prettyShow'' a
x = [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"

checkSame :: Eq a => String -> Check a
checkSame :: forall a. Eq a => [Char] -> Check a
checkSame [Char]
msg a
x a
y | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  | Bool
otherwise = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg

checkList :: String -> Check a -> Check [a]
checkList :: forall a. [Char] -> Check a -> Check [a]
checkList [Char]
_   Check a
_         []     []     = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkList [Char]
msg Check a
checkElem (a
x:[a]
xs) (a
y:[a]
ys) = Check a
checkElem a
x a
y
                                     CheckM () -> CheckM () -> CheckM ()
forall a b. CheckM a -> CheckM b -> CheckM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Check a -> Check [a]
forall a. [Char] -> Check a -> Check [a]
checkList [Char]
msg Check a
checkElem [a]
xs [a]
ys
checkList [Char]
msg Check a
_         [a]
_      [a]
_      = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg

checkListAssoc :: Eq b => String -> Check a -> Check [(b,a)]
checkListAssoc :: forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
_   Check a
_         [] [] = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkListAssoc [Char]
msg Check a
checkElem ((b
kx,a
x):[(b, a)]
xs) ((b
ky,a
y):[(b, a)]
ys)
                       | b
kx b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
ky  = Check a
checkElem a
x a
y
                                  CheckM () -> CheckM () -> CheckM ()
forall a b. CheckM a -> CheckM b -> CheckM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Check a -> Check [(b, a)]
forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
msg Check a
checkElem [(b, a)]
xs [(b, a)]
ys
                       | Bool
otherwise = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg
checkListAssoc [Char]
msg Check a
_         [(b, a)]
_  [(b, a)]
_  = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg

checkNotPresent :: String -> Check (Maybe String)
checkNotPresent :: [Char] -> Check (Maybe [Char])
checkNotPresent [Char]
msg Maybe [Char]
_ (Just [Char]
_) = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg
checkNotPresent [Char]
_ Maybe [Char]
_ Maybe [Char]
Nothing = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkMaybe :: String -> Check a -> Check (Maybe a)
checkMaybe :: forall a. [Char] -> Check a -> Check (Maybe a)
checkMaybe [Char]
_   Check a
_     Maybe a
Nothing  Maybe a
Nothing  = () -> CheckM ()
forall a. a -> CheckM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkMaybe [Char]
_   Check a
check (Just a
x) (Just a
y) = Check a
check a
x a
y
checkMaybe [Char]
msg Check a
_     Maybe a
_        Maybe a
_        = [Char] -> CheckM ()
forall a. [Char] -> CheckM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg

ppTestedWith :: [(CompilerFlavor, VersionRange)] -> Doc
ppTestedWith :: [(CompilerFlavor, VersionRange)] -> Doc
ppTestedWith = [Doc] -> Doc
hsep ([Doc] -> Doc)
-> ([(CompilerFlavor, VersionRange)] -> [Doc])
-> [(CompilerFlavor, VersionRange)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
colon ([Doc] -> [Doc])
-> ([(CompilerFlavor, VersionRange)] -> [Doc])
-> [(CompilerFlavor, VersionRange)]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CompilerFlavor, VersionRange) -> Doc)
-> [(CompilerFlavor, VersionRange)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((CompilerFlavor -> VersionRange -> Doc)
-> (CompilerFlavor, VersionRange) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CompilerFlavor -> VersionRange -> Doc
forall {a} {a}. (Pretty a, Pretty a) => a -> a -> Doc
ppPair)
  where
    ppPair :: a -> a -> Doc
ppPair a
compiler a
vr = [Char] -> Doc
text (a -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow a
compiler) Doc -> Doc -> Doc
<+> [Char] -> Doc
text (a -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow a
vr)

ppSourceRepo :: SourceRepo -> PrettyField ()
ppSourceRepo :: SourceRepo -> PrettyField ()
ppSourceRepo SourceRepo
repo = () -> FieldName -> [Doc] -> [PrettyField ()] -> PrettyField ()
forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"source-repository" [RepoKind -> Doc
forall a. Pretty a => a -> Doc
pretty RepoKind
kind] ([PrettyField ()] -> PrettyField ())
-> [PrettyField ()] -> PrettyField ()
forall a b. (a -> b) -> a -> b
$
    CabalSpecVersion
-> PrettyFieldGrammar SourceRepo SourceRepo
-> SourceRepo
-> [PrettyField ()]
forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
cabalSpecLatest (RepoKind -> PrettyFieldGrammar SourceRepo SourceRepo
forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g SourceRepo),
 c (Identity RepoType), c Token, c FilePathNT) =>
RepoKind -> g SourceRepo SourceRepo
sourceRepoFieldGrammar RepoKind
kind) SourceRepo
repo
  where
    kind :: RepoKind
kind = SourceRepo -> RepoKind
repoKind SourceRepo
repo

-- TODO: Verify that we don't need to worry about UTF8
-- | Insert or update \"x-revision:\" field
insertRevisionField :: Int -> ByteString -> ByteString
insertRevisionField :: Int -> ByteString -> ByteString
insertRevisionField Int
rev
    | Int
rev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  = [ByteString] -> ByteString
LBS8.unlines ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
insertAfterVersion ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS8.lines
    | Bool
otherwise = [ByteString] -> ByteString
LBS8.unlines ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
replaceRevision    ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS8.lines
  where
    replaceRevision :: [ByteString] -> [ByteString]
replaceRevision [] = []
    replaceRevision (ByteString
ln:[ByteString]
lns)
      | ByteString -> ByteString -> Bool
isField ([Char] -> ByteString
LBS8.pack [Char]
"x-revision") ByteString
ln
      = [Char] -> ByteString
LBS8.pack ([Char]
"x-revision: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rev) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
lns

      | Bool
otherwise
      = ByteString
ln ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
replaceRevision [ByteString]
lns

    insertAfterVersion :: [ByteString] -> [ByteString]
insertAfterVersion [] = []
    insertAfterVersion (ByteString
ln:[ByteString]
lns)
      | ByteString -> ByteString -> Bool
isField ([Char] -> ByteString
LBS8.pack [Char]
"version") ByteString
ln
      = ByteString
ln ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [Char] -> ByteString
LBS8.pack ([Char]
"x-revision: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rev) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
lns

      | Bool
otherwise
      = ByteString
ln ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
insertAfterVersion [ByteString]
lns

    isField :: ByteString -> ByteString -> Bool
isField ByteString
nm ByteString
ln
      | ByteString -> ByteString -> Bool
LBS8.isPrefixOf ByteString
nm ((Char -> Char) -> ByteString -> ByteString
LBS8.map Char -> Char
Char.toLower ByteString
ln)
      , let (ByteString
_, ByteString
t) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
LBS8.span (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')
                             (Int64 -> ByteString -> ByteString
LBS8.drop (ByteString -> Int64
LBS8.length ByteString
nm) ByteString
ln)
      , Just (Char
':',ByteString
_) <- ByteString -> Maybe (Char, ByteString)
LBS8.uncons ByteString
t
                  = Bool
True
      | Bool
otherwise = Bool
False