[commit: ghc] wip/nfs-locking: Fix haddockArgs, clean up code. (1c8a0e7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/1c8a0e7aa5f3a11561bdb3b45426f319c83291a8/ghc

>---------------------------------------------------------------

commit 1c8a0e7aa5f3a11561bdb3b45426f319c83291a8
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Dec 24 01:28:50 2015 +0000

    Fix haddockArgs, clean up code.


>---------------------------------------------------------------

1c8a0e7aa5f3a11561bdb3b45426f319c83291a8
 src/Base.hs                      | 10 ++++++++--
 src/Package.hs                   |  7 +++----
 src/Rules/Cabal.hs               |  3 +--
 src/Settings/Builders/Haddock.hs |  4 +++-
 4 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/Base.hs b/src/Base.hs
index 79ce119..7730bf5 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -26,7 +26,7 @@ module Base (
 
     -- * Miscellaneous utilities
     bimap, minusOrd, intersectOrd, removeFileIfExists, replaceEq, chunksOfSize,
-    replaceSeparators, decodeModule, encodeModule, unifyPath, (-/-)
+    replaceSeparators, decodeModule, encodeModule, unifyPath, (-/-), versionToInt
     ) where
 
 import Control.Applicative
@@ -37,7 +37,7 @@ import Data.Function
 import Data.List
 import Data.Maybe
 import Data.Monoid
-import Development.Shake hiding (unit, (*>), parallel)
+import Development.Shake hiding (unit, (*>))
 import Development.Shake.Classes
 import Development.Shake.Config
 import Development.Shake.FilePath
@@ -77,6 +77,12 @@ replaceSeparators = replaceIf isPathSeparator
 replaceIf :: (a -> Bool) -> a -> [a] -> [a]
 replaceIf p to = map (\from -> if p from then to else from)
 
+-- | Given a version string such as "2.16.2" produce an integer equivalent
+versionToInt :: String -> Int
+versionToInt s = major * 1000 + minor * 10 + patch
+  where
+    [major, minor, patch] = map read . words $ replaceEq '.' ' ' s
+
 -- | Given a module name extract the directory and file name, e.g.:
 --
 -- > decodeModule "Data.Functor.Identity" = ("Data/Functor/", "Identity")
diff --git a/src/Package.hs b/src/Package.hs
index a956c6a..536a16f39 100644
--- a/src/Package.hs
+++ b/src/Package.hs
@@ -1,8 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
 
 module Package (
-    Package (..), PackageName(..), PackageType (..),
+    Package (..), PackageName (..), PackageType (..),
     -- * Queries
     pkgNameString,
     pkgCabalFile,
@@ -18,7 +17,7 @@ import Data.String
 -- | The name of a Cabal package
 newtype PackageName = PackageName { getPackageName :: String }
                     deriving ( Eq, Ord, IsString, Generic, Binary, Hashable
-                             , NFData)
+                             , Typeable, NFData)
 
 instance Show PackageName where
     show (PackageName name) = name
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
index 74a2468..ce52388 100644
--- a/src/Rules/Cabal.hs
+++ b/src/Rules/Cabal.hs
@@ -1,13 +1,12 @@
 module Rules.Cabal (cabalRules) where
 
 import Data.Version
-import Distribution.Package as DP hiding (Package)
+import Distribution.Package as DP
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Parse
 import Distribution.Verbosity
 import Expression
 import GHC
-import Package hiding (library)
 import Settings
 
 cabalRules :: Rules ()
diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs
index 4cc8683..0663d04 100644
--- a/src/Settings/Builders/Haddock.hs
+++ b/src/Settings/Builders/Haddock.hs
@@ -16,6 +16,7 @@ haddockArgs = builder Haddock ? do
     hidden   <- getPkgDataList HiddenModules
     deps     <- getPkgDataList Deps
     depNames <- getPkgDataList DepNames
+    hVersion <- lift . pkgData . Version $ targetPath Stage2 haddock
     ghcOpts  <- fromDiffExpr commonGhcArgs
     mconcat
         [ arg $ "--odir=" ++ takeDirectory output
@@ -26,6 +27,7 @@ haddockArgs = builder Haddock ? do
         , arg "--hoogle"
         , arg $ "--title=" ++ pkgNameString pkg ++ "-" ++ version ++ ": " ++ synopsis
         , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt"
+        , arg $ "--optghc=-D__HADDOCK_VERSION__=" ++ show (versionToInt hVersion)
         , append $ map ("--hide=" ++) hidden
         , append $ [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE/./-}.html\\#%{NAME},"
@@ -40,7 +42,7 @@ haddockArgs = builder Haddock ? do
         , customPackageArgs
         , append =<< getInputs
         , arg "+RTS"
-        , arg $ "-t" ++ path </> "haddock.t"
+        , arg $ "-t" ++ path -/- "haddock.t"
         , arg "--machine-readable" ]
 
 customPackageArgs :: Args