Commit 40f3601e authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Remove support for Hugs and NHC98.

Fixes #2130.
parent cfda520f
......@@ -183,13 +183,11 @@ library
Distribution.Simple.Haddock
Distribution.Simple.HaskellSuite
Distribution.Simple.Hpc
Distribution.Simple.Hugs
Distribution.Simple.Install
Distribution.Simple.InstallDirs
Distribution.Simple.JHC
Distribution.Simple.LHC
Distribution.Simple.LocalBuildInfo
Distribution.Simple.NHC
Distribution.Simple.PackageIndex
Distribution.Simple.PreProcess
Distribution.Simple.PreProcess.Unlit
......
......@@ -38,6 +38,7 @@ import qualified System.Posix
-- This is here for Haskell implementations that do not come with
-- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.
-- TODO: Not sure about JHC
-- TODO: This file should probably be removed.
-- This is a copy/paste of the openBinaryTempFile definition, but
-- if uses 666 rather than 600 for the permissions. The base library
......
......@@ -120,7 +120,7 @@ data InstalledPackageInfo_ m
reexportedModules :: [ModuleReexport],
hiddenModules :: [m],
trusted :: Bool,
importDirs :: [FilePath], -- contain sources in case of Hugs
importDirs :: [FilePath],
libraryDirs :: [FilePath],
hsLibraries :: [String],
extraLibraries :: [String],
......@@ -128,7 +128,6 @@ data InstalledPackageInfo_ m
includeDirs :: [FilePath],
includes :: [String],
depends :: [InstalledPackageId],
hugsOptions :: [String],
ccOptions :: [String],
ldOptions :: [String],
frameworkDirs :: [FilePath],
......@@ -179,7 +178,6 @@ emptyInstalledPackageInfo
includeDirs = [],
includes = [],
depends = [],
hugsOptions = [],
ccOptions = [],
ldOptions = [],
frameworkDirs = [],
......@@ -328,9 +326,6 @@ installedFieldDescrs = [
, listField "depends"
disp parse
depends (\xs pkg -> pkg{depends=xs})
, listField "hugs-options"
showToken parseTokenQ
hugsOptions (\path pkg -> pkg{hugsOptions=path})
, listField "cc-options"
showToken parseTokenQ
ccOptions (\path pkg -> pkg{ccOptions=path})
......
......@@ -464,12 +464,15 @@ binfoFieldDescrs =
ghcSharedOptions (\val binfo -> binfo{ghcSharedOptions=val})
, optsField "ghc-options" GHC
options (\path binfo -> binfo{options=path})
, optsField "hugs-options" Hugs
options (\path binfo -> binfo{options=path})
, optsField "nhc98-options" NHC
options (\path binfo -> binfo{options=path})
, optsField "jhc-options" JHC
options (\path binfo -> binfo{options=path})
-- NOTE: Hugs and NHC are not supported anymore, but these fields are kept
-- around for backwards compatibility.
, optsField "hugs-options" Hugs
options (const id)
, optsField "nhc98-options" NHC
options (const id)
]
storeXFieldsBI :: UnrecFieldParser BuildInfo
......
......@@ -26,8 +26,6 @@ module Distribution.Simple.Build (
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
......@@ -475,8 +473,6 @@ buildLib verbosity numJobs pkg_descr lbi lib clbi =
GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi
LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi
Hugs -> Hugs.buildLib verbosity pkg_descr lbi lib clbi
NHC -> NHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
_ -> die "Building is not supported with this compiler."
......@@ -489,8 +485,6 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi
LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi
Hugs -> Hugs.buildExe verbosity pkg_descr lbi exe clbi
NHC -> NHC.buildExe verbosity pkg_descr lbi exe clbi
UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
_ -> die "Building is not supported with this compiler."
......
......@@ -49,7 +49,7 @@ import Data.Maybe
generate :: PackageDescription -> LocalBuildInfo -> String
generate pkg_descr lbi =
let pragmas
| absolute || isHugs = ""
| absolute = ""
| supports_language_pragma =
"{-# LANGUAGE ForeignFunctionInterface #-}\n"
| otherwise =
......@@ -58,7 +58,6 @@ generate pkg_descr lbi =
foreign_imports
| absolute = ""
| isHugs = "import System.Environment\n"
| otherwise =
"import Foreign\n"++
"import Foreign.C\n"
......@@ -143,8 +142,7 @@ generate pkg_descr lbi =
libdir = flat_libdirrel,
datadir = flat_datadirrel,
libexecdir = flat_libexecdirrel,
sysconfdir = flat_sysconfdirrel,
progdir = flat_progdirrel
sysconfdir = flat_sysconfdirrel
} = prefixRelativeInstallDirs (packageId pkg_descr) lbi
mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel
......@@ -158,10 +156,8 @@ generate pkg_descr lbi =
absolute =
hasLibs pkg_descr -- we can only make progs relocatable
|| isNothing flat_bindirrel -- if the bin dir is an absolute path
|| (isHugs && isNothing flat_progdirrel)
|| not (supportsRelocatableProgs (compilerFlavor (compiler lbi)))
supportsRelocatableProgs Hugs = True
supportsRelocatableProgs GHC = case buildOS of
Windows -> True
_ -> False
......@@ -169,12 +165,7 @@ generate pkg_descr lbi =
paths_modulename = autogenModuleName pkg_descr
isHugs = compilerFlavor (compiler lbi) == Hugs
get_prefix_stuff
| isHugs = "progdirrel :: String\n"++
"progdirrel = "++show (fromJust flat_progdirrel)++"\n\n"++
get_prefix_hugs
| otherwise = get_prefix_win32 buildArch
get_prefix_stuff = get_prefix_win32 buildArch
path_sep = show [pathSeparator]
......@@ -218,15 +209,6 @@ get_prefix_win32 arch =
X86_64 -> "ccall"
_ -> error "win32 supported only with I386, X86_64"
get_prefix_hugs :: String
get_prefix_hugs =
"getPrefixDirRel :: FilePath -> IO FilePath\n"++
"getPrefixDirRel dirRel = do\n"++
" mainPath <- getProgName\n"++
" let (progPath,_) = splitFileName mainPath\n"++
" let (progdir,_) = splitFileName progPath\n"++
" return ((progdir `minusFileName` progdirrel) `joinFileName` dirRel)\n"
filename_stuff :: String
filename_stuff =
"minusFileName :: FilePath -> String -> FilePath\n"++
......
......@@ -107,9 +107,8 @@ exeExtension = case buildOS of
Windows -> "exe"
_ -> ""
-- ToDo: This should be determined via autoconf (AC_OBJEXT)
-- | Extension for object files. For GHC and NHC the extension is @\"o\"@.
-- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler.
-- TODO: This should be determined via autoconf (AC_OBJEXT)
-- | Extension for object files. For GHC the extension is @\"o\"@.
objExtension :: String
objExtension = "o"
......
......@@ -113,8 +113,6 @@ import Distribution.Verbosity
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
......@@ -604,9 +602,6 @@ configure (pkg_descr0, pbi) cfg
compiler = comp,
hostPlatform = compPlatform,
buildDir = buildDir',
scratchDir = fromFlagOrDefault
(distPref </> "scratch")
(configScratchDir cfg),
componentsConfigs = buildComponents,
installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing,
......@@ -782,10 +777,8 @@ getInstalledPackages verbosity comp packageDBs progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getInstalledPackages verbosity packageDBs progconf
Hugs->Hugs.getInstalledPackages verbosity packageDBs progconf
JHC -> JHC.getInstalledPackages verbosity packageDBs progconf
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
NHC -> NHC.getInstalledPackages verbosity packageDBs progconf
UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
HaskellSuite {} ->
HaskellSuite.getInstalledPackages verbosity packageDBs progconf
......@@ -1056,8 +1049,6 @@ configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do
JHC -> JHC.configure verbosity hcPath hcPkg conf
LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf
LHC.configure verbosity hcPath Nothing ghcConf
Hugs -> Hugs.configure verbosity hcPath hcPkg conf
NHC -> NHC.configure verbosity hcPath hcPkg conf
UHC -> UHC.configure verbosity hcPath hcPkg conf
HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
......
......@@ -9,7 +9,7 @@
--
module Distribution.Simple.GHC.IPI641 (
InstalledPackageInfo,
InstalledPackageInfo(..),
toCurrent,
) where
......@@ -94,7 +94,6 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.includeDirs = includeDirs ipi,
Current.includes = includes ipi,
Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi),
Current.hugsOptions = hugsOptions ipi,
Current.ccOptions = ccOptions ipi,
Current.ldOptions = ldOptions ipi,
Current.frameworkDirs = frameworkDirs ipi,
......
......@@ -9,7 +9,7 @@
--
module Distribution.Simple.GHC.IPI642 (
InstalledPackageInfo,
InstalledPackageInfo(..),
toCurrent,
-- Don't use these, they're only for conversion purposes
......@@ -129,7 +129,6 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.includeDirs = includeDirs ipi,
Current.includes = includes ipi,
Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi),
Current.hugsOptions = hugsOptions ipi,
Current.ccOptions = ccOptions ipi,
Current.ldOptions = ldOptions ipi,
Current.frameworkDirs = frameworkDirs ipi,
......
This diff is collapsed.
......@@ -30,13 +30,11 @@ import Distribution.Simple.Utils
, die, info, notice, warn, matchDirFileGlob )
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.Simple.Setup (CopyFlags(..), CopyDest(..), fromFlag)
import Distribution.Simple.Setup (CopyFlags(..), fromFlag)
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.NHC as NHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
......@@ -51,8 +49,7 @@ import Distribution.Text
( display )
-- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\"
-- actions. Move files into place based on the prefix argument. FIX:
-- actions. Move files into place based on the prefix argument.
install :: PackageDescription -- ^information from the .cabal file
-> LocalBuildInfo -- ^information from the configure step
......@@ -67,7 +64,6 @@ install pkg_descr lbi flags = do
libdir = libPref,
-- dynlibdir = dynlibPref, --see TODO below
datadir = dataPref,
progdir = progPref,
docdir = docPref,
htmldir = htmlPref,
haddockdir = interfacePref,
......@@ -142,12 +138,6 @@ install pkg_descr lbi flags = do
JHC.installLib verbosity libPref buildPref pkg_descr
withExe pkg_descr $
JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr
Hugs -> do
let targetProgPref = progdir (absoluteInstallDirs pkg_descr lbi NoCopyDest)
let scratchPref = scratchDir lbi
Hugs.install verbosity lbi libPref progPref binPref targetProgPref scratchPref (progPrefixPref, progSuffixPref) pkg_descr
NHC -> do withLibLBI pkg_descr lbi $ NHC.installLib verbosity libPref buildPref (packageId pkg_descr)
withExe pkg_descr $ NHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref)
UHC -> do withLib pkg_descr $ UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
HaskellSuite {} ->
withLib pkg_descr $
......
......@@ -84,7 +84,6 @@ data InstallDirs dir = InstallDirs {
libsubdir :: dir,
dynlibdir :: dir,
libexecdir :: dir,
progdir :: dir,
includedir :: dir,
datadir :: dir,
datasubdir :: dir,
......@@ -105,7 +104,6 @@ instance Functor InstallDirs where
libsubdir = f (libsubdir dirs),
dynlibdir = f (dynlibdir dirs),
libexecdir = f (libexecdir dirs),
progdir = f (progdir dirs),
includedir = f (includedir dirs),
datadir = f (datadir dirs),
datasubdir = f (datasubdir dirs),
......@@ -124,7 +122,6 @@ instance Monoid dir => Monoid (InstallDirs dir) where
libsubdir = mempty,
dynlibdir = mempty,
libexecdir = mempty,
progdir = mempty,
includedir = mempty,
datadir = mempty,
datasubdir = mempty,
......@@ -147,7 +144,6 @@ combineInstallDirs combine a b = InstallDirs {
libsubdir = libsubdir a `combine` libsubdir b,
dynlibdir = dynlibdir a `combine` dynlibdir b,
libexecdir = libexecdir a `combine` libexecdir b,
progdir = progdir a `combine` progdir b,
includedir = includedir a `combine` includedir b,
datadir = datadir a `combine` datadir b,
datasubdir = datasubdir a `combine` datasubdir b,
......@@ -213,7 +209,6 @@ defaultInstallDirs comp userInstall _hasLibs = do
bindir = "$prefix" </> "bin",
libdir = installLibDir,
libsubdir = case comp of
Hugs -> "hugs" </> "packages" </> "$pkg"
JHC -> "$compiler"
LHC -> "$compiler"
UHC -> "$pkgid"
......@@ -222,7 +217,6 @@ defaultInstallDirs comp userInstall _hasLibs = do
libexecdir = case buildOS of
Windows -> "$prefix" </> "$pkgkey"
_other -> "$prefix" </> "libexec",
progdir = "$libdir" </> "hugs" </> "programs",
includedir = "$libdir" </> "$libsubdir" </> "include",
datadir = case buildOS of
Windows -> "$prefix"
......@@ -262,7 +256,6 @@ substituteInstallDirTemplates env dirs = dirs'
libsubdir = subst libsubdir [],
dynlibdir = subst dynlibdir [prefixVar, bindirVar, libdirVar],
libexecdir = subst libexecdir prefixBinLibVars,
progdir = subst progdir prefixBinLibVars,
includedir = subst includedir prefixBinLibVars,
datadir = subst datadir prefixBinLibVars,
datasubdir = subst datasubdir [],
......
......@@ -110,9 +110,6 @@ data LocalBuildInfo = LocalBuildInfo {
-- ^ The platform we're building for
buildDir :: FilePath,
-- ^ Where to build the package.
--TODO: eliminate hugs's scratchDir, use builddir
scratchDir :: FilePath,
-- ^ Where to put the result of the Hugs build.
componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])],
-- ^ All the components to build, ordered by topological sort, and with their dependencies
-- over the intrapackage dependency graph
......
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.NHC
-- Copyright : Isaac Jones 2003-2006
-- Duncan Coutts 2009
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This module contains most of the NHC-specific code for configuring, building
-- and installing packages.
module Distribution.Simple.NHC (
configure,
getInstalledPackages,
buildLib,
buildExe,
installLib,
installExe,
) where
import Distribution.Package
( PackageName, PackageIdentifier(..), InstalledPackageId(..)
, packageName )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo
, InstalledPackageInfo_( InstalledPackageInfo, installedPackageId
, sourcePackageId )
, emptyInstalledPackageInfo, parseInstalledPackageInfo )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
, hcOptions, usedExtensions )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
( mkLibName, objExtension, exeExtension )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..)
, Flag, languageToFlags, extensionsToFlags
, PackageDB(..), PackageDBStack )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Language.Haskell.Extension
( Language(Haskell98), Extension(..), KnownExtension(..) )
import Distribution.Simple.Program
( ProgramConfiguration, userMaybeSpecifyPath, programPath
, requireProgram, requireProgramVersion, lookupProgram
, nhcProgram, hmakeProgram, ldProgram, arProgram
, rawSystemProgramConf )
import Distribution.Simple.Utils
( die, info, findFileWithExtension, findModuleFiles
, installOrdinaryFile, installExecutableFile, installOrdinaryFiles
, createDirectoryIfMissingVerbose, withUTF8FileContents )
import Distribution.Version
( Version(..), orLaterVersion )
import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
import Distribution.ParseUtils
( ParseResult(..) )
import System.FilePath
( (</>), (<.>), normalise, takeDirectory, dropExtension )
import System.Directory
( doesFileExist, doesDirectoryExist, getDirectoryContents
, removeFile, getHomeDirectory )
import Data.Char ( toLower )
import Data.List ( nub )
import Data.Maybe ( catMaybes )
import qualified Data.Map as M ( empty )
import Data.Monoid ( Monoid(..) )
import Control.Monad ( when, unless )
import Distribution.Compat.Exception
import Distribution.System ( Platform )
-- -----------------------------------------------------------------------------
-- Configuring
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration)
configure verbosity hcPath _hcPkgPath conf = do
(_nhcProg, nhcVersion, conf') <-
requireProgramVersion verbosity nhcProgram
(orLaterVersion (Version [1,20] []))
(userMaybeSpecifyPath "nhc98" hcPath conf)
(_hmakeProg, _hmakeVersion, conf'') <-
requireProgramVersion verbosity hmakeProgram
(orLaterVersion (Version [3,13] [])) conf'
(_ldProg, conf''') <- requireProgram verbosity ldProgram conf''
(_arProg, conf'''') <- requireProgram verbosity arProgram conf'''
--TODO: put this stuff in a monad so we can say just:
-- requireProgram hmakeProgram (orLaterVersion (Version [3,13] []))
-- requireProgram ldProgram anyVersion
-- requireProgram ldPrograrProgramam anyVersion
-- unless (null (cSources bi)) $ requireProgram ccProgram anyVersion
let comp = Compiler {
compilerId = CompilerId NHC nhcVersion,
compilerLanguages = nhcLanguages,
compilerExtensions = nhcLanguageExtensions,
compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf'''')
nhcLanguages :: [(Language, Flag)]
nhcLanguages = [(Haskell98, "-98")]
-- | The flags for the supported extensions
nhcLanguageExtensions :: [(Extension, Flag)]
nhcLanguageExtensions =
-- TODO: pattern guards in 1.20
-- NHC doesn't enforce the monomorphism restriction at all.
-- Technically it therefore doesn't support MonomorphismRestriction,
-- but that would mean it doesn't support Haskell98, so we pretend
-- that it does.
[(EnableExtension MonomorphismRestriction, "")
,(DisableExtension MonomorphismRestriction, "")
-- Similarly, I assume the FFI is always on
,(EnableExtension ForeignFunctionInterface, "")
,(DisableExtension ForeignFunctionInterface, "")
-- Similarly, I assume existential quantification is always on
,(EnableExtension ExistentialQuantification, "")
,(DisableExtension ExistentialQuantification, "")
-- Similarly, I assume empty data decls is always on
,(EnableExtension EmptyDataDecls, "")
,(DisableExtension EmptyDataDecls, "")
,(EnableExtension NamedFieldPuns, "-puns")
,(DisableExtension NamedFieldPuns, "-nopuns")
-- CPP can't actually be turned off, but we pretend that it can
,(EnableExtension CPP, "-cpp")
,(DisableExtension CPP, "")
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
homedir <- getHomeDirectory
(nhcProg, _) <- requireProgram verbosity nhcProgram conf
let bindir = takeDirectory (programPath nhcProg)
incdir = takeDirectory bindir </> "include" </> "nhc98"
dbdirs = nub (concatMap (packageDbPaths homedir incdir) packagedbs)
indexes <- mapM getIndividualDBPackages dbdirs
return $! mconcat indexes
where
getIndividualDBPackages :: FilePath -> IO InstalledPackageIndex
getIndividualDBPackages dbdir = do
pkgdirs <- getPackageDbDirs dbdir
pkgs <- sequence [ getInstalledPackage pkgname pkgdir
| (pkgname, pkgdir) <- pkgdirs ]
let pkgs' = map setInstalledPackageId (catMaybes pkgs)
return (PackageIndex.fromList pkgs')
packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths _home incdir db = case db of
GlobalPackageDB -> [ incdir </> "packages" ]
UserPackageDB -> [] --TODO any standard per-user db?
SpecificPackageDB path -> [ path ]
getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)]
getPackageDbDirs dbdir = do
dbexists <- doesDirectoryExist dbdir
if not dbexists
then return []
else do
entries <- getDirectoryContents dbdir
pkgdirs <- sequence
[ do pkgdirExists <- doesDirectoryExist pkgdir
return (pkgname, pkgdir, pkgdirExists)
| (entry, Just pkgname) <- [ (entry, simpleParse entry)
| entry <- entries ]
, let pkgdir = dbdir </> entry ]
return [ (pkgname, pkgdir) | (pkgname, pkgdir, True) <- pkgdirs ]
getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)
getInstalledPackage pkgname pkgdir = do
let pkgconfFile = pkgdir </> "package.conf"
pkgconfExists <- doesFileExist pkgconfFile
let cabalFile = pkgdir <.> "cabal"
cabalExists <- doesFileExist cabalFile
case () of
_ | pkgconfExists -> getFullInstalledPackageInfo pkgname pkgconfFile
| cabalExists -> getPhonyInstalledPackageInfo pkgname cabalFile
| otherwise -> return Nothing
getFullInstalledPackageInfo :: PackageName -> FilePath
-> IO (Maybe InstalledPackageInfo)
getFullInstalledPackageInfo pkgname pkgconfFile =
withUTF8FileContents pkgconfFile $ \contents ->
case parseInstalledPackageInfo contents of
ParseOk _ pkginfo | packageName pkginfo == pkgname
-> return (Just pkginfo)
_ -> return Nothing
-- | This is a backup option for existing versions of nhc98 which do not supply
-- proper installed package info files for the bundled libs. Instead we look
-- for the .cabal file and extract the package version from that.
-- We don't know any other details for such packages, in particular we pretend
-- that they have no dependencies.
--
getPhonyInstalledPackageInfo :: PackageName -> FilePath
-> IO (Maybe InstalledPackageInfo)
getPhonyInstalledPackageInfo pkgname pathsModule = do
content <- readFile pathsModule
case extractVersion content of
Nothing -> return Nothing
Just version -> return (Just pkginfo)
where
pkgid = PackageIdentifier pkgname version
pkginfo = emptyInstalledPackageInfo { sourcePackageId = pkgid }
where
-- search through the .cabal file, looking for a line like:
--
-- > version: 2.0
--
extractVersion :: String -> Maybe Version
extractVersion content =
case catMaybes (map extractVersionLine (lines content)) of
[version] -> Just version
_ -> Nothing
extractVersionLine :: String -> Maybe Version
extractVersionLine line =
case words line of