haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

{-# LANGUAGE RankNTypes #-}

module Haddock.Backends.Hyperlinker.Ast where

import qualified GHC
import Data.Data
import Control.Applicative

import Haddock.Backends.Hyperlinker.Parser

data RichToken = RichToken
    { rtkToken :: Token
    , rtkName :: Maybe GHC.Name
    }

enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
enrich src =
    map $ \token -> RichToken
        { rtkToken = token
        , rtkName = lookupName src $ tkSpan token
        }

lookupName :: GHC.RenamedSource -> Span -> Maybe GHC.Name
lookupName = undefined

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)

variables :: GHC.RenamedSource -> [(GHC.SrcSpan, GHC.Name)]
variables =
    everything (<|>) var
  where
    var term = case cast term of
        (Just (GHC.L sspan (GHC.HsVar sid))) -> pure (sspan, sid)
        _ -> empty