module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
installedOpenUnitId,
sourceComponentName,
requiredSignatures,
ExposedModule(..),
AbiDependency(..),
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
showInstalledPackageInfo,
showFullInstalledPackageInfo,
showInstalledPackageInfoField,
showSimpleInstalledPackageInfoField,
) where
import Distribution.Compat.Prelude
import Prelude ()
import Data.Set (Set)
import Distribution.Backpack
import Distribution.CabalSpecVersion (cabalSpecLatest)
import Distribution.FieldGrammar
import Distribution.FieldGrammar.FieldDescrs
import Distribution.ModuleName
import Distribution.Package hiding (installedUnitId)
import Distribution.Types.ComponentName
import Distribution.Utils.Generic (toUTF8BS)
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 ipi =
case unComponentId (installedComponentId_ ipi) of
"" -> mkComponentId (unUnitId (installedUnitId ipi))
_ -> installedComponentId_ ipi
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId ipi
= mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
sourceComponentName :: InstalledPackageInfo -> ComponentName
sourceComponentName = CLibName . sourceLibName
parseInstalledPackageInfo
:: String
-> Either [String] ([String], InstalledPackageInfo)
parseInstalledPackageInfo s = case P.readFields (toUTF8BS s) of
Left err -> Left [show err]
Right fs -> case partitionFields fs of
(fs', _) -> case P.runParseResult $ parseFieldGrammar cabalSpecLatest fs' ipiFieldGrammar of
(ws, Right x) -> Right (ws', x) where
ws' = map (P.showPWarning "") ws
(_, Left (_, errs)) -> Left errs' where
errs' = map (P.showPError "") errs
showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo ipi =
showFullInstalledPackageInfo ipi { pkgRoot = Nothing }
showFullInstalledPackageInfo :: InstalledPackageInfo -> String
showFullInstalledPackageInfo = P.showFields (const []) . prettyFieldGrammar cabalSpecLatest ipiFieldGrammar
showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField fn =
fmap (\g -> Disp.render . ppField fn . g) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn)
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField fn =
fmap (Disp.renderStyle myStyle .) $ fieldDescrPretty ipiFieldGrammar (toUTF8BS fn)
where
myStyle = Disp.style { Disp.mode = Disp.LeftMode }
ppField :: String -> Disp.Doc -> Disp.Doc
ppField name fielddoc
| Disp.isEmpty fielddoc = mempty
| otherwise = Disp.text name <<>> Disp.colon Disp.<+> fielddoc