    -- |
    -- Module      :  Distribution.PackageDescription.Check.Common
    -- Copyright   :  Francesco Ariis 2022
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- Common types/functions to various check modules which are *no* part of
    -- Distribution.PackageDescription.Check.Monad.
    module Distribution.PackageDescription.Check.Common
      ( AssocDep
      , CabalField
      , PathKind (..)
      , checkCustomField
      , partitionDeps
      , checkPVP
      , checkPVPs
      ) where

    import Distribution.Compat.Prelude
    import Prelude ()

    import Distribution.Compat.NonEmptySet (toNonEmpty)
    import Distribution.Package
    import Distribution.PackageDescription
    import Distribution.PackageDescription.Check.Monad
    import Distribution.Utils.Generic (isAscii)
    import Distribution.Version

    import Control.Monad

    -- Type of FilePath.
    data PathKind
      = PathKindFile
      | PathKindDirectory
      | PathKindGlob
      deriving (PathKind -> PathKind -> Bool
    (PathKind -> PathKind -> Bool)
    -> (PathKind -> PathKind -> Bool) -> Eq PathKind
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PathKind -> PathKind -> Bool
    == :: PathKind -> PathKind -> Bool
    $c/= :: PathKind -> PathKind -> Bool
    /= :: PathKind -> PathKind -> Bool
    Eq)

    -- | .cabal field we are referring to. As now it is just a synonym to help
    -- reading the code, in the future it might take advantage of typification
    -- in Cabal-syntax.
    type CabalField = String

    checkCustomField :: Monad m => (String, String) -> CheckM m ()
    checkCustomField :: forall (m :: * -> *). Monad m => (String, String) -> CheckM m ()
    checkCustomField (String
    n, String
    _) =
      Bool -> PackageCheck -> CheckM m ()
    forall (m :: * -> *).
    Monad m =>
    Bool -> PackageCheck -> CheckM m ()
    checkP
        ((Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isAscii) String
    n)
        (CheckExplanation -> PackageCheck
    PackageDistInexcusable (CheckExplanation -> PackageCheck)
    -> CheckExplanation -> PackageCheck
    forall a b. (a -> b) -> a -> b
    $ [String] -> CheckExplanation
    NonASCIICustomField [String
    n])

    -- ------------------------------------------------------------
    -- PVP types/functions
    -- ------------------------------------------------------------

    -- A library name / dependencies association list. Ultimately to be
    -- fed to PVP check.
    type AssocDep = (UnqualComponentName, [Dependency])

    -- Convenience function to partition important dependencies by name. To
    -- be used together with checkPVP. Important: usually “base” or “Cabal”,
    -- as the error is slightly different.
    -- Note that `partitionDeps` will also filter out dependencies which are
    -- already present in a inherithed fashion (e.g. an exe which imports the
    -- main library will not need to specify upper bounds on shared dependencies,
    -- hence we do not return those).
    --
    partitionDeps
      :: Monad m
      => [AssocDep] -- Possibly inherited dependencies, i.e.
      -- dependencies from internal/main libs.
      -> [UnqualComponentName] -- List of package names ("base", "Cabal"…)
      -> [Dependency] -- Dependencies to check.
      -> CheckM m ([Dependency], [Dependency])
    partitionDeps :: forall (m :: * -> *).
    Monad m =>
    [AssocDep]
    -> [UnqualComponentName]
    -> [Dependency]
    -> CheckM m ([Dependency], [Dependency])
    partitionDeps [AssocDep]
    ads [UnqualComponentName]
    ns [Dependency]
    ds = do
      -- Shared dependencies from “intra .cabal” libraries.
      let
        -- names of our dependencies
        dqs :: [UnqualComponentName]
    dqs = (Dependency -> UnqualComponentName)
    -> [Dependency] -> [UnqualComponentName]
    forall a b. (a -> b) -> [a] -> [b]
    map Dependency -> UnqualComponentName
    unqualName [Dependency]
    ds
        -- shared targets that match
        fads :: [AssocDep]
    fads = (AssocDep -> Bool) -> [AssocDep] -> [AssocDep]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((UnqualComponentName -> [UnqualComponentName] -> Bool)
    -> [UnqualComponentName] -> UnqualComponentName -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip UnqualComponentName -> [UnqualComponentName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem [UnqualComponentName]
    dqs (UnqualComponentName -> Bool)
    -> (AssocDep -> UnqualComponentName) -> AssocDep -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AssocDep -> UnqualComponentName
    forall a b. (a, b) -> a
    fst) [AssocDep]
    ads
        -- the names of such targets
        inNam :: [UnqualComponentName]
    inNam = [UnqualComponentName] -> [UnqualComponentName]
    forall a. Eq a => [a] -> [a]
    nub ([UnqualComponentName] -> [UnqualComponentName])
    -> [UnqualComponentName] -> [UnqualComponentName]
    forall a b. (a -> b) -> a -> b
    $ (AssocDep -> UnqualComponentName)
    -> [AssocDep] -> [UnqualComponentName]
    forall a b. (a -> b) -> [a] -> [b]
    map AssocDep -> UnqualComponentName
    forall a b. (a, b) -> a
    fst [AssocDep]
    fads :: [UnqualComponentName]
        -- the dependencies of such targets
        inDep :: [Dependency]
    inDep = (AssocDep -> [Dependency]) -> [AssocDep] -> [Dependency]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AssocDep -> [Dependency]
    forall a b. (a, b) -> b
    snd [AssocDep]
    fads :: [Dependency]

      -- We exclude from checks:
      -- 1. dependencies which are shared with main library / a
      --    sublibrary; and of course
      -- 2. the names of main library / sub libraries themselves.
      --
      -- So in myPackage.cabal
      -- library
      --      build-depends: text < 5
      -- ⁝
      --      build-depends: myPackage,        ← no warning, internal
      --                     text,             ← no warning, inherited
      --                     monadacme         ← warning!
      let fFun :: Dependency -> Bool
    fFun Dependency
    d =
            UnqualComponentName -> [UnqualComponentName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem (Dependency -> UnqualComponentName
    unqualName Dependency
    d) [UnqualComponentName]
    inNam
              Bool -> Bool -> Bool
    && UnqualComponentName -> [UnqualComponentName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem
                (Dependency -> UnqualComponentName
    unqualName Dependency
    d)
                ((Dependency -> UnqualComponentName)
    -> [Dependency] -> [UnqualComponentName]
    forall a b. (a -> b) -> [a] -> [b]
    map Dependency -> UnqualComponentName
    unqualName [Dependency]
    inDep)
          ds' :: [Dependency]
    ds' = (Dependency -> Bool) -> [Dependency] -> [Dependency]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Dependency -> Bool
    fFun [Dependency]
    ds

      ([Dependency], [Dependency])
    -> CheckM m ([Dependency], [Dependency])
    forall a. a -> CheckM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([Dependency], [Dependency])
     -> CheckM m ([Dependency], [Dependency]))
    -> ([Dependency], [Dependency])
    -> CheckM m ([Dependency], [Dependency])
    forall a b. (a -> b) -> a -> b
    $ (Dependency -> Bool)
    -> [Dependency] -> ([Dependency], [Dependency])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((UnqualComponentName -> [UnqualComponentName] -> Bool)
    -> [UnqualComponentName] -> UnqualComponentName -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip UnqualComponentName -> [UnqualComponentName] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem [UnqualComponentName]
    ns (UnqualComponentName -> Bool)
    -> (Dependency -> UnqualComponentName) -> Dependency -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dependency -> UnqualComponentName
    unqualName) [Dependency]
    ds'
      where
        -- Return *sublibrary* name if exists (internal),
        -- otherwise package name.
        unqualName :: Dependency -> UnqualComponentName
        unqualName :: Dependency -> UnqualComponentName
    unqualName (Dependency PackageName
    n VersionRange
    _ NonEmptySet LibraryName
    nel) =
          case NonEmpty LibraryName -> LibraryName
    forall a. NonEmpty a -> a
    head (NonEmptySet LibraryName -> NonEmpty LibraryName
    forall a. NonEmptySet a -> NonEmpty a
    toNonEmpty NonEmptySet LibraryName
    nel) of
            (LSubLibName UnqualComponentName
    ln) -> UnqualComponentName
    ln
            LibraryName
    _ -> PackageName -> UnqualComponentName
    packageNameToUnqualComponentName PackageName
    n

    -- PVP dependency check (one warning message per dependency, usually
    -- for important dependencies like base).
    checkPVP
      :: Monad m
      => (String -> PackageCheck) -- Warn message dependend on name
      -- (e.g. "base", "Cabal").
      -> [Dependency]
      -> CheckM m ()
    checkPVP :: forall (m :: * -> *).
    Monad m =>
    (String -> PackageCheck) -> [Dependency] -> CheckM m ()
    checkPVP String -> PackageCheck
    ckf [Dependency]
    ds = do
      let ods :: [Dependency]
    ods = [Dependency] -> [Dependency]
    checkPVPPrim [Dependency]
    ds
      (Dependency -> CheckM m ()) -> [Dependency] -> CheckM m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (PackageCheck -> CheckM m ()
    forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
    tellP (PackageCheck -> CheckM m ())
    -> (Dependency -> PackageCheck) -> Dependency -> CheckM m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PackageCheck
    ckf (String -> PackageCheck)
    -> (Dependency -> String) -> Dependency -> PackageCheck
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PackageName -> String
    unPackageName (PackageName -> String)
    -> (Dependency -> PackageName) -> Dependency -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dependency -> PackageName
    depPkgName) [Dependency]
    ods

    -- PVP dependency check for a list of dependencies. Some code duplication
    -- is sadly needed to provide more ergonimic error messages.
    checkPVPs
      :: Monad m
      => ( [String]
           -> PackageCheck -- Grouped error message, depends on a
           -- set of names.
         )
      -> [Dependency] -- Deps to analyse.
      -> CheckM m ()
    checkPVPs :: forall (m :: * -> *).
    Monad m =>
    ([String] -> PackageCheck) -> [Dependency] -> CheckM m ()
    checkPVPs [String] -> PackageCheck
    cf [Dependency]
    ds
      | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ns = () -> CheckM m ()
    forall a. a -> CheckM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise = PackageCheck -> CheckM m ()
    forall (m :: * -> *). Monad m => PackageCheck -> CheckM m ()
    tellP ([String] -> PackageCheck
    cf [String]
    ns)
      where
        ods :: [Dependency]
    ods = [Dependency] -> [Dependency]
    checkPVPPrim [Dependency]
    ds
        ns :: [String]
    ns = (Dependency -> String) -> [Dependency] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (PackageName -> String
    unPackageName (PackageName -> String)
    -> (Dependency -> PackageName) -> Dependency -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dependency -> PackageName
    depPkgName) [Dependency]
    ods

    -- Returns dependencies without upper bounds.
    checkPVPPrim :: [Dependency] -> [Dependency]
    checkPVPPrim :: [Dependency] -> [Dependency]
    checkPVPPrim [Dependency]
    ds = (Dependency -> Bool) -> [Dependency] -> [Dependency]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Dependency -> Bool
    withoutUpper [Dependency]
    ds
      where
        withoutUpper :: Dependency -> Bool
        withoutUpper :: Dependency -> Bool
    withoutUpper (Dependency PackageName
    _ VersionRange
    ver NonEmptySet LibraryName
    _) = Bool -> Bool
    not (Bool -> Bool) -> (VersionRange -> Bool) -> VersionRange -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VersionRange -> Bool
    hasUpperBound (VersionRange -> Bool) -> VersionRange -> Bool
    forall a b. (a -> b) -> a -> b
    $ VersionRange
    ver