{-# 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.Parsec.Newtypes
import Distribution.Pretty
import Distribution.Types.LibraryVisibility
import Distribution.Types.MungedPackageName
import Distribution.Types.LibraryName
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 :: f (a -> b)
f <+> :: f (a -> b) -> f a -> f b
<+> x :: f a
x = f (a -> b)
f f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x
{-# NOINLINE (<+>) #-}
ipiFieldGrammar
:: (FieldGrammar g, Applicative (g InstalledPackageInfo), Applicative (g Basic))
=> g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar :: g InstalledPackageInfo InstalledPackageInfo
ipiFieldGrammar = [String]
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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
forall p.
p
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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
([String]
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
(Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "hugs-options" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
forall a b. Lens' a [b]
unitedList
g InstalledPackageInfo [String]
-> (g InstalledPackageInfo [String]
-> g InstalledPackageInfo [String])
-> g InstalledPackageInfo [String]
forall a b. a -> (a -> b) -> b
^^^ CabalSpecVersion
-> String
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) s a.
FieldGrammar g =>
CabalSpecVersion -> String -> g s a -> g s a
deprecatedSince CabalSpecVersion
CabalSpecV1_22 "hugs isn't supported anymore"
g InstalledPackageInfo
(Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo Basic
-> g InstalledPackageInfo
(UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> ALens' InstalledPackageInfo Basic
-> g Basic Basic -> g InstalledPackageInfo Basic
forall (g :: * -> * -> *) a b c.
FieldGrammar g =>
ALens' a b -> g b c -> g a c
blurFieldGrammar ALens' InstalledPackageInfo Basic
Lens' InstalledPackageInfo Basic
basic g Basic Basic
forall (g :: * -> * -> *).
(FieldGrammar g, Applicative (g Basic)) =>
g Basic Basic
basicFieldGrammar
g InstalledPackageInfo
(UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo UnitId
-> g InstalledPackageInfo
([(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo UnitId
-> UnitId
-> g InstalledPackageInfo UnitId
forall (g :: * -> * -> *) s a.
(FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef "id" ALens' InstalledPackageInfo UnitId
Lens' InstalledPackageInfo UnitId
L.installedUnitId (String -> UnitId
mkUnitId "")
g InstalledPackageInfo
([(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo [(ModuleName, OpenModule)]
-> g InstalledPackageInfo
(String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([(ModuleName, OpenModule)] -> InstWith)
-> ALens' InstalledPackageInfo [(ModuleName, OpenModule)]
-> [(ModuleName, OpenModule)]
-> g InstalledPackageInfo [(ModuleName, OpenModule)]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "instantiated-with" [(ModuleName, OpenModule)] -> InstWith
InstWith ALens' InstalledPackageInfo [(ModuleName, OpenModule)]
Lens' InstalledPackageInfo [(ModuleName, OpenModule)]
L.instantiatedWith []
g InstalledPackageInfo
(String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> (String -> CompatPackageKey)
-> ALens' InstalledPackageInfo String
-> String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "key" String -> CompatPackageKey
CompatPackageKey ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.compatPackageKey ""
g InstalledPackageInfo
(Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo (Either License License)
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> (Either License License -> SpecLicenseLenient)
-> ALens' InstalledPackageInfo (Either License License)
-> Either License License
-> g InstalledPackageInfo (Either License License)
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "license" Either License License -> SpecLicenseLenient
SpecLicenseLenient ALens' InstalledPackageInfo (Either License License)
Lens' InstalledPackageInfo (Either License License)
L.license (License -> Either License License
forall a b. a -> Either a b
Left License
SPDX.NONE)
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "copyright" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.copyright
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "maintainer" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.maintainer
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "author" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.author
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "stability" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.stability
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "homepage" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.homepage
g InstalledPackageInfo
(String
-> String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "package-url" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.pkgUrl
g InstalledPackageInfo
(String
-> String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "synopsis" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.synopsis
g InstalledPackageInfo
(String
-> String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(String
-> 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "description" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.description
g InstalledPackageInfo
(String
-> 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)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
(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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s String -> g s String
freeTextFieldDef "category" ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.category
g InstalledPackageInfo
(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)
-> g InstalledPackageInfo AbiHash
-> g InstalledPackageInfo
(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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo AbiHash
-> AbiHash
-> g InstalledPackageInfo AbiHash
forall (g :: * -> * -> *) s a.
(FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef "abi" ALens' InstalledPackageInfo AbiHash
Lens' InstalledPackageInfo AbiHash
L.abiHash (String -> AbiHash
mkAbiHash "")
g InstalledPackageInfo
(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)
-> g InstalledPackageInfo Bool
-> g InstalledPackageInfo
(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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo Bool
-> Bool
-> g InstalledPackageInfo Bool
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef "indefinite" ALens' InstalledPackageInfo Bool
Lens' InstalledPackageInfo Bool
L.indefinite Bool
False
g InstalledPackageInfo
(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)
-> g InstalledPackageInfo Bool
-> g InstalledPackageInfo
([ExposedModule]
-> [ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo Bool
-> Bool
-> g InstalledPackageInfo Bool
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef "exposed" ALens' InstalledPackageInfo Bool
Lens' InstalledPackageInfo Bool
L.exposed Bool
False
g InstalledPackageInfo
([ExposedModule]
-> [ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [ExposedModule]
-> g InstalledPackageInfo
([ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([ExposedModule] -> ExposedModules)
-> ALens' InstalledPackageInfo [ExposedModule]
-> g InstalledPackageInfo [ExposedModule]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "exposed-modules" [ExposedModule] -> ExposedModules
ExposedModules ALens' InstalledPackageInfo [ExposedModule]
Lens' InstalledPackageInfo [ExposedModule]
L.exposedModules
g InstalledPackageInfo
([ModuleName]
-> Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [ModuleName]
-> g InstalledPackageInfo
(Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([ModuleName] -> List FSep (MQuoted ModuleName) ModuleName)
-> ALens' InstalledPackageInfo [ModuleName]
-> g InstalledPackageInfo [ModuleName]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "hidden-modules" (FSep
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List FSep (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
MQuoted) ALens' InstalledPackageInfo [ModuleName]
Lens' InstalledPackageInfo [ModuleName]
L.hiddenModules
g InstalledPackageInfo
(Bool
-> [String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo Bool
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' InstalledPackageInfo Bool
-> Bool
-> g InstalledPackageInfo Bool
forall (g :: * -> * -> *) s.
FieldGrammar g =>
FieldName -> ALens' s Bool -> Bool -> g s Bool
booleanFieldDef "trusted" ALens' InstalledPackageInfo Bool
Lens' InstalledPackageInfo Bool
L.trusted Bool
False
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "import-dirs" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.importDirs
g InstalledPackageInfo
([String]
-> [String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "library-dirs" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.libraryDirs
g InstalledPackageInfo
([String]
-> String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
(String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "dynamic-library-dirs" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.libraryDynDirs
g InstalledPackageInfo
(String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo String
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> (String -> FilePathNT)
-> ALens' InstalledPackageInfo String
-> String
-> g InstalledPackageInfo String
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "data-dir" String -> FilePathNT
FilePathNT ALens' InstalledPackageInfo String
Lens' InstalledPackageInfo String
L.dataDir ""
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "hs-libraries" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.hsLibraries
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "extra-libraries" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.extraLibraries
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "extra-ghci-libraries" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.extraGHCiLibraries
g InstalledPackageInfo
([String]
-> [String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "include-dirs" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.includeDirs
g InstalledPackageInfo
([String]
-> [UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "includes" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.includes
g InstalledPackageInfo
([UnitId]
-> [AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [UnitId]
-> g InstalledPackageInfo
([AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([UnitId] -> List FSep (Identity UnitId) UnitId)
-> ALens' InstalledPackageInfo [UnitId]
-> g InstalledPackageInfo [UnitId]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "depends" (FSep -> [UnitId] -> List FSep (Identity UnitId) UnitId
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) ALens' InstalledPackageInfo [UnitId]
Lens' InstalledPackageInfo [UnitId]
L.depends
g InstalledPackageInfo
([AbiDependency]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [AbiDependency]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([AbiDependency]
-> List FSep (Identity AbiDependency) AbiDependency)
-> ALens' InstalledPackageInfo [AbiDependency]
-> g InstalledPackageInfo [AbiDependency]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "abi-depends" (FSep
-> [AbiDependency]
-> List FSep (Identity AbiDependency) AbiDependency
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList FSep
FSep) ALens' InstalledPackageInfo [AbiDependency]
Lens' InstalledPackageInfo [AbiDependency]
L.abiDepends
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "cc-options" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.ccOptions
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "cxx-options" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.cxxOptions
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "ld-options" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.ldOptions
g InstalledPackageInfo
([String]
-> [String]
-> [String]
-> [String]
-> Maybe String
-> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String]
-> [String] -> [String] -> Maybe String -> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "framework-dirs" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.frameworkDirs
g InstalledPackageInfo
([String]
-> [String] -> [String] -> Maybe String -> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String] -> [String] -> Maybe String -> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep Token String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "frameworks" (FSep -> (String -> Token) -> [String] -> List FSep Token String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> Token
Token) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.frameworks
g InstalledPackageInfo
([String] -> [String] -> Maybe String -> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo
([String] -> Maybe String -> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "haddock-interfaces" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.haddockInterfaces
g InstalledPackageInfo
([String] -> Maybe String -> InstalledPackageInfo)
-> g InstalledPackageInfo [String]
-> g InstalledPackageInfo (Maybe String -> InstalledPackageInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ([String] -> List FSep FilePathNT String)
-> ALens' InstalledPackageInfo [String]
-> g InstalledPackageInfo [String]
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla "haddock-html" (FSep
-> (String -> FilePathNT)
-> [String]
-> List FSep FilePathNT String
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' FSep
FSep String -> FilePathNT
FilePathNT) ALens' InstalledPackageInfo [String]
Lens' InstalledPackageInfo [String]
L.haddockHTMLs
g InstalledPackageInfo (Maybe String -> InstalledPackageInfo)
-> g InstalledPackageInfo (Maybe String)
-> g InstalledPackageInfo InstalledPackageInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> (String -> FilePathNT)
-> ALens' InstalledPackageInfo (Maybe String)
-> g InstalledPackageInfo (Maybe String)
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s (Maybe a) -> g s (Maybe a)
optionalFieldAla "pkgroot" String -> FilePathNT
FilePathNT ALens' InstalledPackageInfo (Maybe String)
Lens' InstalledPackageInfo (Maybe String)
L.pkgRoot
where
mkInstalledPackageInfo :: p
-> Basic
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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 _ Basic {..} = PackageId
-> LibraryName
-> ComponentId
-> LibraryVisibility
-> UnitId
-> [(ModuleName, OpenModule)]
-> String
-> Either License License
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> 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 "")
LibraryVisibility
_basicLibVisibility
where
MungedPackageName pn :: PackageName
pn ln :: LibraryName
ln = MungedPackageName
_basicName
{-# SPECIALIZE ipiFieldGrammar :: FieldDescrs InstalledPackageInfo InstalledPackageInfo #-}
{-# SPECIALIZE ipiFieldGrammar :: ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo #-}
{-# SPECIALIZE ipiFieldGrammar :: PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo #-}
unitedList :: Lens' a [b]
unitedList :: LensLike f a a [b] [b]
unitedList f :: [b] -> f [b]
f s :: a
s = a
s a -> f [b] -> f a
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 _) _ = LibraryName
l
combineLibraryName _ l :: LibraryName
l = LibraryName
l
showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules :: [ExposedModule] -> Doc
showExposedModules xs :: [ExposedModule]
xs
| (ExposedModule -> Bool) -> [ExposedModule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ExposedModule -> Bool
isExposedModule [ExposedModule]
xs = [Doc] -> Doc
Disp.fsep ((ExposedModule -> Doc) -> [ExposedModule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExposedModule -> Doc
forall a. Pretty a => a -> Doc
pretty [ExposedModule]
xs)
| Bool
otherwise = [Doc] -> Doc
Disp.fsep (Doc -> [Doc] -> [Doc]
Disp.punctuate Doc
Disp.comma ((ExposedModule -> Doc) -> [ExposedModule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExposedModule -> Doc
forall a. Pretty a => a -> Doc
pretty [ExposedModule]
xs))
where isExposedModule :: ExposedModule -> Bool
isExposedModule (ExposedModule _ Nothing) = Bool
True
isExposedModule _ = Bool
False
setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName Nothing ipi :: InstalledPackageInfo
ipi = InstalledPackageInfo
ipi
setMaybePackageName (Just pn :: PackageName
pn) ipi :: 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 pn :: PackageName
pn ln :: LibraryName
ln) ipi :: 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 ipi :: InstalledPackageInfo
ipi = case InstalledPackageInfo -> LibraryName
sourceLibName InstalledPackageInfo
ipi of
LMainLibName -> Maybe PackageName
forall a. Maybe a
Nothing
LSubLibName _ -> PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just (InstalledPackageInfo -> PackageName
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 :: m ExposedModules
parsec = [ExposedModule] -> ExposedModules
ExposedModules ([ExposedModule] -> ExposedModules)
-> m [ExposedModule] -> m ExposedModules
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ExposedModule -> m [ExposedModule]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m ExposedModule
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance Pretty ExposedModules where
pretty :: ExposedModules -> Doc
pretty = [ExposedModule] -> Doc
showExposedModules ([ExposedModule] -> Doc)
-> (ExposedModules -> [ExposedModule]) -> ExposedModules -> Doc
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 (String -> Doc)
-> (CompatPackageKey -> String) -> CompatPackageKey -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompatPackageKey -> String
getCompatPackageKey
instance Parsec CompatPackageKey where
parsec :: m CompatPackageKey
parsec = String -> CompatPackageKey
CompatPackageKey (String -> CompatPackageKey) -> m String -> m CompatPackageKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
uid_char where
uid_char :: Char -> Bool
uid_char c :: Char
c = Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("-_.=[],:<>+" :: 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 (OpenModuleSubst -> Doc)
-> (InstWith -> OpenModuleSubst) -> InstWith -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ModuleName, OpenModule)] -> OpenModuleSubst
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ModuleName, OpenModule)] -> OpenModuleSubst)
-> (InstWith -> [(ModuleName, OpenModule)])
-> InstWith
-> OpenModuleSubst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstWith -> [(ModuleName, OpenModule)]
getInstWith
instance Parsec InstWith where
parsec :: m InstWith
parsec = [(ModuleName, OpenModule)] -> InstWith
InstWith ([(ModuleName, OpenModule)] -> InstWith)
-> (OpenModuleSubst -> [(ModuleName, OpenModule)])
-> OpenModuleSubst
-> InstWith
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenModuleSubst -> [(ModuleName, OpenModule)]
forall k a. Map k a -> [(k, a)]
Map.toList (OpenModuleSubst -> InstWith) -> m OpenModuleSubst -> m InstWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m OpenModuleSubst
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 :: m SpecLicenseLenient
parsec = (Either License License -> SpecLicenseLenient)
-> m (Either License License) -> m SpecLicenseLenient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either License License -> SpecLicenseLenient
SpecLicenseLenient (m (Either License License) -> m SpecLicenseLenient)
-> m (Either License License) -> m SpecLicenseLenient
forall a b. (a -> b) -> a -> b
$ License -> Either License License
forall a b. a -> Either a b
Left (License -> Either License License)
-> m License -> m (Either License License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m License -> m License
forall (m :: * -> *) a. Parsing m => m a -> m a
P.try m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m (Either License License)
-> m (Either License License) -> m (Either License License)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> License -> Either License License
forall a b. b -> Either a b
Right (License -> Either License License)
-> m License -> m (Either License License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance Pretty SpecLicenseLenient where
pretty :: SpecLicenseLenient -> Doc
pretty = (License -> Doc)
-> (License -> Doc) -> Either License License -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> Doc
forall a. Pretty a => a -> Doc
pretty License -> Doc
forall a. Pretty a => a -> Doc
pretty (Either License License -> Doc)
-> (SpecLicenseLenient -> Either License License)
-> SpecLicenseLenient
-> Doc
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 :: LensLike f InstalledPackageInfo InstalledPackageInfo Basic Basic
basic f :: Basic -> f Basic
f ipi :: InstalledPackageInfo
ipi = Basic -> InstalledPackageInfo
g (Basic -> InstalledPackageInfo)
-> f Basic -> f InstalledPackageInfo
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)
(InstalledPackageInfo -> Version
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 n :: MungedPackageName
n v :: Version
v pn :: Maybe PackageName
pn ln :: LibraryName
ln lv :: LibraryVisibility
lv) = InstalledPackageInfo
ipi
InstalledPackageInfo
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
forall a b. a -> (a -> b) -> b
& MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMungedPackageName MungedPackageName
n
InstalledPackageInfo
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
forall a b. a -> (a -> b) -> b
& LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
PackageId
PackageId
Lens' InstalledPackageInfo PackageId
L.sourcePackageId LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
PackageId
PackageId
-> ((Version -> Identity Version)
-> PackageId -> Identity PackageId)
-> (Version -> Identity Version)
-> InstalledPackageInfo
-> Identity InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Identity Version) -> PackageId -> Identity PackageId
Lens' PackageId Version
L.pkgVersion ((Version -> Identity Version)
-> InstalledPackageInfo -> Identity InstalledPackageInfo)
-> Version -> InstalledPackageInfo -> InstalledPackageInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version
v
InstalledPackageInfo
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
forall a b. a -> (a -> b) -> b
& Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName Maybe PackageName
pn
InstalledPackageInfo
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
forall a b. a -> (a -> b) -> b
& LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
LibraryName
LibraryName
Lens' InstalledPackageInfo LibraryName
L.sourceLibName LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
LibraryName
LibraryName
-> LibraryName -> InstalledPackageInfo -> InstalledPackageInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LibraryName
ln
InstalledPackageInfo
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
forall a b. a -> (a -> b) -> b
& LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
LibraryVisibility
LibraryVisibility
Lens' InstalledPackageInfo LibraryVisibility
L.libVisibility LensLike
Identity
InstalledPackageInfo
InstalledPackageInfo
LibraryVisibility
LibraryVisibility
-> LibraryVisibility
-> InstalledPackageInfo
-> InstalledPackageInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LibraryVisibility
lv
basicName :: Lens' Basic MungedPackageName
basicName :: LensLike f Basic Basic MungedPackageName MungedPackageName
basicName f :: MungedPackageName -> f MungedPackageName
f b :: Basic
b = (\x :: MungedPackageName
x -> Basic
b { _basicName :: MungedPackageName
_basicName = MungedPackageName
x }) (MungedPackageName -> Basic) -> f MungedPackageName -> f Basic
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 :: LensLike f Basic Basic Version Version
basicVersion f :: Version -> f Version
f b :: Basic
b = (\x :: Version
x -> Basic
b { _basicVersion :: Version
_basicVersion = Version
x }) (Version -> Basic) -> f Version -> f Basic
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 :: LensLike f Basic Basic (Maybe PackageName) (Maybe PackageName)
basicPkgName f :: Maybe PackageName -> f (Maybe PackageName)
f b :: Basic
b = (\x :: Maybe PackageName
x -> Basic
b { _basicPkgName :: Maybe PackageName
_basicPkgName = Maybe PackageName
x }) (Maybe PackageName -> Basic) -> f (Maybe PackageName) -> f Basic
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 :: LensLike
f
Basic
Basic
(Maybe UnqualComponentName)
(Maybe UnqualComponentName)
basicLibName f :: Maybe UnqualComponentName -> f (Maybe UnqualComponentName)
f b :: Basic
b = (\x :: Maybe UnqualComponentName
x -> Basic
b { _basicLibName :: LibraryName
_basicLibName = Maybe UnqualComponentName -> LibraryName
maybeToLibraryName Maybe UnqualComponentName
x }) (Maybe UnqualComponentName -> Basic)
-> f (Maybe UnqualComponentName) -> f Basic
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 :: LensLike f Basic Basic LibraryVisibility LibraryVisibility
basicLibVisibility f :: LibraryVisibility -> f LibraryVisibility
f b :: Basic
b = (\x :: LibraryVisibility
x -> Basic
b { _basicLibVisibility :: LibraryVisibility
_basicLibVisibility = LibraryVisibility
x }) (LibraryVisibility -> Basic) -> f LibraryVisibility -> f Basic
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 g, Applicative (g Basic))
=> g Basic Basic
basicFieldGrammar :: g Basic Basic
basicFieldGrammar = MungedPackageName
-> Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic
mkBasic
(MungedPackageName
-> Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic)
-> g Basic MungedPackageName
-> g Basic
(Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> (MungedPackageName -> MQuoted MungedPackageName)
-> ALens' Basic MungedPackageName
-> MungedPackageName
-> g Basic MungedPackageName
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "name" MungedPackageName -> MQuoted MungedPackageName
forall a. a -> MQuoted a
MQuoted ALens' Basic MungedPackageName
Lens' Basic MungedPackageName
basicName (InstalledPackageInfo -> MungedPackageName
mungedPackageName InstalledPackageInfo
emptyInstalledPackageInfo)
g Basic
(Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic)
-> g Basic Version
-> g Basic
(Maybe PackageName
-> Maybe UnqualComponentName -> LibraryVisibility -> Basic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> (Version -> MQuoted Version)
-> ALens' Basic Version
-> Version
-> g Basic Version
forall (g :: * -> * -> *) b a s.
(FieldGrammar g, Parsec b, Pretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> g s a
optionalFieldDefAla "version" Version -> MQuoted Version
forall a. a -> MQuoted a
MQuoted ALens' Basic Version
Lens' Basic Version
basicVersion Version
nullVersion
g Basic
(Maybe PackageName
-> Maybe UnqualComponentName -> LibraryVisibility -> Basic)
-> g Basic (Maybe PackageName)
-> g Basic
(Maybe UnqualComponentName -> LibraryVisibility -> Basic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' Basic (Maybe PackageName) -> g Basic (Maybe PackageName)
forall (g :: * -> * -> *) a s.
(FieldGrammar g, Parsec a, Pretty a) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField "package-name" ALens' Basic (Maybe PackageName)
Lens' Basic (Maybe PackageName)
basicPkgName
g Basic (Maybe UnqualComponentName -> LibraryVisibility -> Basic)
-> g Basic (Maybe UnqualComponentName)
-> g Basic (LibraryVisibility -> Basic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' Basic (Maybe UnqualComponentName)
-> g Basic (Maybe UnqualComponentName)
forall (g :: * -> * -> *) a s.
(FieldGrammar g, Parsec a, Pretty a) =>
FieldName -> ALens' s (Maybe a) -> g s (Maybe a)
optionalField "lib-name" ALens' Basic (Maybe UnqualComponentName)
Lens' Basic (Maybe UnqualComponentName)
basicLibName
g Basic (LibraryVisibility -> Basic)
-> g Basic LibraryVisibility -> g Basic Basic
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<+> FieldName
-> ALens' Basic LibraryVisibility
-> LibraryVisibility
-> g Basic LibraryVisibility
forall (g :: * -> * -> *) s a.
(FieldGrammar g, Functor (g s), Parsec a, Pretty a, Eq a) =>
FieldName -> ALens' s a -> a -> g s a
optionalFieldDef "visibility" ALens' Basic LibraryVisibility
Lens' Basic LibraryVisibility
basicLibVisibility LibraryVisibility
LibraryVisibilityPrivate
where
mkBasic :: MungedPackageName
-> Version
-> Maybe PackageName
-> Maybe UnqualComponentName
-> LibraryVisibility
-> Basic
mkBasic n :: MungedPackageName
n v :: Version
v pn :: Maybe PackageName
pn ln :: Maybe UnqualComponentName
ln lv :: 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' = LibraryName
-> (UnqualComponentName -> LibraryName)
-> Maybe UnqualComponentName
-> LibraryName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LibraryName
LMainLibName UnqualComponentName -> LibraryName
LSubLibName Maybe UnqualComponentName
ln
lv' :: LibraryVisibility
lv' = if
let MungedPackageName _ mln :: LibraryName
mln = MungedPackageName
n in
LibraryName
ln' LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName Bool -> Bool -> Bool
&& LibraryName
mln LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName
then LibraryVisibility
LibraryVisibilityPublic
else LibraryVisibility
lv