Rakka/Wiki/Parser.hs

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