← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to utils/haddock/src/Haddock/Parse.y.source

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/haddock/src/Haddock/Parse.y.source
 
1
{
 
2
{-# OPTIONS -Wwarn -w #-}
 
3
-- The above warning supression flag is a temporary kludge.
 
4
-- While working on this module you are encouraged to remove it and fix
 
5
-- any warnings in the module. See
 
6
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 
7
-- for details
 
8
 
 
9
module Haddock.Parse where
 
10
 
 
11
import Haddock.Lex
 
12
import Haddock.Types (Doc(..), Example(Example))
 
13
import Haddock.Doc
 
14
import HsSyn
 
15
import RdrName
 
16
import Data.Char  (isSpace)
 
17
import Data.Maybe (fromMaybe)
 
18
import Data.List  (stripPrefix)
 
19
}
 
20
 
 
21
%expect 0
 
22
 
 
23
%tokentype { LToken }
 
24
 
 
25
%token  '/'     { (TokSpecial '/',_) }
 
26
        '@'     { (TokSpecial '@',_) }
 
27
        '['     { (TokDefStart,_) }
 
28
        ']'     { (TokDefEnd,_) }
 
29
        DQUO    { (TokSpecial '\"',_) }
 
30
        URL     { (TokURL $$,_) }
 
31
        PIC     { (TokPic $$,_) }
 
32
        ANAME   { (TokAName $$,_) }
 
33
        '/../'  { (TokEmphasis $$,_) }
 
34
        '-'     { (TokBullet,_) }
 
35
        '(n)'   { (TokNumber,_) }
 
36
        '>..'   { (TokBirdTrack $$,_) }
 
37
        PROMPT  { (TokExamplePrompt $$,_) }
 
38
        RESULT  { (TokExampleResult $$,_) }
 
39
        EXP     { (TokExampleExpression $$,_) }
 
40
        IDENT   { (TokIdent $$,_) }
 
41
        PARA    { (TokPara,_) }
 
42
        STRING  { (TokString $$,_) }
 
43
 
 
44
%monad { Maybe }
 
45
 
 
46
%name parseParas doc
 
47
%name parseString seq
 
48
 
 
49
%%
 
50
 
 
51
doc     :: { Doc RdrName }
 
52
        : apara PARA doc        { docAppend $1 $3 }
 
53
        | PARA doc              { $2 }
 
54
        | apara                 { $1 }
 
55
        | {- empty -}           { DocEmpty }
 
56
 
 
57
apara   :: { Doc RdrName }
 
58
        : ulpara                { DocUnorderedList [$1] }
 
59
        | olpara                { DocOrderedList [$1] }
 
60
        | defpara               { DocDefList [$1] }
 
61
        | para                  { $1 }
 
62
 
 
63
ulpara  :: { Doc RdrName }
 
64
        : '-' para              { $2 }
 
65
 
 
66
olpara  :: { Doc RdrName } 
 
67
        : '(n)' para            { $2 }
 
68
 
 
69
defpara :: { (Doc RdrName, Doc RdrName) }
 
70
        : '[' seq ']' seq       { ($2, $4) }
 
71
 
 
72
para    :: { Doc RdrName }
 
73
        : seq                   { docParagraph $1 }
 
74
        | codepara              { DocCodeBlock $1 }
 
75
        | examples              { DocExamples $1 }
 
76
 
 
77
codepara :: { Doc RdrName }
 
78
        : '>..' codepara        { docAppend (DocString $1) $2 }
 
79
        | '>..'                 { DocString $1 }
 
80
 
 
81
examples :: { [Example] }
 
82
        : example examples      { $1 : $2 }
 
83
        | example               { [$1] }
 
84
 
 
85
example :: { Example }
 
86
        : PROMPT EXP result     { makeExample $1 $2 (lines $3) }
 
87
        | PROMPT EXP            { makeExample $1 $2 [] }
 
88
 
 
89
result :: { String }
 
90
        : RESULT result         { $1 ++ $2 }
 
91
        | RESULT                { $1 }
 
92
 
 
93
seq     :: { Doc RdrName }
 
94
        : elem seq              { docAppend $1 $2 }
 
95
        | elem                  { $1 }
 
96
 
 
97
elem    :: { Doc RdrName }
 
98
        : elem1                 { $1 }
 
99
        | '@' seq1 '@'          { DocMonospaced $2 }
 
100
 
 
101
seq1    :: { Doc RdrName }
 
102
        : PARA seq1             { docAppend (DocString "\n") $2 }
 
103
        | elem1 seq1            { docAppend $1 $2 }
 
104
        | elem1                 { $1 }
 
105
 
 
106
elem1   :: { Doc RdrName }
 
107
        : STRING                { DocString $1 }
 
108
        | '/../'                { DocEmphasis (DocString $1) }
 
109
        | URL                   { DocURL $1 }
 
110
        | PIC                   { DocPic $1 }
 
111
        | ANAME                 { DocAName $1 }
 
112
        | IDENT                 { DocIdentifier $1 }
 
113
        | DQUO strings DQUO     { DocModule $2 }
 
114
 
 
115
strings  :: { String }
 
116
        : STRING                { $1 }
 
117
        | STRING strings        { $1 ++ $2 }
 
118
 
 
119
{
 
120
happyError :: [LToken] -> Maybe a
 
121
happyError toks = Nothing
 
122
 
 
123
-- | Create an 'Example', stripping superfluous characters as appropriate
 
124
makeExample :: String -> String -> [String] -> Example
 
125
makeExample prompt expression result =
 
126
  Example
 
127
        (strip expression)      -- we do not care about leading and trailing
 
128
                                -- whitespace in expressions, so drop them
 
129
        result'
 
130
  where
 
131
        -- drop trailing whitespace from the prompt, remember the prefix
 
132
        (prefix, _) = span isSpace prompt
 
133
        -- drop, if possible, the exact same sequence of whitespace characters
 
134
        -- from each result line
 
135
        result' = map (tryStripPrefix prefix) result
 
136
          where
 
137
                tryStripPrefix xs ys = fromMaybe ys $ stripPrefix xs ys
 
138
 
 
139
-- | Remove all leading and trailing whitespace
 
140
strip :: String -> String
 
141
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
 
142
}