{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
module Distribution.Types.InstalledPackageInfo.FieldGrammar (
    ipiFieldGrammar,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Backpack
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens               (Lens', (&), (.~))
import Distribution.Compat.Newtype
import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.License
import Distribution.ModuleName
import Distribution.Package
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Types.LibraryName
import Distribution.Types.LibraryVisibility
import Distribution.Types.MungedPackageName
import Distribution.Types.UnqualComponentName
import Distribution.Version

import qualified Data.Char                       as Char
import qualified Data.Map                        as Map
import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.SPDX               as SPDX
import qualified Text.PrettyPrint                as Disp

import Distribution.Types.InstalledPackageInfo

import qualified Distribution.Types.InstalledPackageInfo.Lens as L
import qualified Distribution.Types.PackageId.Lens            as L

-- Note: GHC goes nuts and inlines everything,
-- One can see e.g. in -ddump-simpl-stats:
--
-- 34886 KnownBranch
--  8197 wild1_ixF0
--
-- https://gitlab.haskell.org/ghc/ghc/-/issues/13253 might be the cause.
--
-- The workaround is to prevent GHC optimising the code:
infixl 4 <@>
(<@>) :: Applicative f => f (a -> b) -> f a -> f b
f (a -> b)
f <@> :: forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> f a
x = f (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x
{-# NOINLINE (<@>) #-}

ipiFieldGrammar
    :: ( FieldGrammar c g, Applicative (g InstalledPackageInfo), Applicative (g Basic)
       , c (Identity AbiHash)
       , c (Identity LibraryVisibility)
       , c (Identity PackageName)
       , c (Identity UnitId)
       , c (Identity UnqualComponentName)
       , c (List FSep (Identity AbiDependency) AbiDependency)
       , c (List FSep (Identity UnitId) UnitId)
       , c (List FSep (MQuoted ModuleName) ModuleName)
       , c (List FSep FilePathNT String)
       , c (List FSep Token String)
       , c (MQuoted MungedPackageName)
       , c (MQuoted Version)
       , c CompatPackageKey
       , c ExposedModules
       , c InstWith
       , c SpecLicenseLenient
       )
    => g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g InstalledPackageInfo),
 Applicative (g Basic), c (Identity AbiHash),
 c (Identity LibraryVisibility), c (Identity PackageName),
 c (Identity UnitId), c (Identity UnqualComponentName),
 c (List FSep (Identity AbiDependency) AbiDependency),
 c (List FSep (Identity UnitId) UnitId),
 c (List FSep (MQuoted ModuleName) ModuleName),
 c (List FSep FilePathNT String), c (List FSep Token String),
 c (MQuoted MungedPackageName), c (MQuoted Version),
 c CompatPackageKey, c ExposedModules, c InstWith,
 c SpecLicenseLenient) =>
g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar = forall {p}.
p
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> AbiHash
-> Bool
-> Bool
-> [ExposedModule]
-> [ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo
mkInstalledPackageInfo
    -- Deprecated fields
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"hugs-options"         (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         forall a b. Lens' a [b]
unitedList
        --- https://github.com/haskell/cabal/commit/40f3601e17024f07e0da8e64d3dd390177ce908b
        forall a b. a -> (a -> b) -> b
^^^ forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
FieldGrammar c g =>
CabalSpecVersion -> String -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_22 String
"hugs isn't supported anymore"
    -- Very basic fields: name, version, package-name, lib-name and visibility
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) a b d.
FieldGrammar c g =>
ALens' a b -> g b d -> g a d
blurFieldGrammar Lens' InstalledPackageInfo Basic
basic forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Basic),
 c (Identity LibraryVisibility), c (Identity PackageName),
 c (Identity UnqualComponentName), c (MQuoted MungedPackageName),
 c (MQuoted Version)) =>
g Basic Basic
basicFieldGrammar
    -- Basic fields
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef    FieldName
"id"                                                 Lens' InstalledPackageInfo UnitId
L.installedUnitId (String -> UnitId
mkUnitId String
"")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"instantiated-with"    [(ModuleName, OpenModule)] -> InstWith
InstWith                      Lens' InstalledPackageInfo [(ModuleName, OpenModule)]
L.instantiatedWith []
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"key"                  String -> CompatPackageKey
CompatPackageKey              Lens' InstalledPackageInfo String
L.compatPackageKey String
""
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"license"              Either License License -> SpecLicenseLenient
SpecLicenseLenient            Lens' InstalledPackageInfo (Either License License)
L.license (forall a b. a -> Either a b
Left License
SPDX.NONE)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"copyright"                                          Lens' InstalledPackageInfo ShortText
L.copyright
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"maintainer"                                         Lens' InstalledPackageInfo ShortText
L.maintainer
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"author"                                             Lens' InstalledPackageInfo ShortText
L.author
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"stability"                                          Lens' InstalledPackageInfo ShortText
L.stability
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"homepage"                                           Lens' InstalledPackageInfo ShortText
L.homepage
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"package-url"                                        Lens' InstalledPackageInfo ShortText
L.pkgUrl
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"synopsis"                                           Lens' InstalledPackageInfo ShortText
L.synopsis
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"description"                                        Lens' InstalledPackageInfo ShortText
L.description
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s ShortText -> g s ShortText
freeTextFieldDefST  FieldName
"category"                                           Lens' InstalledPackageInfo ShortText
L.category
    -- Installed fields
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef    FieldName
"abi"                                                Lens' InstalledPackageInfo AbiHash
L.abiHash (String -> AbiHash
mkAbiHash String
"")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef     FieldName
"indefinite"                                         Lens' InstalledPackageInfo Bool
L.indefinite Bool
False
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef     FieldName
"exposed"                                            Lens' InstalledPackageInfo Bool
L.exposed Bool
False
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"exposed-modules"      [ExposedModule] -> ExposedModules
ExposedModules                Lens' InstalledPackageInfo [ExposedModule]
L.exposedModules
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"hidden-modules"       (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep forall a. a -> MQuoted a
MQuoted)       Lens' InstalledPackageInfo [ModuleName]
L.hiddenModules
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) s.
FieldGrammar c g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef     FieldName
"trusted"                                            Lens' InstalledPackageInfo Bool
L.trusted Bool
False
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"import-dirs"          (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.importDirs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"library-dirs"         (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.libraryDirs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"dynamic-library-dirs" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.libraryDynDirs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"data-dir"             String -> FilePathNT
FilePathNT                    Lens' InstalledPackageInfo String
L.dataDir String
""
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"hs-libraries"         (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.hsLibraries
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"extra-libraries"      (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.extraLibraries
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"extra-ghci-libraries" (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.extraGHCiLibraries
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"include-dirs"         (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.includeDirs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"includes"             (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.includes
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"depends"              (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep)                Lens' InstalledPackageInfo [UnitId]
L.depends
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"abi-depends"          (forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep)                Lens' InstalledPackageInfo [AbiDependency]
L.abiDepends
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"cc-options"           (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.ccOptions
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"cxx-options"          (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.cxxOptions
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"ld-options"           (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.ldOptions
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"framework-dirs"       (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.frameworkDirs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"frameworks"           (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token)         Lens' InstalledPackageInfo [String]
L.frameworks
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"haddock-interfaces"   (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.haddockInterfaces
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla    FieldName
"haddock-html"         (forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT)    Lens' InstalledPackageInfo [String]
L.haddockHTMLs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<@> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla    FieldName
"pkgroot"              String -> FilePathNT
FilePathNT                    Lens' InstalledPackageInfo (Maybe String)
L.pkgRoot
  where
    mkInstalledPackageInfo :: p
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> AbiHash
-> Bool
-> Bool
-> [ExposedModule]
-> [ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo
mkInstalledPackageInfo p
_ Basic {Maybe PackageName
Version
LibraryVisibility
LibraryName
MungedPackageName
_basicLibVisibility :: Basic -> LibraryVisibility
_basicLibName :: Basic -> LibraryName
_basicPkgName :: Basic -> Maybe PackageName
_basicVersion :: Basic -> Version
_basicName :: Basic -> MungedPackageName
_basicLibVisibility :: LibraryVisibility
_basicLibName :: LibraryName
_basicPkgName :: Maybe PackageName
_basicVersion :: Version
_basicName :: MungedPackageName
..} = PackageId
-> LibraryName
-> ComponentId
-> LibraryVisibility
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> ShortText
-> AbiHash
-> Bool
-> Bool
-> [ExposedModule]
-> [ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo
InstalledPackageInfo
        -- _basicPkgName is not used
        -- setMaybePackageId says it can be no-op.
        (PackageName -> Version -> PackageId
PackageIdentifier PackageName
pn Version
_basicVersion)
        (LibraryName -> LibraryName -> LibraryName
combineLibraryName LibraryName
ln LibraryName
_basicLibName)
        (String -> ComponentId
mkComponentId String
"") -- installedComponentId_, not in use
        LibraryVisibility
_basicLibVisibility
      where
        MungedPackageName PackageName
pn LibraryName
ln = MungedPackageName
_basicName
{-# SPECIALIZE ipiFieldGrammar :: FieldDescrs InstalledPackageInfo InstalledPackageInfo #-}
{-# SPECIALIZE ipiFieldGrammar :: ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo #-}
{-# SPECIALIZE ipiFieldGrammar :: PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo #-}

-- (forall b. [b]) ~ ()
unitedList :: Lens' a [b]
unitedList :: forall a b. Lens' a [b]
unitedList [b] -> f [b]
f a
s = a
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [b] -> f [b]
f []

-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------

-- | Combine 'LibraryName'. in parsing we prefer value coming
-- from munged @name@ field over the @lib-name@.
--
-- /Should/ be irrelevant.
combineLibraryName :: LibraryName -> LibraryName -> LibraryName
combineLibraryName :: LibraryName -> LibraryName -> LibraryName
combineLibraryName l :: LibraryName
l@(LSubLibName UnqualComponentName
_) LibraryName
_ = LibraryName
l
combineLibraryName LibraryName
_ LibraryName
l                 = LibraryName
l

-- To maintain backwards-compatibility, we accept both comma/non-comma
-- separated variants of this field.  You SHOULD use the comma syntax if you
-- use any new functions, although actually it's unambiguous due to a quirk
-- of the fact that modules must start with capital letters.

showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules :: [ExposedModule] -> Doc
showExposedModules [ExposedModule]
xs
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ExposedModule -> Bool
isExposedModule [ExposedModule]
xs = [Doc] -> Doc
Disp.fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ExposedModule]
xs)
    | Bool
otherwise = [Doc] -> Doc
Disp.fsep (Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [ExposedModule]
xs))
    where isExposedModule :: ExposedModule -> Bool
isExposedModule (ExposedModule ModuleName
_ Maybe OpenModule
Nothing) = Bool
True
          isExposedModule ExposedModule
_ = Bool
False

-- | Setter for the @package-name@ field.  It should be acceptable for this
-- to be a no-op.
setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName Maybe PackageName
Nothing   InstalledPackageInfo
ipi = InstalledPackageInfo
ipi
setMaybePackageName (Just PackageName
pn) InstalledPackageInfo
ipi = InstalledPackageInfo
ipi
    { sourcePackageId :: PackageId
sourcePackageId = (InstalledPackageInfo -> PackageId
sourcePackageId InstalledPackageInfo
ipi) {pkgName :: PackageName
pkgName=PackageName
pn}
    }

setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMungedPackageName (MungedPackageName PackageName
pn LibraryName
ln) InstalledPackageInfo
ipi = InstalledPackageInfo
ipi
    { sourcePackageId :: PackageId
sourcePackageId = (InstalledPackageInfo -> PackageId
sourcePackageId InstalledPackageInfo
ipi) {pkgName :: PackageName
pkgName=PackageName
pn}
    , sourceLibName :: LibraryName
sourceLibName   = LibraryName
ln
    }

--- | Returns @Just@ if the @name@ field of the IPI record would not contain
--- the package name verbatim.  This helps us avoid writing @package-name@
--- when it's redundant.
maybePackageName :: InstalledPackageInfo -> Maybe PackageName
maybePackageName :: InstalledPackageInfo -> Maybe PackageName
maybePackageName InstalledPackageInfo
ipi = case InstalledPackageInfo -> LibraryName
sourceLibName InstalledPackageInfo
ipi of
    LibraryName
LMainLibName  -> forall a. Maybe a
Nothing
    LSubLibName UnqualComponentName
_ -> forall a. a -> Maybe a
Just (forall pkg. Package pkg => pkg -> PackageName
packageName InstalledPackageInfo
ipi)

-------------------------------------------------------------------------------
-- Auxiliary types
-------------------------------------------------------------------------------

newtype ExposedModules = ExposedModules { ExposedModules -> [ExposedModule]
getExposedModules :: [ExposedModule] }

instance Newtype [ExposedModule] ExposedModules

instance Parsec ExposedModules where
    parsec :: forall (m :: * -> *). CabalParsing m => m ExposedModules
parsec = [ExposedModule] -> ExposedModules
ExposedModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

instance Pretty ExposedModules where
    pretty :: ExposedModules -> Doc
pretty = [ExposedModule] -> Doc
showExposedModules forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExposedModules -> [ExposedModule]
getExposedModules

newtype CompatPackageKey = CompatPackageKey { CompatPackageKey -> String
getCompatPackageKey :: String }

instance Newtype String CompatPackageKey

instance Pretty CompatPackageKey where
    pretty :: CompatPackageKey -> Doc
pretty = String -> Doc
Disp.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompatPackageKey -> String
getCompatPackageKey

instance Parsec CompatPackageKey where
    parsec :: forall (m :: * -> *). CabalParsing m => m CompatPackageKey
parsec = String -> CompatPackageKey
CompatPackageKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
uid_char where
        uid_char :: Char -> Bool
uid_char Char
c = Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"-_.=[],:<>+" :: String)

newtype InstWith = InstWith { InstWith -> [(ModuleName, OpenModule)]
getInstWith :: [(ModuleName,OpenModule)] }

instance Newtype  [(ModuleName, OpenModule)] InstWith

instance Pretty InstWith where
    pretty :: InstWith -> Doc
pretty = OpenModuleSubst -> Doc
dispOpenModuleSubst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstWith -> [(ModuleName, OpenModule)]
getInstWith

instance Parsec InstWith where
    parsec :: forall (m :: * -> *). CabalParsing m => m InstWith
parsec = [(ModuleName, OpenModule)] -> InstWith
InstWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CabalParsing m => m OpenModuleSubst
parsecOpenModuleSubst

-- | SPDX License expression or legacy license. Lenient parser, accepts either.
newtype SpecLicenseLenient = SpecLicenseLenient { SpecLicenseLenient -> Either License License
getSpecLicenseLenient :: Either SPDX.License License }

instance Newtype (Either SPDX.License License) SpecLicenseLenient

instance Parsec SpecLicenseLenient where
    parsec :: forall (m :: * -> *). CabalParsing m => m SpecLicenseLenient
parsec = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either License License -> SpecLicenseLenient
SpecLicenseLenient forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Parsing m => m a -> m a
P.try forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec

instance Pretty SpecLicenseLenient where
    pretty :: SpecLicenseLenient -> Doc
pretty = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> Doc
pretty forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecLicenseLenient -> Either License License
getSpecLicenseLenient

-------------------------------------------------------------------------------
-- Basic fields
-------------------------------------------------------------------------------

-- | This type is used to mangle fields as
-- in serialised textual representation
-- to the actual 'InstalledPackageInfo' fields.
data Basic = Basic
    { Basic -> MungedPackageName
_basicName          :: MungedPackageName
    , Basic -> Version
_basicVersion       :: Version
    , Basic -> Maybe PackageName
_basicPkgName       :: Maybe PackageName
    , Basic -> LibraryName
_basicLibName       :: LibraryName
    , Basic -> LibraryVisibility
_basicLibVisibility :: LibraryVisibility
    }

basic :: Lens' InstalledPackageInfo Basic
basic :: Lens' InstalledPackageInfo Basic
basic Basic -> f Basic
f InstalledPackageInfo
ipi = Basic -> InstalledPackageInfo
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Basic -> f Basic
f Basic
b
  where
    b :: Basic
b = MungedPackageName
-> Version
-> Maybe PackageName
-> LibraryName
-> LibraryVisibility
-> Basic
Basic
        (InstalledPackageInfo -> MungedPackageName
mungedPackageName InstalledPackageInfo
ipi)
        (forall pkg. Package pkg => pkg -> Version
packageVersion InstalledPackageInfo
ipi)
        (InstalledPackageInfo -> Maybe PackageName
maybePackageName InstalledPackageInfo
ipi)
        (InstalledPackageInfo -> LibraryName
sourceLibName InstalledPackageInfo
ipi)
        (InstalledPackageInfo -> LibraryVisibility
libVisibility InstalledPackageInfo
ipi)

    g :: Basic -> InstalledPackageInfo
g (Basic MungedPackageName
n Version
v Maybe PackageName
pn LibraryName
ln LibraryVisibility
lv) = InstalledPackageInfo
ipi
        forall a b. a -> (a -> b) -> b
& MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMungedPackageName MungedPackageName
n
        forall a b. a -> (a -> b) -> b
& Lens' InstalledPackageInfo PackageId
L.sourcePackageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PackageId Version
L.pkgVersion forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version
v
        forall a b. a -> (a -> b) -> b
& Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName Maybe PackageName
pn
        forall a b. a -> (a -> b) -> b
& Lens' InstalledPackageInfo LibraryName
L.sourceLibName forall s t a b. ASetter s t a b -> b -> s -> t
.~ LibraryName
ln
        forall a b. a -> (a -> b) -> b
& Lens' InstalledPackageInfo LibraryVisibility
L.libVisibility forall s t a b. ASetter s t a b -> b -> s -> t
.~ LibraryVisibility
lv

basicName :: Lens' Basic MungedPackageName
basicName :: Lens' Basic MungedPackageName
basicName MungedPackageName -> f MungedPackageName
f Basic
b = (\MungedPackageName
x -> Basic
b { _basicName :: MungedPackageName
_basicName = MungedPackageName
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MungedPackageName -> f MungedPackageName
f (Basic -> MungedPackageName
_basicName Basic
b)
{-# INLINE basicName #-}

basicVersion :: Lens' Basic Version
basicVersion :: Lens' Basic Version
basicVersion Version -> f Version
f Basic
b = (\Version
x -> Basic
b { _basicVersion :: Version
_basicVersion = Version
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> f Version
f (Basic -> Version
_basicVersion Basic
b)
{-# INLINE basicVersion #-}

basicPkgName :: Lens' Basic (Maybe PackageName)
basicPkgName :: Lens' Basic (Maybe PackageName)
basicPkgName Maybe PackageName -> f (Maybe PackageName)
f Basic
b = (\Maybe PackageName
x -> Basic
b { _basicPkgName :: Maybe PackageName
_basicPkgName = Maybe PackageName
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PackageName -> f (Maybe PackageName)
f (Basic -> Maybe PackageName
_basicPkgName Basic
b)
{-# INLINE basicPkgName #-}

basicLibName :: Lens' Basic (Maybe UnqualComponentName)
basicLibName :: Lens' Basic (Maybe UnqualComponentName)
basicLibName Maybe UnqualComponentName -> f (Maybe UnqualComponentName)
f Basic
b = (\Maybe UnqualComponentName
x -> Basic
b { _basicLibName :: LibraryName
_basicLibName = Maybe UnqualComponentName -> LibraryName
maybeToLibraryName Maybe UnqualComponentName
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Maybe UnqualComponentName -> f (Maybe UnqualComponentName)
f (LibraryName -> Maybe UnqualComponentName
libraryNameString (Basic -> LibraryName
_basicLibName Basic
b))
{-# INLINE basicLibName #-}

basicLibVisibility :: Lens' Basic LibraryVisibility
basicLibVisibility :: Lens' Basic LibraryVisibility
basicLibVisibility LibraryVisibility -> f LibraryVisibility
f Basic
b = (\LibraryVisibility
x -> Basic
b { _basicLibVisibility :: LibraryVisibility
_basicLibVisibility = LibraryVisibility
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    LibraryVisibility -> f LibraryVisibility
f (Basic -> LibraryVisibility
_basicLibVisibility Basic
b)
{-# INLINE basicLibVisibility #-}

basicFieldGrammar
    :: ( FieldGrammar c g, Applicative (g Basic)
       , c (Identity LibraryVisibility)
       , c (Identity PackageName)
       , c (Identity UnqualComponentName)
       , c (MQuoted MungedPackageName)
       , c (MQuoted Version)
       )
    => g Basic Basic
basicFieldGrammar :: forall (c :: * -> Constraint) (g :: * -> * -> *).
(FieldGrammar c g, Applicative (g Basic),
 c (Identity LibraryVisibility), c (Identity PackageName),
 c (Identity UnqualComponentName), c (MQuoted MungedPackageName),
 c (MQuoted Version)) =>
g Basic Basic
basicFieldGrammar = MungedPackageName
-> Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic
mkBasic
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"name"          forall a. a -> MQuoted a
MQuoted  Lens' Basic MungedPackageName
basicName (InstalledPackageInfo -> MungedPackageName
mungedPackageName InstalledPackageInfo
emptyInstalledPackageInfo)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla FieldName
"version"       forall a. a -> MQuoted a
MQuoted  Lens' Basic Version
basicVersion Version
nullVersion
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField       FieldName
"package-name"           Lens' Basic (Maybe PackageName)
basicPkgName
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField       FieldName
"lib-name"               Lens' Basic (Maybe UnqualComponentName)
basicLibName
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: * -> Constraint) (g :: * -> * -> *) s a.
(FieldGrammar c g, Functor (g s), c (Identity a), Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef    FieldName
"visibility"             Lens' Basic LibraryVisibility
basicLibVisibility LibraryVisibility
LibraryVisibilityPrivate
  where
    mkBasic :: MungedPackageName
-> Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic
mkBasic MungedPackageName
n Version
v Maybe PackageName
pn Maybe UnqualComponentName
ln LibraryVisibility
lv = MungedPackageName
-> Version
-> Maybe PackageName
-> LibraryName
-> LibraryVisibility
-> Basic
Basic MungedPackageName
n Version
v Maybe PackageName
pn LibraryName
ln' LibraryVisibility
lv'
      where
        ln' :: LibraryName
ln' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe LibraryName
LMainLibName UnqualComponentName -> LibraryName
LSubLibName Maybe UnqualComponentName
ln
        -- Older GHCs (<8.8) always report installed libraries as private
        -- because their ghc-pkg builds with an older Cabal.
        -- So we always set LibraryVisibilityPublic for main (unnamed) libs.
        -- This can be removed once we stop supporting GHC<8.8, at the
        -- condition that we keep marking main libraries as public when
        -- registering them.
        lv' :: LibraryVisibility
lv' = if
                let MungedPackageName PackageName
_ LibraryName
mln = MungedPackageName
n in
                -- We need to check both because on ghc<8.2 ln' will always
                -- be LMainLibName
                LibraryName
ln' forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName Bool -> Bool -> Bool
&& LibraryName
mln forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName
              then LibraryVisibility
LibraryVisibilityPublic
              else LibraryVisibility
lv