{-# 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
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
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
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"
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
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
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
(PackageName -> Version -> PackageId
PackageIdentifier PackageName
pn Version
_basicVersion)
(LibraryName -> LibraryName -> LibraryName
combineLibraryName LibraryName
ln LibraryName
_basicLibName)
(String -> ComponentId
mkComponentId String
"")
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 #-}
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 []
combineLibraryName :: LibraryName -> LibraryName -> LibraryName
combineLibraryName :: LibraryName -> LibraryName -> LibraryName
combineLibraryName l :: LibraryName
l@(LSubLibName UnqualComponentName
_) LibraryName
_ = LibraryName
l
combineLibraryName LibraryName
_ LibraryName
l = LibraryName
l
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
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
}
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)
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
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
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
lv' :: LibraryVisibility
lv' = if
let MungedPackageName PackageName
_ LibraryName
mln = MungedPackageName
n in
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