From c84a3ef8ebca5fb396ee9dc8cb2654f7891f5c0e Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 14:12:58 +0200
Subject: Implement module export- and import-list item hyperlinking.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

(limited to 'haddock-api/src/Haddock/Backends')

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 19ebbe77..2325aa21 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -36,7 +36,12 @@ enrich src =
         , rtkDetails = lookupBySpan (tkSpan token) detailsMap
         }
   where
-    detailsMap = variables src ++ types src ++ binds src
+    detailsMap = concat
+        [ variables src
+        , types src
+        , binds src
+        , imports src
+        ]
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
@@ -81,6 +86,19 @@ binds =
             pure (sspan, TokenDetails RtkBind name)
         _ -> empty
 
+imports :: GHC.RenamedSource -> DetailsMap
+imports =
+    everything (<|>) ie
+  where
+    ie term = case cast term of
+        (Just (GHC.IEVar v)) -> pure $ var v
+        (Just (GHC.IEThingAbs t)) -> pure $ typ t
+        (Just (GHC.IEThingAll t)) -> pure $ typ t
+        (Just (GHC.IEThingWith t vs)) -> [typ t] ++ map var vs
+        _ -> empty
+    typ (GHC.L sspan name) = (sspan, TokenDetails RtkType name)
+    var (GHC.L sspan name) = (sspan, TokenDetails RtkVar name)
+
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
     | rs && cs && re && ce = True
-- 
cgit v1.2.3