{-# 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  :  libraries@haskell.org
-- 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 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 -> 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
<$ :: forall a b. a -> CheckM b -> CheckM a
$c<$ :: forall a b. a -> CheckM b -> CheckM a
fmap :: forall a b. (a -> b) -> CheckM a -> CheckM b
$cfmap :: forall a b. (a -> b) -> CheckM a -> CheckM b
Functor, Functor 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
<* :: forall a b. CheckM a -> CheckM b -> CheckM a
$c<* :: forall a b. CheckM a -> CheckM b -> CheckM a
*> :: forall a b. CheckM a -> CheckM b -> CheckM b
$c*> :: forall a b. CheckM a -> CheckM b -> CheckM b
liftA2 :: forall a b c. (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c
$cliftA2 :: forall a b c. (a -> b -> c) -> CheckM a -> CheckM b -> CheckM c
<*> :: forall a b. CheckM (a -> b) -> CheckM a -> CheckM b
$c<*> :: forall a b. CheckM (a -> b) -> CheckM a -> CheckM b
pure :: forall a. a -> CheckM a
$cpure :: forall a. a -> CheckM a
Applicative)

runCheck :: CheckM () -> Either String [Change]
runCheck :: CheckM () -> Either [Char] [Change]
runCheck CheckM ()
c = case forall w a. Writer w a -> (a, w)
runWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CheckM a -> ExceptT [Char] (Writer [Change]) a
unCheckM forall a b. (a -> b) -> a -> b
$ CheckM ()
c of
               (Left [Char]
err, [Change]
_      ) -> forall a b. a -> Either a b
Left [Char]
err
               (Right (), [Change]
changes)
                 | forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Change -> Severity
changeSeverity [Change]
changes forall a. Eq a => a -> a -> Bool
/= Severity
Trivial -> forall a b. b -> Either a b
Right [Change]
changes
                 | Bool
otherwise ->
                   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         = 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 = forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM (ExceptT [Char] (Writer [Change]) a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. CheckM a -> ExceptT [Char] (Writer [Change]) a
unCheckM 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           = forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq, Eq 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
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$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
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
Ord, Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> [Char]
$cshow :: Severity -> [Char]
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show, Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [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
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum, Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: 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 = forall a. Semigroup a => a -> a -> a
(S.<>)

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



logChange :: Change -> CheckM ()
logChange :: Change -> CheckM ()
logChange Change
change = forall a. ExceptT [Char] (Writer [Change]) a -> CheckM a
CheckM (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
    (GenericPackageDescription
pkg,  [PWarning]
warns)  <- forall {m :: * -> *}.
MonadFail m =>
FieldName -> m (GenericPackageDescription, [PWarning])
parseCabalFile FieldName
old
    (GenericPackageDescription
pkg', [PWarning]
warns') <- forall {m :: * -> *}.
MonadFail m =>
FieldName -> m (GenericPackageDescription, [PWarning])
parseCabalFile FieldName
new

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

    Bool -> Check GenericPackageDescription
checkGenericPackageDescription Bool
checkXRevision GenericPackageDescription
pkg GenericPackageDescription
pkg'
    [Char] -> Check [PWarning]
checkParserWarnings [Char]
filename [PWarning]
warns [PWarning]
warns'
    Check GenericPackageDescription
checkPackageChecks  GenericPackageDescription
pkg   GenericPackageDescription
pkg'

  where
    parseCabalFile :: FieldName -> m (GenericPackageDescription, [PWarning])
parseCabalFile FieldName
fileContent =
      case forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult forall a b. (a -> b) -> a -> b
$ FieldName -> ParseResult GenericPackageDescription
parseGenericPackageDescription FieldName
fileContent of
        ([PWarning]
warnings,  Right GenericPackageDescription
pkg) -> forall (m :: * -> *) a. Monad m => a -> m a
return (GenericPackageDescription
pkg, [PWarning]
warnings)
        ([PWarning]
_warnings, Left (Maybe Version
_mver, NonEmpty PError
errs)) -> do
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty PError
errs forall a b. (a -> b) -> a -> b
$ \PError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> PError -> [Char]
showPError [Char]
"-" PError
err)
            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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== PWarnType
t' Bool -> Bool -> Bool
&& [Char]
s 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 forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
differenceBy PWarning -> PWarning -> Bool
eqPWarning [PWarning]
warns' [PWarning]
warns of
        []       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [PWarning]
newwarns -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"New parse warning: "
                        forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines (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
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
pkg  forall a. Maybe a
Nothing
          checks' :: [PackageCheck]
checks' = GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
pkg' forall a. Maybe a
Nothing
       in case [PackageCheck]
checks' forall a. Eq a => [a] -> [a] -> [a]
\\ [PackageCheck]
checks of
            []        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            [PackageCheck]
newchecks -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines (forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> [Char]
ppPackageCheck [PackageCheck]
newchecks)
#if !MIN_VERSION_Cabal(3,9,0)
      where ppPackageCheck :: PackageCheck -> [Char]
ppPackageCheck = PackageCheck -> [Char]
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

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

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

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

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

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

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

    forall b a. Eq b => [Char] -> Check a -> Check [(b, a)]
checkListAssoc [Char]
"Cannot add or remove benchmark sections"
      (forall a.
(ComponentName -> Check a)
-> Check (ComponentName, CondTree ConfVar [Dependency] a)
checkCondTree ComponentName -> Check Benchmark
checkBenchmark)
      (forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CBenchName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benchsA)
      (forall {t} {a} {b}. (t -> a) -> (t, b) -> (t, (a, b))
withComponentName UnqualComponentName -> ComponentName
CBenchName 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)
    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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageFlag -> Bool
flagManual PackageFlag
flagOld) forall a b. (a -> b) -> a -> b
$ do
        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)

        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)

    forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"type of flag '" forall a. [a] -> [a] -> [a]
++ [Char]
fname 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)

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

    forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"description of flag '" forall a. [a] -> [a] -> [a]
++ [Char]
fname forall a. [a] -> [a] -> [a]
++ [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
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Don't be silly! You can't change the package name!"
            (forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
packageIdA) (forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
packageIdB)
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"You can't change the package version!"
            (forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
packageIdA) (forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
packageIdB)
  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)
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"copyright"  ShortText -> [Char]
fromShortText ShortText
copyrightA ShortText
copyrightB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"maintainer" ShortText -> [Char]
fromShortText ShortText
maintainerA ShortText
maintainerB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"author"     ShortText -> [Char]
fromShortText ShortText
authorA ShortText
authorB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"The stability field is unused, don't bother changing it."
            ShortText
stabilityA ShortText
stabilityB
  forall a. Eq a => Severity -> [Char] -> (a -> [Char]) -> Check a
changesOk' Severity
Trivial [Char]
"tested-with" (forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CompilerFlavor, VersionRange)] -> Doc
ppTestedWith) [(CompilerFlavor, VersionRange)]
testedWithA [(CompilerFlavor, VersionRange)]
testedWithB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"homepage" ShortText -> [Char]
fromShortText ShortText
homepageA ShortText
homepageB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"The package-url field is unused, don't bother changing it."
            ShortText
pkgUrlA ShortText
pkgUrlB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"bug-reports" ShortText -> [Char]
fromShortText ShortText
bugReportsA ShortText
bugReportsB
  forall a.
([Char] -> (a -> [Char]) -> Check a)
-> [Char] -> (a -> [Char]) -> Check [a]
changesOkList forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"source-repository" (forall ann. (ann -> [[Char]]) -> [PrettyField ann] -> [Char]
showFields forall {p} {a}. p -> [a]
noComment forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepo -> PrettyField ()
ppSourceRepo)
            [SourceRepo]
sourceReposA [SourceRepo]
sourceReposB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"synopsis"    ShortText -> [Char]
fromShortText ShortText
synopsisA ShortText
synopsisB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"description" ShortText -> [Char]
fromShortText ShortText
descriptionA ShortText
descriptionB
  forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk [Char]
"category"    ShortText -> [Char]
fromShortText ShortText
categoryA ShortText
categoryB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the build-type"
            Maybe BuildType
buildTypeRawA Maybe BuildType
buildTypeRawB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the data files"
            ([[Char]]
dataFilesA, [Char]
dataDirA) ([[Char]]
dataFilesB, [Char]
dataDirB)
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Changing extra-tmp-files is a bit pointless at this stage"
            [[Char]]
extraTmpFilesA [[Char]]
extraTmpFilesB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Changing extra-source-files would not make sense!"
            [[Char]]
extraSrcFilesA [[Char]]
extraSrcFilesB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"You can't change the extra-doc-files."
            [[Char]]
extraDocFilesA [[Char]]
extraDocFilesB

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

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkXRevision 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 _ = NoComment
#else
    noComment :: p -> [a]
noComment p
_ = []
#endif

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

  | Bool
otherwise
  = 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 forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
v Bool -> Bool -> Bool
&& CabalSpecVersion
v 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 =
    forall a. Eq a => [Char] -> Check a
checkSame ([Char]
"The new x-revision must be " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
expectedRevision)
              Int
newRevision Int
expectedRevision
  where
    oldRevision :: Int
oldRevision = forall {a}. (Eq a, IsString a) => [(a, [Char])] -> Int
getRevision [([Char], [Char])]
customFieldsA
    newRevision :: Int
newRevision = forall {a}. (Eq a, IsString a) => [(a, [Char])] -> Int
getRevision [([Char], [Char])]
customFieldsB
    expectedRevision :: Int
expectedRevision = Int
oldRevision forall a. Num a => a -> a -> a
+ Int
1

    getRevision :: [(a, [Char])] -> Int
getRevision [(a, [Char])]
customFields =
      case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"x-revision" [(a, [Char])]
customFields of
        Just [Char]
s  | [(Int
n,[Char]
"")] <- 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 = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"x-curation" [([Char], [Char])]
customFieldsA
    newCuration :: Maybe [Char]
newCuration = 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
      forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName [Dependency]
constraintsA [Dependency]
constraintsB
      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
      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
      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
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [d]
removed forall a b. (a -> b) -> a -> b
$ \d
dep -> do
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([[Char]] -> [Char]
unwords [ [Char]
"Cannot remove existing", [Char]
depKind, [Char]
"on"
                      , forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy (forall vr d. IsDependency vr d => d -> DepKey d
depKey d
dep), [Char]
"in", [Char]
cnameStr, [Char]
" component"])

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [d]
added forall a b. (a -> b) -> a -> b
$ \d
dep ->
        if 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]
"" (forall a. Pretty a => a -> [Char]
prettyShow d
dep))
           else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([[Char]] -> [Char]
unwords [ [Char]
"Cannot add new", [Char]
depKind, [Char]
"on"
                              , forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy (forall vr d. IsDependency vr d => d -> DepKey d
depKey d
dep)
                              , [Char]
"in", [Char]
cnameStr, [Char]
"component"])

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(DepKey d, (vr, vr))]
changed forall a b. (a -> b) -> a -> b
$ \(DepKey d
depk, (vr
verA, vr
verB)) -> do
        forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([[Char]] -> [Char]
unwords [[Char]
"the", [Char]
cnameStr, [Char]
"component's", [Char]
depKind, [Char]
"on"
                           , forall vr d. IsDependency vr d => Proxy d -> DepKey d -> [Char]
depKeyShow Proxy d
dproxy DepKey d
depk])
                   forall a. Pretty a => a -> [Char]
prettyShow vr
verA vr
verB
  where
    ([d]
removed, [(DepKey d, (vr, vr))]
changed, [d]
added) = 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 = forall {k} (t :: k). Proxy t
Proxy

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

    depKind :: [Char]
depKind = forall vr d. IsDependency vr d => Proxy d -> [Char]
depTypeName Proxy d
dproxy 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
pkgname
    depKeyShow :: Proxy Dependency -> DepKey Dependency -> [Char]
depKeyShow Proxy Dependency
Proxy              = 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 DepKey Dependency
n VersionRange
vr NonEmptySet LibraryName
mainLibSet

    depInAddWhitelist :: Dependency -> Bool
depInAddWhitelist (Dependency PackageName
pn VersionRange
_ NonEmptySet LibraryName
_) = PackageName
pn 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)       = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"'", forall a. Pretty a => a -> [Char]
prettyShow PackageName
pkgname, [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]
tname
    depKeyShow :: Proxy LegacyExeDependency -> DepKey LegacyExeDependency -> [Char]
depKeyShow Proxy LegacyExeDependency
Proxy DepKey LegacyExeDependency
tname                 = [Char]
"'" forall a. [a] -> [a] -> [a]
++ DepKey LegacyExeDependency
tname 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
LegacyExeDependency

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

    depInAddWhitelist :: LegacyExeDependency -> Bool
depInAddWhitelist (LegacyExeDependency [Char]
pn VersionRange
_) = [Char]
pn 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
pkgname
    depKeyShow :: Proxy PkgconfigDependency -> DepKey PkgconfigDependency -> [Char]
depKeyShow Proxy PkgconfigDependency
Proxy                       = 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
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 forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` Map (DepKey d) vr
b)
      , forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ 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 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
        = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall vr d. IsDependency vr d => Proxy d -> vr -> vr -> vr
intersectVr (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          forall a b. (a -> b) -> [a] -> [b]
map (\d
d -> (forall vr d. IsDependency vr d => d -> DepKey d
depKey d
d, forall vr d. IsDependency vr d => d -> vr
depVerRg d
d))

    mapToDeps :: Map (DepKey d) vr -> [d]
mapToDeps
        = forall a b. (a -> b) -> [a] -> [b]
map (\(DepKey d
pkgname, vr
verrange) -> forall vr d. IsDependency vr d => DepKey d -> vr -> d
reconstructDep DepKey d
pkgname vr
verrange) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkSetupBuildInfo (Just SetupBuildInfo
_) Maybe SetupBuildInfo
Nothing =
    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 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]" (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> [Char]
prettyShow [Dependency]
setupDependsA))

checkSetupBuildInfo (Just (SetupBuildInfo [Dependency]
setupDependsA Bool
_internalA))
                    (Just (SetupBuildInfo [Dependency]
setupDependsB Bool
_internalB)) = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Dependency]
removed forall a b. (a -> b) -> a -> b
$ \Dependency
dep ->
      Change -> CheckM ()
logChange forall a b. (a -> b) -> a -> b
$ Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal [Char]
"removed 'custom-setup' dependency on" (forall a. Pretty a => a -> [Char]
prettyShow Dependency
dep) [Char]
""
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Dependency]
added forall a b. (a -> b) -> a -> b
$ \Dependency
dep ->
      Change -> CheckM ()
logChange forall a b. (a -> b) -> a -> b
$ Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal [Char]
"added 'custom-setup' dependency on" [Char]
"" (forall a. Pretty a => a -> [Char]
prettyShow Dependency
dep)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(DepKey Dependency, (VersionRange, VersionRange))]
changed forall a b. (a -> b) -> a -> b
$ \(PackageName
pkgn, (VersionRange
verA, VersionRange
verB)) ->
        forall a. Eq a => [Char] -> (a -> [Char]) -> Check a
changesOk ([Char]
"the 'custom-setup' dependency on " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow'' PackageName
pkgn)
                  forall a. Pretty a => a -> [Char]
prettyShow VersionRange
verA VersionRange
verB
  where
    ([Dependency]
removed, [(DepKey Dependency, (VersionRange, VersionRange))]
changed, [Dependency]
added) =
      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
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the exposed modules" LibraryName
modulesA LibraryName
modulesB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the re-exported modules" [ModuleName]
reexportedA [ModuleName]
reexportedB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the required signatures" [ModuleReexport]
requiredSigsA [ModuleReexport]
requiredSigsB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the exposed signatures"  [ModuleName]
exposedSigsA  [ModuleName]
exposedSigsB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the package exposed status" Bool
exposedA Bool
exposedB
  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
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library name" UnqualComponentName
nameA UnqualComponentName
nameB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library type" ForeignLibType
typeA ForeignLibType
typeB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library options" [ForeignLibOption]
optionsA [ForeignLibOption]
optionsB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library version" Maybe LibVersionInfo
verA Maybe LibVersionInfo
verB
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change the foreign library version for Linux" Maybe Version
verLinuxA Maybe Version
verLinuxB
  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
  forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change build information" [Char]
pathA [Char]
pathB
  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 _nameA interfaceA buildInfoA testGeneratorsA)
               (TestSuite _nameB interfaceB buildInfoB testGeneratorsB)
#else
               (TestSuite UnqualComponentName
_nameA TestSuiteInterface
interfaceA BuildInfo
buildInfoA)
               (TestSuite UnqualComponentName
_nameB TestSuiteInterface
interfaceB BuildInfo
buildInfoB)
#endif
  = do
  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@
  checkSame "Cannot change test-generators" testGeneratorsA 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
  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@
    forall a. Ord a => [Char] -> (a -> [Char]) -> Check (Set a)
changesOkSet ([Char]
"'other-extensions' in " forall a. [a] -> [a] -> [a]
++ ComponentName -> [Char]
showComponentName ComponentName
componentName forall a. [a] -> [a] -> [a]
++ [Char]
" component")
              forall a. Pretty a => a -> [Char]
prettyShow
              (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
otherExtensions BuildInfo
biA) (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
otherExtensions BuildInfo
biB)

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

    -- @build-tool-depends@
    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@
    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@
    forall d vr.
(Pretty d, IsDependency vr d) =>
ComponentName -> Check [d]
checkDependencies ComponentName
componentName
        (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends BuildInfo
biA)
        (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends BuildInfo
biB)

    forall a. Eq a => [Char] -> Check a
checkSame [Char]
"Cannot change build information (just the dependency version constraints)"
              (BuildInfo
biA { targetBuildDepends :: [Dependency]
targetBuildDepends = [], otherExtensions :: [Extension]
otherExtensions = [], buildTools :: [LegacyExeDependency]
buildTools = [], buildToolDepends :: [ExeDependency]
buildToolDepends = [], pkgconfigDepends :: [PkgconfigDependency]
pkgconfigDepends = [], buildable :: Bool
buildable = Bool
True })
              (BuildInfo
biB { targetBuildDepends :: [Dependency]
targetBuildDepends = [], otherExtensions :: [Extension]
otherExtensions = [], buildTools :: [LegacyExeDependency]
buildTools = [], buildToolDepends :: [ExeDependency]
buildToolDepends = [], pkgconfigDepends :: [PkgconfigDependency]
pkgconfigDepends = [], buildable :: Bool
buildable = Bool
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 forall a. Eq a => a -> a -> Bool
== a
b    = 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 = 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 []     []     = 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 " 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 "   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 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set a
removed) forall a b. (a -> b) -> a -> b
$
        Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"removed " forall a. [a] -> [a] -> [a]
++ [Char]
what) (Set a -> [Char]
renderSet Set a
removed) [Char]
"")
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set a
added) forall a b. (a -> b) -> a -> b
$
        Change -> CheckM ()
logChange (Severity -> [Char] -> [Char] -> [Char] -> Change
Change Severity
Normal ([Char]
"added " forall a. [a] -> [a] -> [a]
++ [Char]
what) [Char]
"" (Set a -> [Char]
renderSet Set a
added))
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    added :: Set a
added   = Set a
new forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
old
    removed :: Set a
removed = Set a
old forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
new
    renderSet :: Set a -> [Char]
renderSet = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
"'" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow a
x 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 forall a. Eq a => a -> a -> Bool
== a
y    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  | Bool
otherwise = 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
_         []     []     = 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
                                     forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [Char] -> Check a -> Check [a]
checkList [Char]
msg Check a
checkElem [a]
xs [a]
ys
checkList [Char]
msg Check a
_         [a]
_      [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
_         [] [] = 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 forall a. Eq a => a -> a -> Bool
== b
ky  = Check a
checkElem a
x a
y
                                  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg
checkListAssoc [Char]
msg Check a
_         [(b, a)]
_  [(b, 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]
_) = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg
checkNotPresent [Char]
_ Maybe [Char]
_ Maybe [Char]
Nothing = 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  = 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
_        = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
msg

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

ppSourceRepo :: SourceRepo -> PrettyField ()
ppSourceRepo :: SourceRepo -> PrettyField ()
ppSourceRepo SourceRepo
repo = forall ann.
ann -> FieldName -> [Doc] -> [PrettyField ann] -> PrettyField ann
PrettySection () FieldName
"source-repository" [forall a. Pretty a => a -> Doc
pretty RepoKind
kind] forall a b. (a -> b) -> a -> b
$
    forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
cabalSpecLatest (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 forall a. Eq a => a -> a -> Bool
== Int
1  = [ByteString] -> ByteString
LBS8.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
insertAfterVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS8.lines
    | Bool
otherwise = [ByteString] -> ByteString
LBS8.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
replaceRevision    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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
rev) forall a. a -> [a] -> [a]
: [ByteString]
lns

      | Bool
otherwise
      = ByteString
ln 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 forall a. a -> [a] -> [a]
: [Char] -> ByteString
LBS8.pack ([Char]
"x-revision: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
rev) forall a. a -> [a] -> [a]
: [ByteString]
lns

      | Bool
otherwise
      = ByteString
ln 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 forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c 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