From 937a6011d253a77cda98ec112a839cd08ac7e7ca Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 00:20:44 +0200
Subject: Add some documentation for AST module of source hyperlinker.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs        | 56 ++++++++++++++++++----
 1 file changed, 46 insertions(+), 10 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 10389958..275f10e9 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -33,6 +33,7 @@ rtkName (RtkBind name) = Left name
 rtkName (RtkDecl name) = Left name
 rtkName (RtkModule name) = Right name
 
+-- | Add more detailed information to token stream using GHC API.
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
     map $ \token -> RichToken
@@ -48,23 +49,24 @@ enrich src =
         , imports
         ]
 
+-- | A map containing association between source locations and "details" of
+-- this location.
+--
+-- For the time being, it is just a list of pairs. However, looking up things
+-- in such structure has linear complexity. We cannot use any hashmap-like
+-- stuff because source locations are not ordered. In the future, this should
+-- be replaced with interval tree data structure.
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
+lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
+lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
+
 enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
 enrichToken (Token typ _ spn) dm
     | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm
 enrichToken _ _ = Nothing
 
-lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
-lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
-
-everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
-           -> (forall a. Data a => a -> r)
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
-
-combine :: Alternative f => (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r)
-combine f g x = f x <|> g x
-
+-- | Obtain details map for variables ("normally" used identifiers).
 variables :: GHC.RenamedSource -> DetailsMap
 variables =
     everything (<|>) var
@@ -74,6 +76,7 @@ variables =
             pure (sspan, RtkVar name)
         _ -> empty
 
+-- | Obtain details map for types.
 types :: GHC.RenamedSource -> DetailsMap
 types =
     everything (<|>) ty
@@ -83,6 +86,11 @@ types =
             pure (sspan, RtkType name)
         _ -> empty
 
+-- | Obtain details map for identifier bindings.
+--
+-- That includes both identifiers bound by pattern matching or declared using
+-- ordinary assignment (in top-level declarations, let-expressions and where
+-- clauses).
 binds :: GHC.RenamedSource -> DetailsMap
 binds =
     everything (<|>) (fun `combine` pat)
@@ -96,6 +104,7 @@ binds =
             pure (sspan, RtkBind name)
         _ -> empty
 
+-- | Obtain details map for top-level declarations.
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
@@ -110,6 +119,10 @@ decls (group, _, _, _) = concatMap ($ group)
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
 
+-- | Obtain details map for import declarations.
+--
+-- This map also includes type and variable details for items in export and
+-- import lists.
 imports :: GHC.RenamedSource -> DetailsMap
 imports src@(_, imps, _, _) =
     everything (<|>) ie src ++ map (imp . GHC.unLoc) imps
@@ -126,6 +139,15 @@ imports src@(_, imps, _, _) =
         let (GHC.L sspan name) = GHC.ideclName idecl
         in (sspan, RtkModule name)
 
+-- | Check whether token stream span matches GHC source span.
+--
+-- Currently, it is implemented as checking whether "our" span is contained
+-- in GHC span. The reason for that is because GHC span are generally wider
+-- and may spread across couple tokens. For example, @(>>=)@ consists of three
+-- tokens: @(@, @>>=@, @)@, but GHC source span associated with @>>=@ variable
+-- contains @(@ and @)@. Similarly, qualified identifiers like @Foo.Bar.quux@
+-- are tokenized as @Foo@, @.@, @Bar@, @.@, @quux@ but GHC source span
+-- associated with @quux@ contains all five elements.
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
     | saspan <= stspan && etspan <= easpan = True
@@ -135,3 +157,17 @@ matches tspan (GHC.RealSrcSpan aspan)
     saspan = (GHC.srcSpanStartLine aspan, GHC.srcSpanStartCol aspan)
     easpan = (GHC.srcSpanEndLine aspan, GHC.srcSpanEndCol aspan)
 matches _ _ = False
+
+-- | Perform a query on each level of a tree.
+--
+-- This is stolen directly from SYB package and copied here to not introduce
+-- additional dependencies.
+everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
+           -> (forall a. Data a => a -> r)
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
+
+-- | Combine two queries into one using alternative combinator.
+combine :: Alternative f => (forall a. Data a => a -> f r)
+                         -> (forall a. Data a => a -> f r)
+                         -> (forall a. Data a => a -> f r)
+combine f g x = f x <|> g x
-- 
cgit v1.2.3