Merge pull request #1 from haskell/ghc-head

Ghc head

1 files changed, 68 insertions, 0 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
new file mode 100644
index 00000000..9de4a03d
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -0,0 +1,68 @@
+module Haddock.Backends.Hyperlinker.Utils
+    ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile'
+    , hypSrcModuleUrl, hypSrcModuleUrl'
+    , hypSrcNameUrl
+    , hypSrcLineUrl
+    , hypSrcModuleNameUrl, hypSrcModuleLineUrl
+    , hypSrcModuleUrlFormat
+    , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat
+    ) where
+
+
+import Haddock.Backends.Xhtml.Utils
+
+import GHC
+import FastString
+import System.FilePath.Posix ((</>))
+
+
+hypSrcDir :: FilePath
+hypSrcDir = "src"
+
+hypSrcModuleFile :: Module -> FilePath
+hypSrcModuleFile = hypSrcModuleFile' . moduleName
+
+hypSrcModuleFile' :: ModuleName -> FilePath
+hypSrcModuleFile' mdl = spliceURL'
+    Nothing (Just mdl) Nothing Nothing moduleFormat
+
+hypSrcModuleUrl :: Module -> String
+hypSrcModuleUrl = hypSrcModuleFile
+
+hypSrcModuleUrl' :: ModuleName -> String
+hypSrcModuleUrl' = hypSrcModuleFile'
+
+hypSrcNameUrl :: Name -> String
+hypSrcNameUrl name = spliceURL
+    Nothing Nothing (Just name) Nothing nameFormat
+
+hypSrcLineUrl :: Int -> String
+hypSrcLineUrl line = spliceURL
+    Nothing Nothing Nothing (Just spn) lineFormat
+  where
+    loc = mkSrcLoc nilFS line 1
+    spn = mkSrcSpan loc loc
+
+hypSrcModuleNameUrl :: Module -> Name -> String
+hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
+
+hypSrcModuleLineUrl :: Module -> Int -> String
+hypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ "#" ++ hypSrcLineUrl line
+
+hypSrcModuleUrlFormat :: String
+hypSrcModuleUrlFormat = hypSrcDir </> moduleFormat
+
+hypSrcModuleNameUrlFormat :: String
+hypSrcModuleNameUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ nameFormat
+
+hypSrcModuleLineUrlFormat :: String
+hypSrcModuleLineUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ lineFormat
+
+moduleFormat :: String
+moduleFormat = "%{MODULE}.html"
+
+nameFormat :: String
+nameFormat = "%{NAME}"
+
+lineFormat :: String
+lineFormat = "line-%{LINE}"