diff options
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 20 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 1 |
2 files changed, 20 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 0ccf010b..19ebbe77 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Haddock.Backends.Hyperlinker.Ast ( enrich @@ -26,6 +27,7 @@ data TokenDetails = TokenDetails data RichTokenType = RtkVar | RtkType + | RtkBind enrich :: GHC.RenamedSource -> [Token] -> [RichToken] enrich src = @@ -34,7 +36,7 @@ enrich src = , rtkDetails = lookupBySpan (tkSpan token) detailsMap } where - detailsMap = variables src ++ types src + detailsMap = variables src ++ types src ++ binds src type DetailsMap = [(GHC.SrcSpan, TokenDetails)] @@ -45,6 +47,9 @@ 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 + variables :: GHC.RenamedSource -> DetailsMap variables = everything (<|>) var @@ -63,6 +68,19 @@ types = pure (sspan, TokenDetails RtkType name) _ -> empty +binds :: GHC.RenamedSource -> DetailsMap +binds = + everything (<|>) (fun `combine` pat) + where + fun term = case cast term of + (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name)) -> + pure (sspan, TokenDetails RtkBind name) + _ -> empty + pat term = case cast term of + (Just (GHC.L sspan (GHC.VarPat name))) -> + pure (sspan, TokenDetails RtkBind name) + _ -> empty + matches :: Span -> GHC.SrcSpan -> Bool matches tspan (GHC.RealSrcSpan aspan) | rs && cs && re && ce = True diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index c2bca438..57851c22 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -48,6 +48,7 @@ tokenSpan = Html.thespan . Html.toHtml . tkValue richTokenStyle :: RichTokenType -> [StyleClass] richTokenStyle RtkVar = ["hs-var"] richTokenStyle RtkType = ["hs-type"] +richTokenStyle RtkBind = ["hs-bind"] tokenStyle :: TokenType -> [StyleClass] tokenStyle TkIdentifier = ["hs-identifier"] |