module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
installedOpenUnitId,
sourceComponentName,
requiredSignatures,
ExposedModule(..),
AbiDependency(..),
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
showInstalledPackageInfo,
showFullInstalledPackageInfo,
showInstalledPackageInfoField,
showSimpleInstalledPackageInfoField,
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.Backpack
import Distribution.CabalSpecVersion (cabalSpecLatest)
import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.Fields.Pretty
import Distribution.ModuleName
import Distribution.Package hiding (installedUnitId)
import Distribution.Types.ComponentName
import Distribution.Utils.Generic (toUTF8BS)
import Data.ByteString (ByteString)
import qualified Data.Map as Map
import qualified Distribution.Fields as P
import qualified Text.PrettyPrint as Disp
import Distribution.Types.InstalledPackageInfo
import Distribution.Types.InstalledPackageInfo.FieldGrammar
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId InstalledPackageInfo
ipi =
case ComponentId -> String
unComponentId (InstalledPackageInfo -> ComponentId
installedComponentId_ InstalledPackageInfo
ipi) of
String
"" -> String -> ComponentId
mkComponentId (UnitId -> String
unUnitId (InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
ipi))
String
_ -> InstalledPackageInfo -> ComponentId
installedComponentId_ InstalledPackageInfo
ipi
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId InstalledPackageInfo
ipi
= UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId (InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
ipi) (InstalledPackageInfo -> ComponentId
installedComponentId InstalledPackageInfo
ipi) ([(ModuleName, OpenModule)] -> OpenModuleSubst
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
instantiatedWith InstalledPackageInfo
ipi))
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures InstalledPackageInfo
ipi = OpenModuleSubst -> Set ModuleName
openModuleSubstFreeHoles ([(ModuleName, OpenModule)] -> OpenModuleSubst
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (InstalledPackageInfo -> [(ModuleName, OpenModule)]
instantiatedWith InstalledPackageInfo
ipi))
sourceComponentName :: InstalledPackageInfo -> ComponentName
sourceComponentName :: InstalledPackageInfo -> ComponentName
sourceComponentName = LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName)
-> (InstalledPackageInfo -> LibraryName)
-> InstalledPackageInfo
-> ComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> LibraryName
sourceLibName
parseInstalledPackageInfo
:: ByteString
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
parseInstalledPackageInfo :: ByteString
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
parseInstalledPackageInfo ByteString
s = case ByteString -> Either ParseError [Field Position]
P.readFields ByteString
s of
Left ParseError
err -> NonEmpty String
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
forall a b. a -> Either a b
Left (ParseError -> String
forall a. Show a => a -> String
show ParseError
err String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [])
Right [Field Position]
fs -> case [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fs of
(Fields Position
fs', [[Section Position]]
_) -> case ParseResult InstalledPackageInfo
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) InstalledPackageInfo)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
P.runParseResult (ParseResult InstalledPackageInfo
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) InstalledPackageInfo))
-> ParseResult InstalledPackageInfo
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) InstalledPackageInfo)
forall a b. (a -> b) -> a -> b
$ CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo
-> ParseResult InstalledPackageInfo
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fs' ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo
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 of
([PWarning]
ws, Right InstalledPackageInfo
x) -> InstalledPackageInfo
x InstalledPackageInfo
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
forall a b. NFData a => a -> b -> b
`deepseq` ([String], InstalledPackageInfo)
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
forall a b. b -> Either a b
Right ([String]
ws', InstalledPackageInfo
x) where
ws' :: [String]
ws' = [ String -> PWarning -> String
P.showPWarning String
"" PWarning
w
| w :: PWarning
w@(P.PWarning PWarnType
wt Position
_ String
_) <- [PWarning]
ws
, PWarnType
wt PWarnType -> PWarnType -> Bool
forall a. Eq a => a -> a -> Bool
/= PWarnType
P.PWTExperimental
]
([PWarning]
_, Left (Maybe Version
_, NonEmpty PError
errs)) -> NonEmpty String
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
forall a b. a -> Either a b
Left NonEmpty String
errs' where
errs' :: NonEmpty String
errs' = (PError -> String) -> NonEmpty PError -> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> PError -> String
P.showPError String
"") NonEmpty PError
errs
showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo InstalledPackageInfo
ipi =
InstalledPackageInfo -> String
showFullInstalledPackageInfo InstalledPackageInfo
ipi { pkgRoot :: Maybe String
pkgRoot = Maybe String
forall a. Maybe a
Nothing }
showFullInstalledPackageInfo :: InstalledPackageInfo -> String
showFullInstalledPackageInfo :: InstalledPackageInfo -> String
showFullInstalledPackageInfo = (() -> CommentPosition) -> [PrettyField ()] -> String
forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
P.showFields (CommentPosition -> () -> CommentPosition
forall a b. a -> b -> a
const CommentPosition
NoComment) ([PrettyField ()] -> String)
-> (InstalledPackageInfo -> [PrettyField ()])
-> InstalledPackageInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion
-> PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo
-> InstalledPackageInfo
-> [PrettyField ()]
forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
cabalSpecLatest PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo
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
showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField String
fn =
((InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String)
-> Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\InstalledPackageInfo -> Doc
g -> Doc -> String
Disp.render (Doc -> String)
-> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> Doc
ppField String
fn (Doc -> Doc)
-> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> Doc
g) (Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String))
-> Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String)
forall a b. (a -> b) -> a -> b
$ FieldDescrs InstalledPackageInfo InstalledPackageInfo
-> ByteString -> Maybe (InstalledPackageInfo -> Doc)
forall s a. FieldDescrs s a -> ByteString -> Maybe (s -> Doc)
fieldDescrPretty FieldDescrs InstalledPackageInfo InstalledPackageInfo
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 (String -> ByteString
toUTF8BS String
fn)
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField String
fn =
((InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String)
-> Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Style -> Doc -> String
Disp.renderStyle Style
myStyle (Doc -> String)
-> (InstalledPackageInfo -> Doc) -> InstalledPackageInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String))
-> Maybe (InstalledPackageInfo -> Doc)
-> Maybe (InstalledPackageInfo -> String)
forall a b. (a -> b) -> a -> b
$ FieldDescrs InstalledPackageInfo InstalledPackageInfo
-> ByteString -> Maybe (InstalledPackageInfo -> Doc)
forall s a. FieldDescrs s a -> ByteString -> Maybe (s -> Doc)
fieldDescrPretty FieldDescrs InstalledPackageInfo InstalledPackageInfo
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 (String -> ByteString
toUTF8BS String
fn)
where
myStyle :: Style
myStyle = Style
Disp.style { mode :: Mode
Disp.mode = Mode
Disp.LeftMode }
ppField :: String -> Disp.Doc -> Disp.Doc
ppField :: String -> Doc -> Doc
ppField String
name Doc
fielddoc
| Doc -> Bool
Disp.isEmpty Doc
fielddoc = Doc
forall a. Monoid a => a
mempty
| Bool
otherwise = String -> Doc
Disp.text String
name Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
Disp.<+> Doc
fielddoc