diff --git a/Cabal.cabal b/Cabal.cabal --- a/Cabal.cabal +++ b/Cabal.cabal @@ -1,5 +1,5 @@ Name: Cabal -Version: 1.2.2.0 +Version: 1.2.3.0 Copyright: 2003-2006, Isaac Jones License: BSD3 License-File: LICENSE @@ -37,7 +37,7 @@ Build-Depends: unix GHC-Options: -Wall - CPP-Options: "-DCABAL_VERSION=1,2,2,0" + CPP-Options: "-DCABAL_VERSION=1,2,3,0" nhc98-Options: -K4M Exposed-Modules: diff --git a/Distribution/Compat/Directory.hs b/Distribution/Compat/Directory.hs --- a/Distribution/Compat/Directory.hs +++ b/Distribution/Compat/Directory.hs @@ -4,7 +4,7 @@ module System.Directory, #if (__GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ <= 602) findExecutable, copyFile, getHomeDirectory, createDirectoryIfMissing, - removeDirectoryRecursive, + removeDirectoryRecursive, getTemporaryDirectory, #endif getDirectoryContentsWithoutSpecial ) where @@ -134,8 +134,65 @@ removeDirectoryRecursive f Right _ -> return () +{- | Returns the current directory for temporary files. + +On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@ +environment variable or \"\/tmp\" if the variable isn\'t defined. +On Windows, the function checks for the existence of environment variables in +the following order and uses the first path found: + +* +TMP environment variable. + +* +TEMP environment variable. + +* +USERPROFILE environment variable. + +* +The Windows directory + +The operation may fail with: + +* 'UnsupportedOperation' +The operating system has no notion of temporary directory. + +The function doesn\'t verify whether the path exists. +-} +getTemporaryDirectory :: IO FilePath +getTemporaryDirectory = do +#if defined(mingw32_HOST_OS) + allocaBytes long_path_size $ \pPath -> do + r <- c_GetTempPath (fromIntegral long_path_size) pPath + peekCString pPath +#else + catch (getEnv "TMPDIR") (\ex -> return "/tmp") #endif +#if defined(mingw32_HOST_OS) +foreign import ccall unsafe "__hscore_getFolderPath" + c_SHGetFolderPath :: Ptr () + -> CInt + -> Ptr () + -> CInt + -> CString + -> IO CInt +foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt +foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt +foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt +foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt + +foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt + +raiseUnsupported loc = + ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing) + +#endif + +#endif + getDirectoryContentsWithoutSpecial :: FilePath -> IO [FilePath] getDirectoryContentsWithoutSpecial = fmap (filter (not . flip elem [".", ".."])) . getDirectoryContents + diff --git a/Distribution/Configuration.hs b/Distribution/Configuration.hs --- a/Distribution/Configuration.hs +++ b/Distribution/Configuration.hs @@ -373,7 +373,7 @@ -- | Flatten a CondTree. This will resolve the CondTree by taking all -- possible paths into account. Note that since branches represent exclusive --- choices this may not result in a "sane" result. +-- choices this may not result in a \"sane\" result. ignoreConditions :: (Monoid a, Monoid c) => CondTree v c a -> (a, c) ignoreConditions (CondNode a c ifs) = (a, c) `mappend` mconcat (concatMap f ifs) where f (_, t, me) = ignoreConditions t diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -582,7 +582,7 @@ ru _ _ _ _ = return () -- | Hooks that correspond to a plain instantiation of the --- "simple" build system +-- \"simple\" build system simpleUserHooks :: UserHooks simpleUserHooks = emptyUserHooks { diff --git a/Distribution/Simple/Build.hs b/Distribution/Simple/Build.hs --- a/Distribution/Simple/Build.hs +++ b/Distribution/Simple/Build.hs @@ -43,7 +43,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Build ( - build, makefile + build, makefile, initialBuildSteps #ifdef DEBUG ,hunitTests #endif diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -268,7 +268,8 @@ dataDirTemplate = maybeDefault configDataDir dataDirTemplate, dataSubdirTemplate = maybeDefault configDataSubDir dataSubdirTemplate, docDirTemplate = maybeDefault configDocDir docDirTemplate, - htmlDirTemplate = maybeDefault configHtmlDir htmlDirTemplate + htmlDirTemplate = maybeDefault configHtmlDir htmlDirTemplate, + interfaceDirTemplate = maybeDefault configInterfaceDir interfaceDirTemplate } -- check extensions diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -9,7 +9,7 @@ -- Portability : portable -- -- Build and Install implementations for GHC. See --- 'Distribution.Simple.GHCPackageConfig.GHCPackageConfig' for +-- 'Distribution.Simple.GHC.PackageConfig.GHCPackageConfig' for -- registration-related stuff. {- Copyright (c) 2003-2005, Isaac Jones @@ -56,7 +56,7 @@ Executable(..), withExe, Library(..), libModules, hcOptions ) import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(..), autogenModulesDir, distPref ) + ( LocalBuildInfo(..), autogenModulesDir ) import Distribution.Simple.Utils import Distribution.Package ( PackageIdentifier(..), showPackageId, parsePackageId ) @@ -64,7 +64,7 @@ rawSystemProgramStdoutConf, rawSystemProgramStdout, Program(..), ConfiguredProgram(..), - ProgramConfiguration, addKnownProgram, + ProgramConfiguration, userMaybeSpecifyPath, requireProgram, programPath, lookupProgram, updateProgram, ghcProgram, ghcPkgProgram, @@ -86,10 +86,12 @@ import Data.List ( nub, isPrefixOf ) import System.Directory ( removeFile, renameFile, getDirectoryContents, doesFileExist ) +import Distribution.Compat.Directory ( getTemporaryDirectory ) +import Distribution.Compat.TempFile ( withTempFile ) import System.FilePath ( (), (<.>), takeExtension, takeDirectory, replaceExtension, splitExtension ) import System.IO -import Control.Exception as Exception (catch) +import Control.Exception as Exception (handle) -- System.IO used to export a different try, so we can't use try unqualified #ifndef __NHC__ @@ -126,31 +128,32 @@ ++ programPath ghcPkgProg ++ " is version " ++ showVersion ghcPkgVersion -- finding ghc's local ld is a bit tricky as it's not on the path: - let conf''' = case os of + let ldProgram' = case os of Windows _ -> let compilerDir = takeDirectory (programPath ghcProg) baseDir = takeDirectory compilerDir binInstallLd = baseDir "gcc-lib" "ld.exe" - in addKnownProgram ldProgram { + in ldProgram { programFindLocation = \_ -> return (Just binInstallLd) - } conf'' - _ -> conf'' + } + _ -> ldProgram -- we need to find out if ld supports the -x flag - (ldProg, conf'''') <- requireProgram verbosity ldProgram AnyVersion conf''' - let testfile = distPref "Conftest" - testfile' = testfile ++ "2" - writeFile (testfile <.> "c") "int foo() {}\n" - rawSystemProgram verbosity ghcProg ["-c", testfile <.> "c"] - ldx <- - (rawSystemProgramStdout verbosity ldProg ["-x", "-r", testfile <.> "o", - "-o", testfile' <.> "o"] - >> return True) `Exception.catch` \_ -> return False - mapM_ (try . removeFile) [testfile <.> "c", testfile <.> "o" - , testfile' <.> "o"] - let conf''''' = updateProgram ldProg { + (ldProg, conf''') <- requireProgram verbosity ldProgram' AnyVersion conf'' + tempDir <- getTemporaryDirectory + ldx <- withTempFile tempDir "c" $ \testcfile -> + withTempFile tempDir "o" $ \testofile -> do + writeFile testcfile "int foo() {}\n" + rawSystemProgram verbosity ghcProg ["-c", testcfile, + "-o", testofile] + withTempFile tempDir "o" $ \testofile' -> + Exception.handle (\_ -> return False) $ do + rawSystemProgramStdout verbosity ldProg + ["-x", "-r", testofile, "-o", testofile'] + return True + let conf'''' = updateProgram ldProg { programArgs = if ldx then ["-x"] else [] - } conf'''' + } conf''' -- Yeah yeah, so obviously conf''''' is totally rediculious and the program -- configuration needs to be in a state monad. That is exactly the plan -- (along with some other stuff to give Cabal a better DSL). @@ -170,7 +173,7 @@ compilerId = PackageIdentifier "ghc" ghcVersion, compilerExtensions = languageExtensions } - return (comp, conf''''') + return (comp, conf'''') -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a -- corresponding ghc-pkg, we try looking for both a versioned and unversioned @@ -212,6 +215,7 @@ ,(TemplateHaskell , "-fth") ,(ForeignFunctionInterface , "-fffi") ,(NoMonomorphismRestriction , "-fno-monomorphism-restriction") + ,(NoMonoPatBinds , "-fno-mono-pat-binds") ,(UndecidableInstances , "-fallow-undecidable-instances") ,(IncoherentInstances , "-fallow-incoherent-instances") ,(Arrows , "-farrows") @@ -229,13 +233,24 @@ ,(RankNTypes , fglasgowExts) ,(PolymorphicComponents , fglasgowExts) ,(ExistentialQuantification , fglasgowExts) - ,(ScopedTypeVariables , fglasgowExts) + ,(ScopedTypeVariables , "-fscoped-type-variables") ,(FlexibleContexts , fglasgowExts) ,(FlexibleInstances , fglasgowExts) ,(EmptyDataDecls , fglasgowExts) ,(PatternGuards , fglasgowExts) ,(GeneralizedNewtypeDeriving , fglasgowExts) ,(MagicHash , fglasgowExts) + ,(UnicodeSyntax , fglasgowExts) + ,(PatternSignatures , fglasgowExts) + ,(UnliftedFFITypes , fglasgowExts) + ,(LiberalTypeSynonyms , fglasgowExts) + ,(TypeOperators , fglasgowExts) + ,(GADTs , fglasgowExts) + ,(RelaxedPolyRec , fglasgowExts) + ,(ExtendedDefaultRules , "-fextended-default-rules") + ,(UnboxedTuples , fglasgowExts) + ,(DeriveDataTypeable , fglasgowExts) + ,(ConstrainedClassMethods , fglasgowExts) ] where fglasgowExts = "-fglasgow-exts" diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs --- a/Distribution/Simple/Haddock.hs +++ b/Distribution/Simple/Haddock.hs @@ -58,6 +58,7 @@ import Distribution.Simple.PreProcess (ppCpp', ppUnlit, preprocessSources, PPSuffixHandler, runSimplePreProcessor) import Distribution.Simple.Setup +import Distribution.Simple.Build (initialBuildSteps) import Distribution.Simple.InstallDirs (InstallDirTemplates(..), PathTemplateVariable(..), toPathTemplate, fromPathTemplate, @@ -74,10 +75,10 @@ -- Base import System.Directory(removeFile, doesFileExist) -import Control.Monad (liftM, when, join) +import Control.Monad (liftM, when, unless, join) import Data.Maybe ( isJust, catMaybes, fromJust ) -import Data.List (nub) import Data.Char (isSpace) +import Data.List (nub) import Distribution.Compat.Directory(removeDirectoryRecursive, copyFile) import System.FilePath((), (<.>), splitFileName, splitExtension, @@ -116,27 +117,26 @@ setupMessage verbosity "Running Haddock for" pkg_descr let replaceLitExts = map ( (tmpDir ) . (`replaceExtension` "hs") ) - let mockAll bi = mapM_ (mockPP ["-D__HADDOCK__"] bi tmpDir) let showPkg = showPackageId (package pkg_descr) let outputFlag = if haddockHoogle haddockFlags then "--hoogle" else "--html" let Just version = programVersion confHaddock let have_src_hyperlink_flags = version >= Version [0,8] [] && version < Version [2,0] [] - have_new_flags = version > Version [0,8] [] && version < Version [2,0] [] isVersion2 = version >= Version [2,0] [] + + let mockFlags + | isVersion2 = [] + | otherwise = ["-D__HADDOCK__"] + + let mockAll bi = mapM_ (mockPP mockFlags bi tmpDir) + let comp = compiler lbi Just pkgTool = lookupProgram ghcPkgProgram (withPrograms lbi) - let ghcpkgFlags = if have_new_flags - then ["--ghc-pkg=" ++ programPath pkgTool] - else [] let cssFileFlag = case haddockCss haddockFlags of Nothing -> [] Just cssFile -> ["--css=" ++ cssFile] let verboseFlags = if verbosity > deafening then ["--verbose"] else [] - let allowMissingHtmlFlags = if have_new_flags - then ["--allow-missing-html"] - else [] when (hsColour && not have_src_hyperlink_flags) $ die "haddock --hyperlink-source requires Haddock version 0.8 or later" let linkToHscolour = if hsColour @@ -193,21 +193,26 @@ then ["--optghc=-package-name", "--optghc=" ++ showPkg] else ["--package=" ++ showPkg] - let haddock2options bi = if isVersion2 - then ("-B" ++ ghcLibDir) : map ("--optghc=" ++) (ghcSimpleOptions lbi bi) + let haddock2options bi preprocessDir = if isVersion2 + then ("-B" ++ ghcLibDir) : map ("--optghc=" ++) (ghcSimpleOptions lbi bi preprocessDir) else [] + when isVersion2 $ initialBuildSteps pkg_descr lbi verbosity suffixes + withLib pkg_descr () $ \lib -> do let bi = libBuildInfo lib - inFiles <- getModulePaths lbi bi (exposedModules lib ++ otherModules bi) - mockAll bi inFiles + modules = exposedModules lib ++ otherModules bi + inFiles <- getModulePaths lbi bi modules + unless isVersion2 $ mockAll bi inFiles let prologName = distPref showPkg ++ "-haddock-prolog.txt" prolog | null (description pkg_descr) = synopsis pkg_descr | otherwise = description pkg_descr subtitle | null (synopsis pkg_descr) = "" | otherwise = ": " ++ synopsis pkg_descr writeFile prologName (prolog ++ "\n") - let outFiles = replaceLitExts inFiles + let targets + | isVersion2 = modules + | otherwise = replaceLitExts inFiles let haddockFile = haddockPref pkg_descr haddockName pkg_descr -- FIX: replace w/ rawSystemProgramConf? rawSystemProgram verbosity confHaddock @@ -217,16 +222,14 @@ "--dump-interface=" ++ haddockFile, "--prologue=" ++ prologName] ++ packageName - ++ ghcpkgFlags - ++ allowMissingHtmlFlags ++ cssFileFlag ++ linkToHscolour ++ packageFlags ++ programArgs confHaddock ++ verboseFlags ++ map ("--hide=" ++) (otherModules bi) - ++ haddock2options bi - ++ outFiles + ++ haddock2options bi (buildDir lbi) + ++ targets ) removeFile prologName notice verbosity $ "Documentation created: " @@ -244,20 +247,21 @@ prolog | null (description pkg_descr) = synopsis pkg_descr | otherwise = description pkg_descr writeFile prologName (prolog ++ "\n") - let outFiles = replaceLitExts inFiles + let targets + | isVersion2 = srcMainPath : otherModules bi + | otherwise = replaceLitExts inFiles + let preprocessDir = buildDir lbi exeName exe exeName exe ++ "-tmp" rawSystemProgram verbosity confHaddock ([outputFlag, "--odir=" ++ exeTargetDir, "--title=" ++ exeName exe, "--prologue=" ++ prologName] - ++ ghcpkgFlags - ++ allowMissingHtmlFlags ++ linkToHscolour ++ packageFlags ++ programArgs confHaddock ++ verboseFlags - ++ haddock2options bi - ++ outFiles + ++ haddock2options bi preprocessDir + ++ targets ) removeFile prologName notice verbosity $ "Documentation created: " @@ -283,13 +287,18 @@ needsCpp bi = CPP `elem` extensions bi -ghcSimpleOptions :: LocalBuildInfo -> BuildInfo -> [String] -ghcSimpleOptions lbi bi +ghcSimpleOptions :: LocalBuildInfo -> BuildInfo -> FilePath -> [String] +ghcSimpleOptions lbi bi mockDir = ["-hide-all-packages"] - ++ ["-i" ++ autogenModulesDir lbi] - ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)] ++ (concat [ ["-package", showPackageId pkg] | pkg <- packageDeps lbi ]) + ++ ["-i"] ++ hcOptions GHC (options bi) + ++ ["-i" ++ autogenModulesDir lbi] + ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)] + ++ ["-i" ++ mockDir] + ++ ["-I" ++ dir | dir <- includeDirs bi] + ++ ["-odir", mockDir] + ++ ["-hidir", mockDir] ++ extensionsToFlags c (extensions bi) where c = compiler lbi diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs --- a/Distribution/Simple/InstallDirs.hs +++ b/Distribution/Simple/InstallDirs.hs @@ -124,7 +124,7 @@ -- -- A few of these installation directories are split into two components, the -- dir and subdir. The full installation path is formed by combining the two --- together with @<\/>@. The reason for this is compatability with other unix +-- together with @\/@. The reason for this is compatability with other unix -- build systems which also support @--libdir@ and @--datadir@. We would like -- users to be able to configure @--libdir=\/usr\/lib64@ for example but -- because by default we want to support installing multiplve versions of diff --git a/Distribution/Simple/PreProcess.hs b/Distribution/Simple/PreProcess.hs --- a/Distribution/Simple/PreProcess.hs +++ b/Distribution/Simple/PreProcess.hs @@ -47,8 +47,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.PreProcess (preprocessSources, knownSuffixHandlers, - ppSuffixes, PPSuffixHandler, PreProcessor, - runSimplePreProcessor, + ppSuffixes, PPSuffixHandler, PreProcessor(..), + mkSimplePreProcessor, runSimplePreProcessor, removePreprocessed, removePreprocessedPackage, ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs, ppHappy, ppAlex, ppUnlit @@ -112,8 +112,8 @@ -- file mentions the .h file in the FFI imports). This path must be relative to -- the base directory where the genereated files are located, it cannot be -- relative to the top level of the build tree because the compilers do not --- look for .h files relative to there, ie we do not use "-I .", instead we use --- "-I dist\/build" (or whatever dist dir has been set by the user) +-- look for .h files relative to there, ie we do not use \"-I .\", instead we +-- use \"-I dist\/build\" (or whatever dist dir has been set by the user) -- -- Most pre-processors do not care of course, so mkSimplePreProcessor and -- runSimplePreProcessor functions handle the simple case. diff --git a/Distribution/Simple/PreProcess/Unlit.hs b/Distribution/Simple/PreProcess/Unlit.hs --- a/Distribution/Simple/PreProcess/Unlit.hs +++ b/Distribution/Simple/PreProcess/Unlit.hs @@ -33,8 +33,8 @@ allProg (x:xs) = Program x:allProg xs classify (('>':x):xs) = Program (' ':x) : classify xs classify (('#':x):xs) = (case words x of - (line:file:_) | all isDigit line - -> Include (read line) file + (line:rest) | all isDigit line + -> Include (read line) (unwords rest) _ -> Pre x ) : classify xs classify (x:xs) | all isSpace x = Blank:classify xs diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs --- a/Distribution/Simple/Register.hs +++ b/Distribution/Simple/Register.hs @@ -271,7 +271,8 @@ dataDirTemplate = toPathTemplate pwd, dataSubdirTemplate = toPathTemplate distPref, docDirTemplate = toPathTemplate (pwd distPref "doc"), - htmlDirTemplate = toPathTemplate (pwd distPref "doc" "html" pkgName (package pkg_descr)) + htmlDirTemplate = toPathTemplate (pwd distPref "doc" "html" pkgName (package pkg_descr)), + interfaceDirTemplate = toPathTemplate (pwd distPref "doc" "html" pkgName (package pkg_descr)) } } NoCopyDest (absinc,relinc) = partition isAbsolute (includeDirs bi) diff --git a/Distribution/Simple/Setup.hs b/Distribution/Simple/Setup.hs --- a/Distribution/Simple/Setup.hs +++ b/Distribution/Simple/Setup.hs @@ -544,7 +544,7 @@ programFlagsDescription :: ProgramConfiguration -> String programFlagsDescription progConf = - "The flags --with-PROG and --PROG-arg(s) can be used with" + "The flags --with-PROG and --PROG-option(s) can be used with" ++ " the following programs:" ++ (concatMap ("\n "++) . wrapText 77 . sort) [ programName prog | (prog, _) <- knownPrograms progConf ] diff --git a/Language/Haskell/Extension.hs b/Language/Haskell/Extension.hs --- a/Language/Haskell/Extension.hs +++ b/Language/Haskell/Extension.hs @@ -92,4 +92,22 @@ | MagicHash | TypeFamilies | StandaloneDeriving + + | UnicodeSyntax + | PatternSignatures + | UnliftedFFITypes + | LiberalTypeSynonyms + | TypeOperators +--PArr -- not ready yet, and will probably be renamed to ParallelArrays + | RecordWildCards + | RecordPuns + | DisambiguateRecordFields + | OverloadedStrings + | GADTs + | NoMonoPatBinds + | RelaxedPolyRec + | ExtendedDefaultRules + | UnboxedTuples + | DeriveDataTypeable + | ConstrainedClassMethods deriving (Show, Read, Eq)