darcs patch: Add preliminary support for haddock-ghc (and 1 more)

David Waern davve at dtek.chalmers.se
Fri Jan 5 16:38:13 EST 2007


Erhm.. please ignore the first one of these patches, since I've  
already sent it in. Seems like darcs send is a bit buggy.

/David

5 jan 2007 kl. 22.28 skrev davve at dtek.chalmers.se:

> Fri Sep 15 21:29:49 CEST 2006  davve at dtek.chalmers.se
>   * Add preliminary support for haddock-ghc
>
> Fri Jan  5 22:22:24 CET 2007  davve at dtek.chalmers.se
>   * Add -D__HADDOCK__ to haddock-ghc
>
> New patches:
>
> [Add preliminary support for haddock-ghc
> davve at dtek.chalmers.se**20060915192949] {
> hunk ./Distribution/Program.hs 57
> +                           , haddockGHCProgram
> hunk ./Distribution/Program.hs 108
> +                              , haddockGHCProgram
> hunk ./Distribution/Program.hs 188
> +haddockGHCProgram :: Program
> +haddockGHCProgram = simpleProgram "haddock-ghc"
> +
> hunk ./Distribution/Setup.hs 92
> +            | HaddockGHCCmd           -- haddock-ghc
> hunk ./Distribution/Setup.hs 364
> -                        copyCmd, sdistCmd, testCmd, haddockCmd,  
> programaticaCmd,
> -                        registerCmd, unregisterCmd]
> +                        copyCmd, sdistCmd, testCmd, haddockCmd,  
> haddockGHCCmd,
> +                        programaticaCmd, registerCmd, unregisterCmd]
> hunk ./Distribution/Setup.hs 577
> +
> +haddockGHCCmd :: Cmd a
> +haddockGHCCmd = Cmd {
> +        cmdName        = "haddock-ghc",
> +        cmdHelp        = "Generate Haddock HTML code from Exposed- 
> Modules, using haddock-ghc.",
> +        cmdDescription = "Requires haddock-ghc.",
> +        cmdOptions     = [cmd_help, cmd_verbose,
> +                          Option "" ["hoogle"] (NoArg  
> HaddockHoogle) "Generate a hoogle database"],
> +        cmdAction      = HaddockGHCCmd
> +        }
> hunk ./Distribution/Simple/GHC.hs 47
> -	build, installLib, installExe
> +	build, installLib, installExe, constructGeneralGHCCmdLine
> hunk ./Distribution/Simple/GHC.hs 339
> -
> -constructGHCCmdLine
> -	:: LocalBuildInfo
> +constructGeneralGHCCmdLine :: LocalBuildInfo
> hunk ./Distribution/Simple/GHC.hs 342
> -	-> Int				-- verbosity level
> hunk ./Distribution/Simple/GHC.hs 343
> -constructGHCCmdLine lbi bi odir verbose =
> -        ["--make"]
> -     ++ (if verbose > 4 then ["-v"] else [])
> -	    -- Unsupported extensions have already been checked by configure
> -     ++ (if compilerVersion (compiler lbi) > Version [6,4] []
> -            then ["-hide-all-packages"]
> -            else [])
> +constructGeneralGHCCmdLine lbi bi odir =
> +    (if compilerVersion (compiler lbi) > Version [6,4] []
> +         then ["-hide-all-packages"]
> +         else [])
> hunk ./Distribution/Simple/GHC.hs 358
> +constructGHCCmdLine
> +	:: LocalBuildInfo
> +        -> BuildInfo
> +	-> FilePath
> +	-> Int				-- verbosity level
> +        -> [String]
> +constructGHCCmdLine lbi bi odir verbose =
> +        ["--make"]
> +     ++ (if verbose > 4 then ["-v"] else [])
> +     ++ constructGeneralGHCCmdLine lbi bi odir
> +
> hunk ./Distribution/Simple.hs 72
> -                            haddockProgram, rawSystemProgram,  
> defaultProgramConfiguration,
> -                            pfesetupProgram, updateProgram,   
> rawSystemProgramConf)
> +                            haddockProgram, haddockGHCProgram,  
> rawSystemProgram,
> +                            defaultProgramConfiguration,  
> pfesetupProgram, updateProgram,
> +                            rawSystemProgramConf)
> hunk ./Distribution/Simple.hs 98
> +import Distribution.Simple.GHC ( constructGeneralGHCCmdLine )
> +
> hunk ./Distribution/Simple.hs 209
> +      -- |Hook to run before haddock command.  Second arg  
> indicates verbosity level.
> +     preGHCHaddock  :: Args -> HaddockFlags -> IO HookedBuildInfo,
> +      -- |Hook to run after haddock command.  Second arg indicates  
> verbosity level.
> +      -- |Over-ride this hook to get different behavior during  
> haddock.
> +     haddockGHCHook :: PackageDescription -> LocalBuildInfo ->  
> Maybe UserHooks -> HaddockFlags -> IO (),
> +     postGHCHaddock :: Args -> HaddockFlags -> PackageDescription - 
> > LocalBuildInfo -> IO ExitCode,
> +
> hunk ./Distribution/Simple.hs 316
> +            HaddockGHCCmd -> do
> +                (verbose, _, args) <- parseHaddockArgs  
> emptyHaddockFlags args []
> +                pkg_descr <- hookOrInArgs preGHCHaddock args verbose
> +                localbuildinfo <- getPersistBuildConfig
> +
> +                cmdHook haddockGHCHook pkg_descr localbuildinfo  
> verbose
> +                postHook postGHCHaddock args verbose pkg_descr  
> localbuildinfo
> +
> hunk ./Distribution/Simple.hs 418
> +haddockGHC :: PackageDescription -> LocalBuildInfo -> Maybe UserHooks
> +              -> HaddockFlags -> IO ()
> +haddockGHC pkg_descr lbi hooks (HaddockFlags hoogle verbose) = do
> +    confHaddock <- do
> +        let programConf = withPrograms lbi
> +        let haddockGHCName = programName haddockGHCProgram
> +        mHaddock <- lookupProgram haddockGHCName programConf
> +        maybe (die "haddock-ghc command not found") return mHaddock
> +
> +    let tmpDir = joinPaths (buildDir lbi) "tmp"
> +    createDirectoryIfMissing True tmpDir
> +
> +    setupMessage "Running Haddock for" pkg_descr
> +
> +    let showPkg = showPackageId (package pkg_descr)
> +    let outputFlag = if hoogle then "--hoogle" else "--html"
> +
> +    withLib pkg_descr () $ \lib -> do
> +        let bi = libBuildInfo lib
> +        inFiles <- getModulePaths bi (exposedModules lib ++  
> otherModules bi)
> +        let prologName = showPkg ++ "-haddock-prolog.txt"
> +        writeFile prologName (description pkg_descr ++ "\n")
> +
> +        rawSystemProgram verbose confHaddock
> +                (["--ghc-flags",
> +                  outputFlag,
> +                  "--odir=" ++ haddockPref,
> +                  "--title=" ++ showPkg ++ ": " ++ synopsis  
> pkg_descr,
> +                  "--prologue=" ++ prologName]
> +                 ++ programArgs confHaddock
> +                 ++ (if verbose > 4 then ["--verbose"] else [])
> +                 ++ inFiles
> +                 ++ map ("--hide=" ++) (otherModules bi)
> +                 ++ ["-package-name", showPackageId (package  
> pkg_descr) ]
> +                 ++ constructGeneralGHCCmdLine lbi bi tmpDir
> +                )
> +        removeFile prologName
> +
> +    removeDirectoryRecursive tmpDir
> +
> hunk ./Distribution/Simple.hs 651
> -       postHaddock = res
> -      }
> +       postHaddock = res,
> +       preGHCHaddock  = rn,
> +       haddockGHCHook = ru,
> +       postGHCHaddock = res
> +       }
> hunk ./Distribution/Simple.hs 691
> +       haddockGHCHook = haddockGHC,
> }
>
> [Add -D__HADDOCK__ to haddock-ghc
> davve at dtek.chalmers.se**20070105212224] {
> hunk ./Distribution/Simple.hs 443
> +                  "-cpp",
> +                  "-D__HADDOCK__",
> }
>
> Context:
>
> [added --save-configure flag to clean. got some complaints that  
> there was no way to avoid reconfiguring after a clean.  now if you  
> use --save-configure, you should be able to.
> ijones at syntaxpolice.org**20061219152204]
> [tiny mod to License comments
> ijones at syntaxpolice.org**20061219060021]
> [improving help output
> ijones at syntaxpolice.org**20061219055849
>  As suggested by Claus Reinke in this ticket:
>  http://hackage.haskell.org/trac/hackage/ticket/105
> ]
> [fix ./Setup unregister --help, which was giving the help for register
> Simon Marlow <simonmar at microsoft.com>**20061215165000]
> [Fix the links in the user guide to the API docs
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>*-20061129131633]
> [Fix the links in the user guide to the API docs
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061129131633]
> [haddock comments for SrcDist.hs
> ijones at syntaxpolice.org**20061127041303]
> [some haddock comments for LocalBuildInfo.hs
> ijones at syntaxpolice.org**20061127040916]
> [a little comment for JHC.hs
> ijones at syntaxpolice.org**20061127040026]
> [some comments for Install.hs
> ijones at syntaxpolice.org**20061127035919]
> [some comments for Hugs.hs
> ijones at syntaxpolice.org**20061127035310]
> [haddock comments for GHC and GHCPackageConig
> ijones at syntaxpolice.org**20061127034617]
> [some comments for Configure.hs
> ijones at syntaxpolice.org**20061127033157]
> [some comments for Build.hs
> ijones at syntaxpolice.org**20061127032409]
> [minor comments and cleanup for Setup.hs
> ijones at syntaxpolice.org**20061127031744]
> [some haddock explanation of preprocessors
> ijones at syntaxpolice.org**20061127031055]
> [some comments for Package.hs
> ijones at syntaxpolice.org**20061127025108]
> [haddockizing some comments from Make.hs
> ijones at syntaxpolice.org**20061127024142]
> [adding comments to Program.hs
> ijones at syntaxpolice.org**20061127022353]
> [comments for the Program module
> ijones at syntaxpolice.org**20061127002749]
> [don't return an error code just because there's no library to  
> register
> ijones at syntaxpolice.org**20061124144831]
> [Purely cosmetic; have '--<FOO>-args' use ARGS on their RHS rather  
> than PATH in usage output
> sof at galois.com**20061121195844]
> [parse executable field as a token (as documented), rather than  
> free text
> Ross Paterson <ross at soi.city.ac.uk>**20061120093400]
> [trim trailing spaces (including CRs) from all input lines
> Ross Paterson <ross at soi.city.ac.uk>**20061120092526]
> [help nhc98 find the import of programLocation
> Malcolm.Wallace at cs.york.ac.uk**20061117144001]
> [sdist: make it work on Windows platforms by simplifying 'tar'  
> invocation. Hopefully not at the cost of other plats (i.e., as-yet  
> untested there..)"
> sof at galois.com**20061117014832]
> [build: consult and use any user-provided settings for 'ld' and 'ar'
> sof at galois.com**20061117014622]
> [defaultUserHooks.sDistHook: pass in optional LBI to SrcDist.sdist
> sof at galois.com**20061117014448]
> [defaultProgramConfiguration: add 'ld' and 'tar' entries
> sof at galois.com**20061117014318]
> [revise Paths module for the Hugs target
> Ross Paterson <ross at soi.city.ac.uk>**20061108223349
>
>  When targetting Hugs, the Paths module now uses prefix-independent
>  paths relative to the location of the Main module of the program,
>  on all platforms.
>
>  For the Hugs target, this replaces the code using  
> GetModuleFileNameA(),
>  which never worked.  Behaviour under GHC should be unchanged.
> ]
> [Hugs: fix location of installed package info
> Ross Paterson <ross at soi.city.ac.uk>**20061021144613]
> [Fix escaping of ' chars in register.sh script.
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061016215459]
> [Tidy up command comments
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061013211158]
> [Fix getDataDir etc. when bindir=$prefix
> Simon Marlow <simonmar at microsoft.com>**20061013100941]
> [Update text on the front page: packages can now overlap in GHC 6.6
> Simon Marlow <simonmar at microsoft.com>**20061012114601
>
> ]
> [New unlit code "ported" from cpphs-1.2
> Lennart Kolmodin <kolmodin at dtek.chalmers.se>**20061009192609]
> [Share one more place where the cabal version is defined.
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010140027]
> [Fix spelling error in error message.
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010140013]
> [Centeralise the places that know that Cabal version number
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010135918]
> [Remove spurious debug message.
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010125643]
> [Bump to next unstable development version
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010125602]
> [Make cabal know it's own version number correctly
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061010130939
>  This is an unpleasent way of doing it.
>  Will have to fix once and for all in the next version.
> ]
> [TAG 1.1.6
> Duncan Coutts <duncan.coutts at worc.ox.ac.uk>**20061009123801]
> Patch bundle hash:
> 7df51d81ae0d14dd632dc23b8cbb513cc5b5746a
> _______________________________________________
> cabal-devel mailing list
> cabal-devel at haskell.org
> http://www.haskell.org/mailman/listinfo/cabal-devel



More information about the cabal-devel mailing list