summaryrefslogtreecommitdiff
path: root/compiler/rename/RnHsDoc.hs
blob: f3d36907f4e4534b564676992670c145ddbcd574 (plain)
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where

import TcRnMonad   ( RnM )
import RnEnv       ( dataTcOccs, lookupGreRn_maybe )
import HsDoc       ( HsDoc(..) )

import RdrName     ( RdrName, isRdrDataCon, isRdrTc, gre_name )
import Name        ( Name )
import SrcLoc      ( Located(..) )
import Outputable  ( ppr, defaultUserStyle )

import Data.List   ( (\\) )
import Debug.Trace ( trace )

rnMbHsDoc mb_doc = case mb_doc of
  Just doc -> do
    doc' <- rnHsDoc doc
    return (Just doc')
  Nothing -> return Nothing

rnMbLHsDoc mb_doc = case mb_doc of
  Just doc -> do
    doc' <- rnLHsDoc doc
    return (Just doc')
  Nothing -> return Nothing

rnLHsDoc (L pos doc) = do
  doc' <- rnHsDoc doc
  return (L pos doc')

ids2string []    = []
ids2string (x:_) = show $ ppr x defaultUserStyle

rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name)
rnHsDoc doc = case doc of 
  
  DocEmpty -> return DocEmpty

  DocAppend a b -> do
    a' <- rnHsDoc a 
    b' <- rnHsDoc b
    return (DocAppend a' b')

  DocString str -> return (DocString str)

  DocParagraph doc -> do
    doc' <- rnHsDoc doc
    return (DocParagraph doc')

  DocIdentifier ids -> do
    let choices = concatMap dataTcOccs ids
    mb_gres <- mapM lookupGreRn_maybe choices 
    case [gre_name gre | Just gre <- mb_gres] of
      [] -> return (DocString (ids2string ids))
      ids' -> return (DocIdentifier ids')

  DocModule str -> return (DocModule str)

  DocEmphasis doc -> do
    doc' <- rnHsDoc doc
    return (DocEmphasis doc')

  DocMonospaced doc -> do
    doc' <- rnHsDoc doc 
    return (DocMonospaced doc')
 
  DocUnorderedList docs -> do
    docs' <- mapM rnHsDoc docs
    return (DocUnorderedList docs')

  DocOrderedList docs -> do
    docs' <- mapM rnHsDoc docs
    return (DocOrderedList docs')

  DocDefList list -> do
    list' <- mapM (\(a,b) -> do
      a' <- rnHsDoc a
      b' <- rnHsDoc b
      return (a', b')) list
    return (DocDefList list')

  DocCodeBlock doc -> do
    doc' <- rnHsDoc doc
    return (DocCodeBlock doc')

  DocURL str -> return (DocURL str)

  DocAName str -> return (DocAName str)