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 wikiElement)
  12               skipMany comment
  13               eof
  14               return xs
  15
  16
  17 wikiElement :: Parser WikiElement
  18 wikiElement = skipMany comment >>
  19               ( try (blockElement >>= return . Block)
  20                 <|>
  21                 try (inlineElement >>= return . Inline)
  22               )
  23
  24
  25 blockElement :: Parser BlockElement
  26 blockElement = ( try heading
  27                  <|>
  28                  try emptyLine
  29                )
  30
  31
  32 heading :: Parser BlockElement
  33 heading = foldr (<|>) pzero (map (try . heading') [1..5])
  34           <?>
  35           "heading"
  36     where
  37       heading' :: Int -> Parser BlockElement
  38       heading' n = do count n (char '=')
  39                       notFollowedBy (char '=')
  40                       ws
  41                       x  <- notFollowedBy (char '=') >> anyChar
  42                       xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
  43                       ws
  44                       eol
  45                       return (Heading n (x:xs))
  46
  47
  48 emptyLine :: Parser BlockElement
  49 emptyLine = count 2 newline >> many newline >> return EmptyLine
  50             <?>
  51             "empty line"
  52
  53
  54 inlineElement :: Parser InlineElement
  55 inlineElement = ( try text
  56                   <|>
  57                   try pageLink
  58                 )
  59
  60
  61 text :: Parser InlineElement
  62 text = text' >>= return . Text
  63     where
  64       text' :: Parser String
  65       text' = do x <- noneOf inlineSymbols
  66                  case x of
  67                    -- 單獨の \n は受け入れる。
  68                    '\n' -> return [x]
  69                    -- それ以外では \n を受け入れない。
  70                    _    -> many (noneOf ('\n':inlineSymbols)) >>= return . (x:)
  71
  72
  73 pageLink :: Parser InlineElement
  74 pageLink = do string "[["
  75               page     <- option Nothing
  76                           (many1 (noneOf "#|]") >>= return . Just)
  77               fragment <- option Nothing
  78                           (char '#' >> many1 (noneOf "|]") >>= return . Just)
  79               text     <- option Nothing
  80                           (char '|' >> many1 (noneOf "]") >>= return . Just)
  81
  82               case (page, fragment) of
  83                 (Nothing, Nothing) -> pzero
  84                 (_, _)             -> return ()
  85
  86               string "]]"
  87               return $ PageLink page fragment text
  88            <?>
  89            "page link"
  90
  91
  92 comment :: Parser ()
  93 comment = (try (string "<!--") >> skipTillEnd 1)
  94           <?>
  95           "comment"
  96     where
  97       skipTillEnd :: Int -> Parser ()
  98       skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
  99                             <|>
 100                             (try (string "-->") >> case level of
 101                                                      1 -> return ()
 102                                                      n -> skipTillEnd (n - 1))
 103                             <|>
 104                             (anyChar >> skipTillEnd level)
 105                           )
 106
 107
 108 inlineSymbols :: [Char]
 109 inlineSymbols = "<["
 110
 111 -- white space
 112 ws :: Parser ()
 113 ws = skipMany ( (oneOf " \t" >> return ())
 114                 <|>
 115                 comment
 116               )
 117
 118 -- end of line
 119 eol :: Parser ()
 120 eol = ( (many1 newline >> return ())
 121         <|>
 122         eof
 123       )