{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Distribution.PackageDescription.Check.Conditional
-- Copyright   :  Lennart Kolmodin 2008, Francesco Ariis 2023
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Checks on conditional targets (libraries, executables, etc. that are
-- still inside a CondTree and related checks that can only be performed
-- here (variables, duplicated modules).
module Distribution.PackageDescription.Check.Conditional
  ( checkCondTarget
  , checkDuplicateModules
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compiler
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check.Monad
import Distribution.System

import qualified Data.Map as Map

import Control.Monad

-- As a prerequisite to some checks, we transform a target CondTree into
-- a CondTree of “target + useful context”.
-- This is slightly clearer, is easier to walk without resorting to
-- list comprehensions, allows us in the future to apply some sensible
-- “optimisations” to checks (exclusive branches, etc.).

-- | @nf@ function is needed to appropriately name some targets which need
-- to be spoonfed (otherwise name appears as "").
initTargetAnnotation
  :: Monoid a
  => (UnqualComponentName -> a -> a) -- Naming function for targets.
  -> UnqualComponentName
  -> TargetAnnotation a
initTargetAnnotation :: forall a.
Monoid a =>
(UnqualComponentName -> a -> a)
-> UnqualComponentName -> TargetAnnotation a
initTargetAnnotation UnqualComponentName -> a -> a
nf UnqualComponentName
n = a -> Bool -> TargetAnnotation a
forall a. a -> Bool -> TargetAnnotation a
TargetAnnotation (UnqualComponentName -> a -> a
nf UnqualComponentName
n a
forall a. Monoid a => a
mempty) Bool
False

-- | We “build up” target from various slices.
updateTargetAnnotation
  :: Monoid a
  => a -- A target (lib, exe, test, …)
  -> TargetAnnotation a
  -> TargetAnnotation a
updateTargetAnnotation :: forall a. Monoid a => a -> TargetAnnotation a -> TargetAnnotation a
updateTargetAnnotation a
t TargetAnnotation a
ta = TargetAnnotation a
ta{taTarget = taTarget ta <> t}

-- | Before walking a target 'CondTree', we need to annotate it with
-- information relevant to the checks (read 'TaraAnn' and 'checkCondTarget'
-- doc for more info).
annotateCondTree
  :: forall a
   . (Eq a, Monoid a)
  => [PackageFlag] -- User flags.
  -> TargetAnnotation a
  -> CondTree ConfVar [Dependency] a
  -> CondTree ConfVar [Dependency] (TargetAnnotation a)
annotateCondTree :: forall a.
(Eq a, Monoid a) =>
[PackageFlag]
-> TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
annotateCondTree [PackageFlag]
fs TargetAnnotation a
ta (CondNode a
a [Dependency]
c [CondBranch ConfVar [Dependency] a]
bs) =
  let ta' :: TargetAnnotation a
ta' = a -> TargetAnnotation a -> TargetAnnotation a
forall a. Monoid a => a -> TargetAnnotation a -> TargetAnnotation a
updateTargetAnnotation a
a TargetAnnotation a
ta
      bs' :: [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs' = (CondBranch ConfVar [Dependency] a
 -> CondBranch ConfVar [Dependency] (TargetAnnotation a))
-> [CondBranch ConfVar [Dependency] a]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
forall a b. (a -> b) -> [a] -> [b]
map (TargetAnnotation a
-> CondBranch ConfVar [Dependency] a
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
annotateBranch TargetAnnotation a
ta') [CondBranch ConfVar [Dependency] a]
bs
      bs'' :: [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs'' = [PackageFlag]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
forall a.
(Eq a, Monoid a) =>
[PackageFlag]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
crossAnnotateBranches [PackageFlag]
defTrueFlags [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs'
   in TargetAnnotation a
-> [Dependency]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode TargetAnnotation a
ta' [Dependency]
c [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs''
  where
    annotateBranch
      :: TargetAnnotation a
      -> CondBranch ConfVar [Dependency] a
      -> CondBranch
          ConfVar
          [Dependency]
          (TargetAnnotation a)
    annotateBranch :: TargetAnnotation a
-> CondBranch ConfVar [Dependency] a
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
annotateBranch TargetAnnotation a
wta (CondBranch Condition ConfVar
k CondTree ConfVar [Dependency] a
t Maybe (CondTree ConfVar [Dependency] a)
mf) =
      let uf :: Bool
uf = Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
k
          wta' :: TargetAnnotation a
wta' = TargetAnnotation a
wta{taPackageFlag = taPackageFlag wta || uf}
          atf :: TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
atf = [PackageFlag]
-> TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
forall a.
(Eq a, Monoid a) =>
[PackageFlag]
-> TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
annotateCondTree [PackageFlag]
fs
       in Condition ConfVar
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch
            Condition ConfVar
k
            (TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
atf TargetAnnotation a
wta' CondTree ConfVar [Dependency] a
t)
            (TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
atf TargetAnnotation a
wta (CondTree ConfVar [Dependency] a
 -> CondTree ConfVar [Dependency] (TargetAnnotation a))
-> Maybe (CondTree ConfVar [Dependency] a)
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree ConfVar [Dependency] a)
mf)
    -- Note how we are passing the *old* wta
    -- in the `else` branch, since we are not
    -- under that flag.

    -- We only want to pick up variables that are flags and that are
    -- \*off* by default.
    isPkgFlagCond :: Condition ConfVar -> Bool
    isPkgFlagCond :: Condition ConfVar -> Bool
isPkgFlagCond (Lit Bool
_) = Bool
False
    isPkgFlagCond (Var (PackageFlag FlagName
f)) = FlagName -> [FlagName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FlagName
f [FlagName]
defOffFlags
    isPkgFlagCond (Var ConfVar
_) = Bool
False
    isPkgFlagCond (CNot Condition ConfVar
cn) = Bool -> Bool
not (Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
cn)
    isPkgFlagCond (CAnd Condition ConfVar
ca Condition ConfVar
cb) = Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
ca Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
cb
    isPkgFlagCond (COr Condition ConfVar
ca Condition ConfVar
cb) = Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
ca Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
isPkgFlagCond Condition ConfVar
cb

    -- Package flags that are off by default *and* that are manual.
    defOffFlags :: [FlagName]
defOffFlags =
      (PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
flagName ([PackageFlag] -> [FlagName]) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> a -> b
$
        (PackageFlag -> Bool) -> [PackageFlag] -> [PackageFlag]
forall a. (a -> Bool) -> [a] -> [a]
filter
          ( \PackageFlag
f ->
              Bool -> Bool
not (PackageFlag -> Bool
flagDefault PackageFlag
f)
                Bool -> Bool -> Bool
&& PackageFlag -> Bool
flagManual PackageFlag
f
          )
          [PackageFlag]
fs

    defTrueFlags :: [PackageFlag]
    defTrueFlags :: [PackageFlag]
defTrueFlags = (PackageFlag -> Bool) -> [PackageFlag] -> [PackageFlag]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageFlag -> Bool
flagDefault [PackageFlag]
fs

-- Propagate contextual information in CondTree branches. This is
-- needed as CondTree is a rosetree and not a binary tree.
crossAnnotateBranches
  :: forall a
   . (Eq a, Monoid a)
  => [PackageFlag] -- `default: true` flags.
  -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
  -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
crossAnnotateBranches :: forall a.
(Eq a, Monoid a) =>
[PackageFlag]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
crossAnnotateBranches [PackageFlag]
fs [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs = (CondBranch ConfVar [Dependency] (TargetAnnotation a)
 -> CondBranch ConfVar [Dependency] (TargetAnnotation a))
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
forall a b. (a -> b) -> [a] -> [b]
map CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
crossAnnBranch [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs
  where
    crossAnnBranch
      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)
      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)
    crossAnnBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
crossAnnBranch CondBranch ConfVar [Dependency] (TargetAnnotation a)
wr =
      let
        rs :: [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
rs = (CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Bool)
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Bool
forall a. Eq a => a -> a -> Bool
/= CondBranch ConfVar [Dependency] (TargetAnnotation a)
wr) [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs
        ts :: [a]
ts = (CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a)
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a
realiseBranch [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
rs
       in
        a
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
updateTargetAnnBranch ([a] -> a
forall a. Monoid a => [a] -> a
mconcat [a]
ts) CondBranch ConfVar [Dependency] (TargetAnnotation a)
wr

    realiseBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a
    realiseBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a
realiseBranch CondBranch ConfVar [Dependency] (TargetAnnotation a)
b =
      let
        -- We are only interested in True by default package flags.
        realiseBranchFunction :: ConfVar -> Either ConfVar Bool
        realiseBranchFunction :: ConfVar -> Either ConfVar Bool
realiseBranchFunction (PackageFlag FlagName
n) | FlagName -> [FlagName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FlagName
n ((PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
flagName [PackageFlag]
fs) = Bool -> Either ConfVar Bool
forall a b. b -> Either a b
Right Bool
True
        realiseBranchFunction ConfVar
_ = Bool -> Either ConfVar Bool
forall a b. b -> Either a b
Right Bool
False
        ms :: Maybe ([Dependency], a)
ms = (ConfVar -> Either ConfVar Bool)
-> CondBranch ConfVar [Dependency] a -> Maybe ([Dependency], a)
forall a d v.
(Semigroup a, Semigroup d) =>
(v -> Either v Bool) -> CondBranch v d a -> Maybe (d, a)
simplifyCondBranch ConfVar -> Either ConfVar Bool
realiseBranchFunction ((TargetAnnotation a -> a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] a
forall a b.
(a -> b)
-> CondBranch ConfVar [Dependency] a
-> CondBranch ConfVar [Dependency] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TargetAnnotation a -> a
forall a. TargetAnnotation a -> a
taTarget CondBranch ConfVar [Dependency] (TargetAnnotation a)
b)
       in
        (([Dependency], a) -> a) -> Maybe ([Dependency], a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Dependency], a) -> a
forall a b. (a, b) -> b
snd Maybe ([Dependency], a)
ms

    updateTargetAnnBranch
      :: a
      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)
      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)
    updateTargetAnnBranch :: a
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
updateTargetAnnBranch a
a (CondBranch Condition ConfVar
k CondTree ConfVar [Dependency] (TargetAnnotation a)
t Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
mt) =
      let updateTargetAnnTree :: CondTree v c (TargetAnnotation a)
-> CondTree v c (TargetAnnotation a)
updateTargetAnnTree (CondNode TargetAnnotation a
ka c
c [CondBranch v c (TargetAnnotation a)]
wbs) =
            (TargetAnnotation a
-> c
-> [CondBranch v c (TargetAnnotation a)]
-> CondTree v c (TargetAnnotation a)
forall v c a. a -> c -> [CondBranch v c a] -> CondTree v c a
CondNode (a -> TargetAnnotation a -> TargetAnnotation a
forall a. Monoid a => a -> TargetAnnotation a -> TargetAnnotation a
updateTargetAnnotation a
a TargetAnnotation a
ka) c
c [CondBranch v c (TargetAnnotation a)]
wbs)
       in Condition ConfVar
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
-> CondBranch ConfVar [Dependency] (TargetAnnotation a)
forall v c a.
Condition v
-> CondTree v c a -> Maybe (CondTree v c a) -> CondBranch v c a
CondBranch Condition ConfVar
k (CondTree ConfVar [Dependency] (TargetAnnotation a)
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
forall {v} {c}.
CondTree v c (TargetAnnotation a)
-> CondTree v c (TargetAnnotation a)
updateTargetAnnTree CondTree ConfVar [Dependency] (TargetAnnotation a)
t) (CondTree ConfVar [Dependency] (TargetAnnotation a)
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
forall {v} {c}.
CondTree v c (TargetAnnotation a)
-> CondTree v c (TargetAnnotation a)
updateTargetAnnTree (CondTree ConfVar [Dependency] (TargetAnnotation a)
 -> CondTree ConfVar [Dependency] (TargetAnnotation a))
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
mt)

-- | A conditional target is a library, exe, benchmark etc., destructured
-- in a CondTree. Traversing method: we render the branches, pass a
-- relevant context, collect checks.
checkCondTarget
  :: forall m a
   . (Monad m, Eq a, Monoid a)
  => [PackageFlag] -- User flags.
  -> (a -> CheckM m ()) -- Check function (a = target).
  -> (UnqualComponentName -> a -> a)
  -- Naming function (some targets
  -- need to have their name
  -- spoonfed to them.
  -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
  -- Target name/condtree.
  -> CheckM m ()
checkCondTarget :: forall (m :: * -> *) a.
(Monad m, Eq a, Monoid a) =>
[PackageFlag]
-> (a -> CheckM m ())
-> (UnqualComponentName -> a -> a)
-> (UnqualComponentName, CondTree ConfVar [Dependency] a)
-> CheckM m ()
checkCondTarget [PackageFlag]
fs a -> CheckM m ()
cf UnqualComponentName -> a -> a
nf (UnqualComponentName
unqualName, CondTree ConfVar [Dependency] a
ct) =
  CondTree ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wTree (CondTree ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ())
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
-> CheckM m ()
forall a b. (a -> b) -> a -> b
$ [PackageFlag]
-> TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
forall a.
(Eq a, Monoid a) =>
[PackageFlag]
-> TargetAnnotation a
-> CondTree ConfVar [Dependency] a
-> CondTree ConfVar [Dependency] (TargetAnnotation a)
annotateCondTree [PackageFlag]
fs ((UnqualComponentName -> a -> a)
-> UnqualComponentName -> TargetAnnotation a
forall a.
Monoid a =>
(UnqualComponentName -> a -> a)
-> UnqualComponentName -> TargetAnnotation a
initTargetAnnotation UnqualComponentName -> a -> a
nf UnqualComponentName
unqualName) CondTree ConfVar [Dependency] a
ct
  where
    -- Walking the tree. Remember that CondTree is not a binary
    -- tree but a /rose/tree.
    wTree
      :: CondTree ConfVar [Dependency] (TargetAnnotation a)
      -> CheckM m ()
    wTree :: CondTree ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wTree (CondNode TargetAnnotation a
ta [Dependency]
_ [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs)
      -- There are no branches ([] == True) *or* every branch
      -- is “simple” (i.e. missing a 'condBranchIfFalse' part).
      -- This is convenient but not necessarily correct in all
      -- cases; a more precise way would be to check incompatibility
      -- among simple branches conditions (or introduce a principled
      -- `cond` construct in `.cabal` files.
      | (CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Bool)
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Bool
isSimple [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs = do
          (CheckCtx m -> CheckCtx m) -> CheckM m () -> CheckM m ()
forall (m :: * -> *).
Monad m =>
(CheckCtx m -> CheckCtx m) -> CheckM m () -> CheckM m ()
localCM (TargetAnnotation a -> CheckCtx m -> CheckCtx m
forall (m :: * -> *) a.
Monad m =>
TargetAnnotation a -> CheckCtx m -> CheckCtx m
initCheckCtx TargetAnnotation a
ta) (a -> CheckM m ()
cf (a -> CheckM m ()) -> a -> CheckM m ()
forall a b. (a -> b) -> a -> b
$ TargetAnnotation a -> a
forall a. TargetAnnotation a -> a
taTarget TargetAnnotation a
ta)
          (CondBranch ConfVar [Dependency] (TargetAnnotation a)
 -> CheckM m ())
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CondBranch ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wBranch [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs
      -- If there are T/F conditions, there is no need to check
      -- the intermediate 'TargetAnnotation' too.
      | Bool
otherwise = do
          (CondBranch ConfVar [Dependency] (TargetAnnotation a)
 -> CheckM m ())
-> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
-> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CondBranch ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wBranch [CondBranch ConfVar [Dependency] (TargetAnnotation a)]
bs

    isSimple
      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)
      -> Bool
    isSimple :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Bool
isSimple (CondBranch Condition ConfVar
_ CondTree ConfVar [Dependency] (TargetAnnotation a)
_ Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
Nothing) = Bool
True
    isSimple (CondBranch Condition ConfVar
_ CondTree ConfVar [Dependency] (TargetAnnotation a)
_ (Just CondTree ConfVar [Dependency] (TargetAnnotation a)
_)) = Bool
False

    wBranch
      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)
      -> CheckM m ()
    wBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wBranch (CondBranch Condition ConfVar
k CondTree ConfVar [Dependency] (TargetAnnotation a)
t Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
mf) = do
      Condition ConfVar -> CheckM m ()
forall (m :: * -> *). Monad m => Condition ConfVar -> CheckM m ()
checkCondVars Condition ConfVar
k
      CondTree ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wTree CondTree ConfVar [Dependency] (TargetAnnotation a)
t
      CheckM m ()
-> (CondTree ConfVar [Dependency] (TargetAnnotation a)
    -> CheckM m ())
-> Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
-> CheckM m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) CondTree ConfVar [Dependency] (TargetAnnotation a) -> CheckM m ()
wTree Maybe (CondTree ConfVar [Dependency] (TargetAnnotation a))
mf

-- | Condvar checking (misspelled OS in if conditions, etc).
checkCondVars :: Monad m => Condition ConfVar -> CheckM m ()
checkCondVars :: forall (m :: * -> *). Monad m => Condition ConfVar -> CheckM m ()
checkCondVars Condition ConfVar
cond =
  let (Condition ConfVar
_, [ConfVar]
vs) = Condition ConfVar
-> (ConfVar -> Either ConfVar Bool)
-> (Condition ConfVar, [ConfVar])
forall c d.
Condition c -> (c -> Either d Bool) -> (Condition d, [d])
simplifyCondition Condition ConfVar
cond (\ConfVar
v -> ConfVar -> Either ConfVar Bool
forall a b. a -> Either a b
Left ConfVar
v)
   in -- Using simplifyCondition is convenient and correct,
      -- if checks become more complex we can always walk
      -- 'Condition'.
      (ConfVar -> CheckM m ()) -> [ConfVar] -> CheckM m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ConfVar -> CheckM m ()
forall (m :: * -> *). Monad m => ConfVar -> CheckM m ()
vcheck [ConfVar]
vs
  where
    vcheck :: Monad m => ConfVar -> CheckM m ()
    vcheck :: forall (m :: * -> *). Monad m => ConfVar -> CheckM m ()
vcheck (OS (OtherOS String
os)) =
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
UnknownOS [String
os])
    vcheck (Arch (OtherArch String
arch)) =
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
UnknownArch [String
arch])
    vcheck (Impl (OtherCompiler String
os) VersionRange
_) =
      PackageCheck -> CheckM m ()
forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
tellP (CheckExplanation -> PackageCheck
PackageDistInexcusable (CheckExplanation -> PackageCheck)
-> CheckExplanation -> PackageCheck
forall a b. (a -> b) -> a -> b
$ [String] -> CheckExplanation
UnknownCompiler [String
os])
    vcheck ConfVar
_ = () -> CheckM m ()
forall a. a -> CheckM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Checking duplicated modules cannot unfortunately be done in the
-- “tree checking”. This is because of the monoidal instance in some targets,
-- where e.g. merged dependencies are `nub`’d, hence losing information for
-- this particular check.
checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
checkDuplicateModules :: GenericPackageDescription -> [PackageCheck]
checkDuplicateModules GenericPackageDescription
pkg =
  (CondTree ConfVar [Dependency] Library -> [PackageCheck])
-> [CondTree ConfVar [Dependency] Library] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondTree ConfVar [Dependency] Library -> [PackageCheck]
forall {v} {c}. CondTree v c Library -> [PackageCheck]
checkLib (([CondTree ConfVar [Dependency] Library]
 -> [CondTree ConfVar [Dependency] Library])
-> (CondTree ConfVar [Dependency] Library
    -> [CondTree ConfVar [Dependency] Library]
    -> [CondTree ConfVar [Dependency] Library])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [CondTree ConfVar [Dependency] Library]
-> [CondTree ConfVar [Dependency] Library]
forall a. a -> a
id (:) (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg) ([CondTree ConfVar [Dependency] Library]
 -> [CondTree ConfVar [Dependency] Library])
-> ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
    -> [CondTree ConfVar [Dependency] Library])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> CondTree ConfVar [Dependency] Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> [CondTree ConfVar [Dependency] Library])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [CondTree ConfVar [Dependency] Library]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
pkg)
    [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (CondTree ConfVar [Dependency] Executable -> [PackageCheck])
-> [CondTree ConfVar [Dependency] Executable] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondTree ConfVar [Dependency] Executable -> [PackageCheck]
forall {v} {c}. CondTree v c Executable -> [PackageCheck]
checkExe (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> CondTree ConfVar [Dependency] Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [CondTree ConfVar [Dependency] Executable]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
 -> [CondTree ConfVar [Dependency] Executable])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [CondTree ConfVar [Dependency] Executable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables GenericPackageDescription
pkg)
    [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (CondTree ConfVar [Dependency] TestSuite -> [PackageCheck])
-> [CondTree ConfVar [Dependency] TestSuite] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondTree ConfVar [Dependency] TestSuite -> [PackageCheck]
forall {v} {c}. CondTree v c TestSuite -> [PackageCheck]
checkTest (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> CondTree ConfVar [Dependency] TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [CondTree ConfVar [Dependency] TestSuite]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> [CondTree ConfVar [Dependency] TestSuite])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [CondTree ConfVar [Dependency] TestSuite]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites GenericPackageDescription
pkg)
    [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ (CondTree ConfVar [Dependency] Benchmark -> [PackageCheck])
-> [CondTree ConfVar [Dependency] Benchmark] -> [PackageCheck]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondTree ConfVar [Dependency] Benchmark -> [PackageCheck]
forall {v} {c}. CondTree v c Benchmark -> [PackageCheck]
checkBench (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> CondTree ConfVar [Dependency] Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [CondTree ConfVar [Dependency] Benchmark]
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> [CondTree ConfVar [Dependency] Benchmark])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [CondTree ConfVar [Dependency] Benchmark]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks GenericPackageDescription
pkg)
  where
    -- the duplicate modules check is has not been thoroughly vetted for backpack
    checkLib :: CondTree v c Library -> [PackageCheck]
checkLib = String
-> (Library -> [ModuleName])
-> CondTree v c Library
-> [PackageCheck]
forall a v c.
String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
checkDups String
"library" (\Library
l -> Library -> [ModuleName]
explicitLibModules Library
l [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ (ModuleReexport -> ModuleName) -> [ModuleReexport] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleReexport -> ModuleName
moduleReexportName (Library -> [ModuleReexport]
reexportedModules Library
l))
    checkExe :: CondTree v c Executable -> [PackageCheck]
checkExe = String
-> (Executable -> [ModuleName])
-> CondTree v c Executable
-> [PackageCheck]
forall a v c.
String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
checkDups String
"executable" Executable -> [ModuleName]
exeModules
    checkTest :: CondTree v c TestSuite -> [PackageCheck]
checkTest = String
-> (TestSuite -> [ModuleName])
-> CondTree v c TestSuite
-> [PackageCheck]
forall a v c.
String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
checkDups String
"test suite" TestSuite -> [ModuleName]
testModules
    checkBench :: CondTree v c Benchmark -> [PackageCheck]
checkBench = String
-> (Benchmark -> [ModuleName])
-> CondTree v c Benchmark
-> [PackageCheck]
forall a v c.
String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
checkDups String
"benchmark" Benchmark -> [ModuleName]
benchmarkModules
    checkDups :: String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
    checkDups :: forall a v c.
String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]
checkDups String
s a -> [ModuleName]
getModules CondTree v c a
t =
      let sumPair :: (Int, Int) -> (Int, Int) -> (Int, Int)
sumPair (Int
x, Int
x') (Int
y, Int
y') = (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x' :: Int, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y' :: Int)
          mergePair :: (a, a) -> (b, b) -> (a, b)
mergePair (a
x, a
x') (b
y, b
y') = (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x', b -> b -> b
forall a. Ord a => a -> a -> a
max b
y b
y')
          maxPair :: (a, a) -> (b, b) -> (a, b)
maxPair (a
x, a
x') (b
y, b
y') = (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
x', b -> b -> b
forall a. Ord a => a -> a -> a
max b
y b
y')
          libMap :: Map ModuleName (Int, Int)
libMap =
            Map ModuleName (Int, Int)
-> ((c, a) -> Map ModuleName (Int, Int))
-> (Map ModuleName (Int, Int)
    -> Map ModuleName (Int, Int) -> Map ModuleName (Int, Int))
-> (Map ModuleName (Int, Int)
    -> Map ModuleName (Int, Int) -> Map ModuleName (Int, Int))
-> CondTree v c a
-> Map ModuleName (Int, Int)
forall b c a v.
b
-> ((c, a) -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> CondTree v c a
-> b
foldCondTree
              Map ModuleName (Int, Int)
forall k a. Map k a
Map.empty
              (\(c
_, a
v) -> ((Int, Int) -> (Int, Int) -> (Int, Int))
-> [(ModuleName, (Int, Int))] -> Map ModuleName (Int, Int)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (Int, Int) -> (Int, Int) -> (Int, Int)
sumPair ([(ModuleName, (Int, Int))] -> Map ModuleName (Int, Int))
-> ([ModuleName] -> [(ModuleName, (Int, Int))])
-> [ModuleName]
-> Map ModuleName (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> (ModuleName, (Int, Int)))
-> [ModuleName] -> [(ModuleName, (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
x -> (ModuleName
x, (Int
1, Int
1))) ([ModuleName] -> Map ModuleName (Int, Int))
-> [ModuleName] -> Map ModuleName (Int, Int)
forall a b. (a -> b) -> a -> b
$ a -> [ModuleName]
getModules a
v)
              (((Int, Int) -> (Int, Int) -> (Int, Int))
-> Map ModuleName (Int, Int)
-> Map ModuleName (Int, Int)
-> Map ModuleName (Int, Int)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (Int, Int) -> (Int, Int) -> (Int, Int)
forall {a} {b}. (Num a, Ord b) => (a, a) -> (b, b) -> (a, b)
mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely.
              (((Int, Int) -> (Int, Int) -> (Int, Int))
-> Map ModuleName (Int, Int)
-> Map ModuleName (Int, Int)
-> Map ModuleName (Int, Int)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (Int, Int) -> (Int, Int) -> (Int, Int)
forall {a} {b}. (Ord a, Ord b) => (a, a) -> (b, b) -> (a, b)
maxPair) -- a module occurs the max of times it might appear in exclusive branches
              CondTree v c a
t
          dupLibsStrict :: [ModuleName]
dupLibsStrict = Map ModuleName (Int, Int) -> [ModuleName]
forall k a. Map k a -> [k]
Map.keys (Map ModuleName (Int, Int) -> [ModuleName])
-> Map ModuleName (Int, Int) -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Bool)
-> Map ModuleName (Int, Int) -> Map ModuleName (Int, Int)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst) Map ModuleName (Int, Int)
libMap
          dupLibsLax :: [ModuleName]
dupLibsLax = Map ModuleName (Int, Int) -> [ModuleName]
forall k a. Map k a -> [k]
Map.keys (Map ModuleName (Int, Int) -> [ModuleName])
-> Map ModuleName (Int, Int) -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Bool)
-> Map ModuleName (Int, Int) -> Map ModuleName (Int, Int)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) Map ModuleName (Int, Int)
libMap
       in if Bool -> Bool
not ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
dupLibsLax)
            then
              [ CheckExplanation -> PackageCheck
PackageBuildImpossible
                  (String -> [ModuleName] -> CheckExplanation
DuplicateModule String
s [ModuleName]
dupLibsLax)
              ]
            else
              if Bool -> Bool
not ([ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
dupLibsStrict)
                then
                  [ CheckExplanation -> PackageCheck
PackageDistSuspicious
                      (String -> [ModuleName] -> CheckExplanation
PotentialDupModule String
s [ModuleName]
dupLibsStrict)
                  ]
                else []