compiler/parser/HaddockParse.y

   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 HaddockParse (
  10   parseHaddockParagraphs,
  11   parseHaddockString,
  12   EitherString(..)
  13 ) where
  14
  15 import {-# SOURCE #-} HaddockLex
  16 import HsSyn
  17 import RdrName
  18 }
  19
  20 %expect 0
  21
  22 %tokentype { Token }
  23
  24 %token  '/'     { TokSpecial '/' }
  25         '@'     { TokSpecial '@' }
  26         '['     { TokDefStart }
  27         ']'     { TokDefEnd }
  28         DQUO    { TokSpecial '\"' }
  29         URL     { TokURL $$ }
  30         PIC     { TokPic $$ }
  31         ANAME   { TokAName $$ }
  32         '/../'  { TokEmphasis $$ }
  33         '-'     { TokBullet }
  34         '(n)'   { TokNumber }
  35         '>..'   { TokBirdTrack $$ }
  36         IDENT   { TokIdent $$ }
  37         PARA    { TokPara }
  38         STRING  { TokString $$ }
  39
  40 %monad { EitherString }
  41
  42 %name parseHaddockParagraphs  doc
  43 %name parseHaddockString seq
  44
  45 %%
  46
  47 doc     :: { HsDoc RdrName }
  48         : apara PARA doc        { docAppend $1 $3 }
  49         | PARA doc              { $2 }
  50         | apara                 { $1 }
  51         | {- empty -}           { DocEmpty }
  52
  53 apara   :: { HsDoc RdrName }
  54         : ulpara                { DocUnorderedList [$1] }
  55         | olpara                { DocOrderedList [$1] }
  56         | defpara               { DocDefList [$1] }
  57         | para                  { $1 }
  58
  59 ulpara  :: { HsDoc RdrName }
  60         : '-' para              { $2 }
  61
  62 olpara  :: { HsDoc RdrName }
  63         : '(n)' para            { $2 }
  64
  65 defpara :: { (HsDoc RdrName, HsDoc RdrName) }
  66         : '[' seq ']' seq       { ($2, $4) }
  67
  68 para    :: { HsDoc RdrName }
  69         : seq                   { docParagraph $1 }
  70         | codepara              { DocCodeBlock $1 }
  71
  72 codepara :: { HsDoc RdrName }
  73         : '>..' codepara        { docAppend (DocString $1) $2 }
  74         | '>..'                 { DocString $1 }
  75
  76 seq     :: { HsDoc RdrName }
  77         : elem seq              { docAppend $1 $2 }
  78         | elem                  { $1 }
  79
  80 elem    :: { HsDoc RdrName }
  81         : elem1                 { $1 }
  82         | '@' seq1 '@'          { DocMonospaced $2 }
  83
  84 seq1    :: { HsDoc RdrName }
  85         : PARA seq1             { docAppend (DocString "\n") $2 }
  86         | elem1 seq1            { docAppend $1 $2 }
  87         | elem1                 { $1 }
  88
  89 elem1   :: { HsDoc RdrName }
  90         : STRING                { DocString $1 }
  91         | '/../'                { DocEmphasis (DocString $1) }
  92         | URL                   { DocURL $1 }
  93         | PIC                   { DocPic $1 }
  94         | ANAME                 { DocAName $1 }
  95         | IDENT                 { DocIdentifier $1 }
  96         | DQUO strings DQUO     { DocModule $2 }
  97
  98 strings  :: { String }
  99         : STRING                { $1 }
 100         | STRING strings        { $1 ++ $2 }
 101
 102 {
 103 happyError :: [Token] -> EitherString a
 104 happyError toks = MyLeft ("parse error in doc string")
 105
 106 -- We don't want to make an instance for Either String,
 107 -- since every user of the GHC API would get that instance
 108
 109 -- But why use non-Haskell98 instances when MyEither String
 110 -- is the only MyEither we're intending to use anyway? --Isaac Dupree
 111 --data MyEither a b = MyLeft a | MyRight b
 112 data EitherString b = MyLeft String | MyRight b
 113
 114 instance Monad EitherString where
 115         return          = MyRight
 116         MyLeft  l >>= _ = MyLeft l
 117         MyRight r >>= k = k r
 118         fail msg        = MyLeft msg
 119 }