Rakka/Wiki/Parser.hs

   1 module Rakka.Wiki.Parser
   2     ( wikiPage
   3     )
   4     where
   5
   6 import           Rakka.Wiki
   7 import           Text.ParserCombinators.Parsec
   8
   9
  10 wikiPage :: Parser WikiPage
  11 wikiPage = do xs <- many (try blockElement)
  12               skipMany ( comment
  13                          <|>
  14                          (newline >> return ())
  15                        )
  16               eof
  17               return xs
  18
  19
  20 blockElement :: Parser BlockElement
  21 blockElement = skipMany ( comment
  22                           <|>
  23                           (newline >> return ())
  24                         )
  25                >>
  26                ( heading
  27                  <|>
  28                  paragraph
  29                )
  30
  31
  32 heading :: Parser BlockElement
  33 heading = foldr (<|>) pzero (map heading' [1..5])
  34           <?>
  35           "heading"
  36     where
  37       heading' :: Int -> Parser BlockElement
  38       heading' n = do try $ do count n (char '=')
  39                                notFollowedBy (char '=')
  40                       ws
  41                       x  <- notFollowedBy (char '=') >> anyChar
  42                       xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
  43                                                             <?>
  44                                                             ("trailing " ++ take n (repeat '='))
  45                                                           )
  46                                              )
  47                       ws
  48                       eol
  49                       return (Heading n (x:xs))
  50
  51
  52 paragraph :: Parser BlockElement
  53 paragraph = paragraph' >>= return . Paragraph
  54     where
  55       paragraph' :: Parser [InlineElement]
  56       paragraph' = do x  <- inlineElement
  57                       xs <- try ( do newline
  58                                      eof
  59                                      return []
  60                                   -- \n で文字列が終はってゐたら、ここ
  61                                   -- で終了。
  62                                 )
  63                             <|>
  64                             try ( do newline
  65                                      ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
  66                                      ys <- (paragraph' <|> return [])
  67                                      return (Text "\n" : ys)
  68                                   -- \n があり、その次に \n または
  69                                   -- blockSymbols があれば、fail して
  70                                   -- 最初の newline を讀んだ所まで卷き
  71                                   -- 戻す。
  72                                 )
  73                             <|>
  74                             try paragraph'
  75                             -- それ以外の場合は次の inlineElement から
  76                             -- を讀んで見る。但し一つも無くても良い。
  77                             <|>
  78                             return [] -- 全部失敗したらここで終了。
  79                       return (x:xs)
  80
  81
  82 inlineElement :: Parser InlineElement
  83 inlineElement = skipMany comment
  84                 >>
  85                 ( try text
  86                   <|>
  87                   try pageLink
  88                 )
  89
  90
  91 text :: Parser InlineElement
  92 text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text
  93
  94
  95 pageLink :: Parser InlineElement
  96 pageLink = do string "[["
  97               page     <- option Nothing
  98                           (many1 (noneOf "#|]") >>= return . Just)
  99               fragment <- option Nothing
 100                           (char '#' >> many1 (noneOf "|]") >>= return . Just)
 101               text     <- option Nothing
 102                           (char '|' >> many1 (noneOf "]") >>= return . Just)
 103
 104               case (page, fragment) of
 105                 (Nothing, Nothing) -> pzero
 106                 (_, _)             -> return ()
 107
 108               string "]]"
 109               return $ PageLink page fragment text
 110            <?>
 111            "page link"
 112
 113
 114 comment :: Parser ()
 115 comment = (try (string "<!--") >> skipTillEnd 1)
 116           <?>
 117           "comment"
 118     where
 119       skipTillEnd :: Int -> Parser ()
 120       skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
 121                             <|>
 122                             (try (string "-->") >> case level of
 123                                                      1 -> return ()
 124                                                      n -> skipTillEnd (n - 1))
 125                             <|>
 126                             (anyChar >> skipTillEnd level)
 127                           )
 128
 129
 130 blockSymbols :: [Char]
 131 blockSymbols = "="
 132
 133
 134 inlineSymbols :: [Char]
 135 inlineSymbols = "<["
 136
 137 -- white space
 138 ws :: Parser ()
 139 ws = skipMany ( (oneOf " \t" >> return ())
 140                 <|>
 141                 comment
 142               )
 143
 144 -- end of line
 145 eol :: Parser ()
 146 eol = ( (newline >> return ())
 147         <|>
 148         eof
 149       )