module Distribution.Simple.Program.HcPkg (
register,
reregister,
unregister,
expose,
hide,
dump,
registerInvocation,
reregisterInvocation,
unregisterInvocation,
exposeInvocation,
hideInvocation,
dumpInvocation,
) where
import Distribution.Package
( PackageId, InstalledPackageId(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, InstalledPackageInfo_(..)
, showInstalledPackageInfo
, emptyInstalledPackageInfo, fieldsInstalledPackageInfo )
import Distribution.ParseUtils
import Distribution.Simple.Compiler
( PackageDB(..), PackageDBStack )
import Distribution.Simple.Program.Types
( ConfiguredProgram(programId, programVersion) )
import Distribution.Simple.Program.Run
( ProgramInvocation(..), IOEncoding(..), programInvocation
, runProgramInvocation, getProgramInvocationOutput )
import Distribution.Version
( Version(..) )
import Distribution.Text
( display )
import Distribution.Simple.Utils
( die )
import Distribution.Verbosity
( Verbosity, deafening, silent )
import Distribution.Compat.Exception
( catchExit )
import Data.Char
( isSpace )
import Data.Maybe
( fromMaybe )
import Data.List
( stripPrefix )
import System.FilePath as FilePath
( (</>), splitPath, splitDirectories, joinPath, isPathSeparator )
import qualified System.FilePath.Posix as FilePath.Posix
register :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> IO ()
register verbosity hcPkg packagedb pkgFile =
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()runProgramInvocation verbosity :: Verbosityverbosity
(registerInvocation ::
ConfiguredProgram
-> Verbosity
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocationregisterInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb pkgFile :: Either FilePath InstalledPackageInfopkgFile)
reregister :: Verbosity -> ConfiguredProgram -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> IO ()
reregister verbosity hcPkg packagedb pkgFile =
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()runProgramInvocation verbosity :: Verbosityverbosity
(reregisterInvocation ::
ConfiguredProgram
-> Verbosity
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocationreregisterInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb pkgFile :: Either FilePath InstalledPackageInfopkgFile)
unregister :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
unregister verbosity hcPkg packagedb pkgid =
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()runProgramInvocation verbosity :: Verbosityverbosity
(unregisterInvocation ::
ConfiguredProgram
-> Verbosity
-> PackageDB
-> PackageId
-> ProgramInvocationunregisterInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb pkgid :: PackageIdpkgid)
expose :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
expose verbosity hcPkg packagedb pkgid =
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()runProgramInvocation verbosity :: Verbosityverbosity
(exposeInvocation ::
ConfiguredProgram
-> Verbosity
-> PackageDB
-> PackageId
-> ProgramInvocationexposeInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb pkgid :: PackageIdpkgid)
hide :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO ()
hide verbosity hcPkg packagedb pkgid =
runProgramInvocation :: Verbosity -> ProgramInvocation -> IO ()runProgramInvocation verbosity :: Verbosityverbosity
(hideInvocation ::
ConfiguredProgram
-> Verbosity
-> PackageDB
-> PackageId
-> ProgramInvocationhideInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb pkgid :: PackageIdpkgid)
dump :: Verbosity -> ConfiguredProgram -> PackageDB -> IO [InstalledPackageInfo]
dump verbosity hcPkg packagedb = do
output <- getProgramInvocationOutput ::
Verbosity -> ProgramInvocation -> IO StringgetProgramInvocationOutput verbosity :: Verbosityverbosity
(dumpInvocation ::
ConfiguredProgram -> Verbosity -> PackageDB -> ProgramInvocationdumpInvocation hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity packagedb :: PackageDBStackpackagedb)
catchExit :: IO a -> (ExitCode -> IO a) -> IO a`catchExit` \_ -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ programId :: ConfiguredProgram -> StringprogramId hcPkg :: ConfiguredProgramhcPkg (++) :: [a] -> [a] -> [a]++ " dump failed"
case parsePackages :: String -> Either [InstalledPackageInfo] [PError]parsePackages output :: Stringoutput of
Left ok -> return :: Monad m => forall a. a -> m areturn ok :: [InstalledPackageInfo]ok
_ -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "failed to parse output of '"
(++) :: [a] -> [a] -> [a]++ programId :: ConfiguredProgram -> StringprogramId hcPkg :: ConfiguredProgramhcPkg (++) :: [a] -> [a] -> [a]++ " dump'"
where
parsePackages str =
let parsed = map :: (a -> b) -> [a] -> [b]map parseInstalledPackageInfo' ::
String -> ParseResult (Maybe FilePath, InstalledPackageInfo)parseInstalledPackageInfo' (splitPkgs :: String -> [String]splitPkgs str :: Stringstr)
in case [ msg :: PErrormsg | ParseFailed msg <- parsed :: [ParseResult (Maybe FilePath, InstalledPackageInfo)]parsed ] of
[] -> Left :: a -> Either a bLeft [ setInstalledPackageId ::
InstalledPackageInfo -> InstalledPackageInfosetInstalledPackageId
(.) :: (b -> c) -> (a -> b) -> a -> c. maybe :: b -> (a -> b) -> Maybe a -> bmaybe id :: a -> aid mungePackagePaths ::
FilePath -> InstalledPackageInfo -> InstalledPackageInfomungePackagePaths pkgroot :: Maybe FilePathpkgroot
($) :: (a -> b) -> a -> b$ pkg :: InstalledPackageInfopkg
| ParseOk _ (pkgroot, pkg) <- parsed :: [ParseResult (Maybe FilePath, InstalledPackageInfo)]parsed ]
msgs -> Right :: b -> Either a bRight msgs :: [PError]msgs
parseInstalledPackageInfo' =
parseFieldsFlat :: [FieldDescr a] -> a -> String -> ParseResult aparseFieldsFlat fields :: [FieldDescr (Maybe FilePath, InstalledPackageInfo)]fields (Nothing :: Maybe aNothing, emptyInstalledPackageInfo :: InstalledPackageInfo_ memptyInstalledPackageInfo)
where
fields = liftFieldFst :: FieldDescr a -> FieldDescr (a, b)liftFieldFst pkgrootField :: FieldDescr (Maybe FilePath)pkgrootField
(:) :: a -> [a] -> [a]: map :: (a -> b) -> [a] -> [b]map liftFieldSnd :: FieldDescr a -> FieldDescr (a1, a)liftFieldSnd fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]fieldsInstalledPackageInfo
pkgrootField =
simpleField ::
String
-> (a -> Doc)
-> ReadP a a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr bsimpleField "pkgroot"
showFilePath :: FilePath -> DocshowFilePath parseFilePathQ :: ReadP r FilePathparseFilePathQ
(fromMaybe :: a -> Maybe a -> afromMaybe "") (\x _ -> Just :: a -> Maybe aJust x :: FilePathx)
liftFieldFst = liftField ::
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField fst :: (a, b) -> afst (\x (_x,y) -> (x :: FilePathx,y :: by))
liftFieldSnd = liftField ::
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr bliftField snd :: (a, b) -> bsnd (\y (x,_y) -> (x :: FilePathx,y :: by))
splitPkgs :: String -> [String]
splitPkgs = checkEmpty :: [[Char]] -> [[Char]]checkEmpty (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map unlines :: [String] -> Stringunlines (.) :: (b -> c) -> (a -> b) -> a -> c. splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith ("---" (==) :: Eq a => a -> a -> Bool==) (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
where
checkEmpty [s] | all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolisSpace s :: [Char]s = [] :: [a][]
checkEmpty ss = ss :: [[Char]]ss
splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith p xs = ys :: [a]ys (:) :: a -> [a] -> [a]: case zs :: [a]zs of
[] -> [] :: [a][]
_:ws -> splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith p :: a -> Boolp ws :: [a]ws
where (ys,zs) = break :: (a -> Bool) -> [a] -> ([a], [a])break p :: a -> Boolp xs :: [a]xs
mungePackagePaths :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
mungePackagePaths pkgroot pkginfo =
pkginfo :: InstalledPackageInfopkginfo {
importDirs = mungePaths :: [FilePath] -> [FilePath]mungePaths (importDirs :: InstalledPackageInfo_ m -> [FilePath]importDirs pkginfo :: InstalledPackageInfopkginfo),
includeDirs = mungePaths :: [FilePath] -> [FilePath]mungePaths (includeDirs :: InstalledPackageInfo_ m -> [FilePath]includeDirs pkginfo :: InstalledPackageInfopkginfo),
libraryDirs = mungePaths :: [FilePath] -> [FilePath]mungePaths (libraryDirs :: InstalledPackageInfo_ m -> [FilePath]libraryDirs pkginfo :: InstalledPackageInfopkginfo),
frameworkDirs = mungePaths :: [FilePath] -> [FilePath]mungePaths (frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]frameworkDirs pkginfo :: InstalledPackageInfopkginfo),
haddockInterfaces = mungePaths :: [FilePath] -> [FilePath]mungePaths (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]haddockInterfaces pkginfo :: InstalledPackageInfopkginfo),
haddockHTMLs = mungeUrls :: [FilePath] -> [[Char]]mungeUrls (haddockHTMLs :: InstalledPackageInfo_ m -> [FilePath]haddockHTMLs pkginfo :: InstalledPackageInfopkginfo)
}
where
mungePaths = map :: (a -> b) -> [a] -> [b]map mungePath :: FilePath -> FilePathmungePath
mungeUrls = map :: (a -> b) -> [a] -> [b]map mungeUrl :: FilePath -> [Char]mungeUrl
mungePath p = case stripVarPrefix :: [Char] -> FilePath -> Maybe FilePathstripVarPrefix "${pkgroot}" p :: a -> Boolp of
Just p' -> pkgroot :: Maybe FilePathpkgroot (</>) :: FilePath -> FilePath -> FilePath</> p' :: FilePathp'
Nothing -> p :: a -> Boolp
mungeUrl p = case stripVarPrefix :: [Char] -> FilePath -> Maybe FilePathstripVarPrefix "${pkgrooturl}" p :: a -> Boolp of
Just p' -> toUrlPath :: FilePath -> FilePath -> [Char]toUrlPath pkgroot :: Maybe FilePathpkgroot p' :: FilePathp'
Nothing -> p :: a -> Boolp
toUrlPath r p = "file:///"
(++) :: [a] -> [a] -> [a]++ joinPath :: [FilePath] -> FilePathFilePath.Posix.joinPath (r :: FilePathr (:) :: a -> [a] -> [a]: splitDirectories :: FilePath -> [FilePath]FilePath.splitDirectories p :: a -> Boolp)
stripVarPrefix var p =
case splitPath :: FilePath -> [FilePath]splitPath p :: a -> Boolp of
(root:path') -> case stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]stripPrefix var :: [Char]var root :: FilePathroot of
Just [sep] | isPathSeparator :: Char -> BoolisPathSeparator sep :: Charsep -> Just :: a -> Maybe aJust (joinPath :: [FilePath] -> FilePathjoinPath path' :: [FilePath]path')
_ -> Nothing :: Maybe aNothing
_ -> Nothing :: Maybe aNothing
setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo
setInstalledPackageId pkginfo@InstalledPackageInfo {
installedPackageId = InstalledPackageId "",
sourcePackageId = pkgid
}
= pkginfo :: InstalledPackageInfopkginfo {
installedPackageId = InstalledPackageId :: String -> InstalledPackageIdInstalledPackageId (display :: Text a => a -> Stringdisplay pkgid :: PackageIdpkgid)
}
setInstalledPackageId pkginfo = pkginfo :: InstalledPackageInfopkginfo
registerInvocation, reregisterInvocation
:: ConfiguredProgram -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocation
registerInvocation = registerInvocation' ::
String
-> ConfiguredProgram
-> Verbosity
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocationregisterInvocation' "register"
reregisterInvocation = registerInvocation' ::
String
-> ConfiguredProgram
-> Verbosity
-> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocationregisterInvocation' "update"
registerInvocation' :: String
-> ConfiguredProgram -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocation
registerInvocation' cmdname hcPkg verbosity packagedbs (Left pkgFile) =
programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg args :: [String]args
where
args = [cmdname :: Stringcmdname, pkgFile :: Either FilePath InstalledPackageInfopkgFile]
(++) :: [a] -> [a] -> [a]++ (if legacyVersion :: ConfiguredProgram -> BoollegacyVersion hcPkg :: ConfiguredProgramhcPkg
then [packageDbOpts :: PackageDB -> StringpackageDbOpts (last :: [a] -> alast packagedbs :: PackageDBStackpackagedbs)]
else packageDbStackOpts :: PackageDBStack -> [String]packageDbStackOpts packagedbs :: PackageDBStackpackagedbs)
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity
registerInvocation' cmdname hcPkg verbosity packagedbs (Right pkgInfo) =
(programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg args :: [String]args) {
progInvokeInput = Just :: a -> Maybe aJust (showInstalledPackageInfo :: InstalledPackageInfo -> StringshowInstalledPackageInfo pkgInfo :: InstalledPackageInfopkgInfo),
progInvokeInputEncoding = IOEncodingUTF8 :: IOEncodingIOEncodingUTF8
}
where
args = [cmdname :: Stringcmdname, "-"]
(++) :: [a] -> [a] -> [a]++ (if legacyVersion :: ConfiguredProgram -> BoollegacyVersion hcPkg :: ConfiguredProgramhcPkg
then [packageDbOpts :: PackageDB -> StringpackageDbOpts (last :: [a] -> alast packagedbs :: PackageDBStackpackagedbs)]
else packageDbStackOpts :: PackageDBStack -> [String]packageDbStackOpts packagedbs :: PackageDBStackpackagedbs)
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity
unregisterInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> PackageId
-> ProgramInvocation
unregisterInvocation hcPkg verbosity packagedb pkgid =
programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg ($) :: (a -> b) -> a -> b$
["unregister", packageDbOpts :: PackageDB -> StringpackageDbOpts packagedb :: PackageDBStackpackagedb, display :: Text a => a -> Stringdisplay pkgid :: PackageIdpkgid]
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity
exposeInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
exposeInvocation hcPkg verbosity packagedb pkgid =
programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg ($) :: (a -> b) -> a -> b$
["expose", packageDbOpts :: PackageDB -> StringpackageDbOpts packagedb :: PackageDBStackpackagedb, display :: Text a => a -> Stringdisplay pkgid :: PackageIdpkgid]
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity
hideInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
hideInvocation hcPkg verbosity packagedb pkgid =
programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg ($) :: (a -> b) -> a -> b$
["hide", packageDbOpts :: PackageDB -> StringpackageDbOpts packagedb :: PackageDBStackpackagedb, display :: Text a => a -> Stringdisplay pkgid :: PackageIdpkgid]
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg verbosity :: Verbosityverbosity
dumpInvocation :: ConfiguredProgram
-> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation hcPkg _verbosity packagedb =
(programInvocation ::
ConfiguredProgram -> [String] -> ProgramInvocationprogramInvocation hcPkg :: ConfiguredProgramhcPkg args :: [String]args) {
progInvokeOutputEncoding = IOEncodingUTF8 :: IOEncodingIOEncodingUTF8
}
where
args = ["dump", packageDbOpts :: PackageDB -> StringpackageDbOpts packagedb :: PackageDBStackpackagedb]
(++) :: [a] -> [a] -> [a]++ verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]verbosityOpts hcPkg :: ConfiguredProgramhcPkg silent :: Verbositysilent
packageDbStackOpts :: PackageDBStack -> [String]
packageDbStackOpts dbstack = case dbstack :: PackageDBStackdbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> "--global"
(:) :: a -> [a] -> [a]: "--user"
(:) :: a -> [a] -> [a]: map :: (a -> b) -> [a] -> [b]map specific :: PackageDB -> [Char]specific dbs :: [PackageDB]dbs
(GlobalPackageDB:dbs) -> "--global"
(:) :: a -> [a] -> [a]: "--no-user-package-conf"
(:) :: a -> [a] -> [a]: map :: (a -> b) -> [a] -> [b]map specific :: PackageDB -> [Char]specific dbs :: [PackageDB]dbs
_ -> ierror :: aierror
where
specific (SpecificPackageDB db) = "--package-conf=" (++) :: [a] -> [a] -> [a]++ db :: FilePathdb
specific _ = ierror :: aierror
ierror :: a
ierror = error :: [Char] -> aerror ("internal error: unexpected package db stack: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow dbstack :: PackageDBStackdbstack)
packageDbOpts :: PackageDB -> String
packageDbOpts GlobalPackageDB = "--global"
packageDbOpts UserPackageDB = "--user"
packageDbOpts (SpecificPackageDB db) = "--package-conf=" (++) :: [a] -> [a] -> [a]++ db :: FilePathdb
verbosityOpts :: ConfiguredProgram -> Verbosity -> [String]
verbosityOpts hcPkg v
| programId :: ConfiguredProgram -> StringprogramId hcPkg :: ConfiguredProgramhcPkg (==) :: Eq a => a -> a -> Bool== "ghc-pkg"
(&&) :: Bool -> Bool -> Bool&& programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion hcPkg :: ConfiguredProgramhcPkg (<) :: Ord a => a -> a -> Bool< Just :: a -> Maybe aJust (Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][])
= [] :: [a][]
| v :: Verbosityv (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = ["-v2"]
| v :: Verbosityv (==) :: Eq a => a -> a -> Bool== silent :: Verbositysilent = ["-v0"]
| otherwise :: Boolotherwise = [] :: [a][]
legacyVersion :: ConfiguredProgram -> Bool
legacyVersion hcPkg = programId :: ConfiguredProgram -> StringprogramId hcPkg :: ConfiguredProgramhcPkg (==) :: Eq a => a -> a -> Bool== "ghc-pkg"
(&&) :: Bool -> Bool -> Bool&& programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion hcPkg :: ConfiguredProgramhcPkg (<) :: Ord a => a -> a -> Bool< Just :: a -> Maybe aJust (Version :: [Int] -> [String] -> VersionVersion [6,9] [] :: [a][])