aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-22 00:20:44 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 22:37:49 +0200
commit937a6011d253a77cda98ec112a839cd08ac7e7ca (patch)
treea8fa6e257bfec66018b4f32234a8a19ad39fe686 /haddock-api/src
parent416c384a981593005c9c6bf87ac27b7c2f9b8695 (diff)
Add some documentation for AST module of source hyperlinker.
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs56
1 files changed, 46 insertions, 10 deletions
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