Rakka/Wiki/Parser.hs

   1 module Rakka.Wiki.Parser
   2     ( wikiPage
   3     )
   4     where
   5
   6 import           Data.Maybe
   7 import           Rakka.Wiki
   8 import           Text.ParserCombinators.Parsec
   9
  10
  11 wikiPage :: Parser WikiPage
  12 wikiPage = do xs <- many (try blockElement)
  13               skipMany ( comment
  14                          <|>
  15                          (newline >> return ())
  16                        )
  17               eof
  18               return xs
  19
  20
  21 blockElement :: Parser BlockElement
  22 blockElement = skipMany ( comment
  23                           <|>
  24                           (newline >> return ())
  25                         )
  26                >>
  27                ( heading
  28                  <|>
  29                  horizontalLine
  30                  <|>
  31                  listElement
  32                  <|>
  33                  definitionList
  34                  <|>
  35                  leadingSpaced
  36                  <|>
  37                  paragraph
  38                )
  39
  40
  41 heading :: Parser BlockElement
  42 heading = foldr (<|>) pzero (map heading' [1..5])
  43           <?>
  44           "heading"
  45     where
  46       heading' :: Int -> Parser BlockElement
  47       heading' n = do try $ do count n (char '=')
  48                                notFollowedBy (char '=')
  49                       ws
  50                       x  <- notFollowedBy (char '=') >> anyChar
  51                       xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
  52                                                             <?>
  53                                                             ("trailing " ++ take n (repeat '='))
  54                                                           )
  55                                              )
  56                       ws
  57                       eol
  58                       return (Heading n (x:xs))
  59
  60
  61 horizontalLine :: Parser BlockElement
  62 horizontalLine = try $ do count 4 (char '-')
  63                           many (char '-')
  64                           ws
  65                           eol
  66                           return HorizontalLine
  67
  68
  69 listElement :: Parser BlockElement
  70 listElement = listElement' [] >>= return . List
  71     where
  72       listElement' :: [Char] -> Parser ListElement
  73       listElement' stack
  74           = try $ do t  <- oneOf "*#"
  75                      ws
  76                      xs <- items (stack ++ [t])
  77                      return (ListElement (toType t) xs)
  78
  79       -- ListItem の終了條件は、
  80       items :: [Char] -> Parser [ListItem]
  81       items stack = do xs     <- many1 inlineElement
  82                        nested <- option Nothing
  83                                  $ try $ do newline
  84                                             string stack
  85                                             listElement' stack >>= return . Just
  86                        rest <- items stack
  87                        return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
  88                     <|>
  89                     (try $ do newline
  90                               string stack
  91                               ws
  92                               items stack
  93                     )
  94                     <|>
  95                     return []
  96
  97       toType :: Char -> ListType
  98       toType '*' = Bullet
  99       toType '#' = Numbered
 100
 101
 102 definitionList :: Parser BlockElement
 103 definitionList = many1 definition >>= return . DefinitionList
 104     where
 105       definition :: Parser Definition
 106       definition = do char ';'
 107                       ws
 108                       tHead <- inlineElement
 109                       tRest <- term
 110                       d     <- description
 111                       return (Definition (tHead:tRest) d)
 112                    <?>
 113                    "definition list"
 114
 115       term :: Parser [InlineElement]
 116       term = (char ':' >> ws >> return [])
 117              <|>
 118              (newline >> char ':' >> ws >> return [])
 119              <|>
 120              do x  <- inlineElement
 121                 xs <- term
 122                 return (x:xs)
 123              <?>
 124              "term to be defined"
 125
 126       description :: Parser [InlineElement]
 127       description = do x  <- inlineElement
 128                        xs <- description
 129                        return (x:xs)
 130                     <|>
 131                     try ( do newline
 132                              char ':'
 133                              ws
 134                              xs <- description
 135                              return (Text "\n" : xs)
 136                         )
 137                     <|>
 138                     (newline >> return [])
 139                     <|>
 140                     (eof >> return [])
 141                     <?>
 142                     "description of term"
 143
 144
 145 leadingSpaced :: Parser BlockElement
 146 leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
 147     where
 148       leadingSpaced' :: Parser [InlineElement]
 149       leadingSpaced' = do x  <- inlineElement
 150                           xs <- leadingSpaced'
 151                           return (x:xs)
 152                        <|>
 153                        try ( newline
 154                              >>
 155                              char ' '
 156                              >>
 157                              leadingSpaced'
 158                              >>=
 159                              return . (Text "\n" :)
 160                            )
 161                        <|>
 162                        return []
 163
 164
 165 blockTag :: Parser BlockElement
 166 blockTag = pzero -- not implemented
 167
 168
 169 paragraph :: Parser BlockElement
 170 paragraph = paragraph' >>= return . Paragraph
 171     where
 172       paragraph' :: Parser [InlineElement]
 173       paragraph' = do x  <- inlineElement
 174                       xs <- try ( do newline
 175                                      eof
 176                                      return []
 177                                   -- \n で文字列が終はってゐたら、ここ
 178                                   -- で終了。
 179                                 )
 180                             <|>
 181                             try ( do newline
 182                                      ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
 183                                      ((blockTag                  >> pzero) <|> return ())
 184                                      ys <- (paragraph' <|> return [])
 185                                      return (Text "\n" : ys)
 186                                   -- \n があり、その次に \n、ブロックタ
 187                                   -- グまたは blockSymbols があれば、
 188                                   -- fail して 最初の newline を讀んだ
 189                                   -- 所まで卷き戻す。
 190                                 )
 191                             <|>
 192                             try paragraph'
 193                             -- それ以外の場合は次の inlineElement から
 194                             -- を讀んで見る。但し一つも無くても良い。
 195                             <|>
 196                             return [] -- 全部失敗したらここで終了。
 197                       return (x:xs)
 198
 199
 200 inlineElement :: Parser InlineElement
 201 inlineElement = skipMany comment
 202                 >>
 203                 ( try text
 204                   <|>
 205                   try pageLink
 206                 )
 207
 208
 209 text :: Parser InlineElement
 210 text = ( char ':'
 211          >>
 212          many (noneOf ('\n':':':inlineSymbols))
 213          >>=
 214          return . Text . (':' :)
 215          -- 定義リストとの關係上、コロンは先頭にしか存在できない。
 216        )
 217        <|>
 218        ( many1 (noneOf ('\n':':':inlineSymbols))
 219          >>=
 220          return . Text
 221        )
 222
 223
 224 pageLink :: Parser InlineElement
 225 pageLink = do string "[["
 226               page     <- option Nothing
 227                           (many1 (noneOf "#|]") >>= return . Just)
 228               fragment <- option Nothing
 229                           (char '#' >> many1 (noneOf "|]") >>= return . Just)
 230               text     <- option Nothing
 231                           (char '|' >> many1 (noneOf "]") >>= return . Just)
 232
 233               case (page, fragment) of
 234                 (Nothing, Nothing) -> pzero
 235                 (_, _)             -> return ()
 236
 237               string "]]"
 238               return $ PageLink page fragment text
 239            <?>
 240            "page link"
 241
 242
 243 comment :: Parser ()
 244 comment = (try (string "<!--") >> skipTillEnd 1)
 245           <?>
 246           "comment"
 247     where
 248       skipTillEnd :: Int -> Parser ()
 249       skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
 250                             <|>
 251                             (try (string "-->") >> case level of
 252                                                      1 -> return ()
 253                                                      n -> skipTillEnd (n - 1))
 254                             <|>
 255                             (anyChar >> skipTillEnd level)
 256                           )
 257
 258
 259 blockSymbols :: [Char]
 260 blockSymbols = " =-*#;"
 261
 262
 263 inlineSymbols :: [Char]
 264 inlineSymbols = "<["
 265
 266 -- white space
 267 ws :: Parser ()
 268 ws = skipMany ( (oneOf " \t" >> return ())
 269                 <|>
 270                 comment
 271               )
 272
 273 -- end of line
 274 eol :: Parser ()
 275 eol = ( (newline >> return ())
 276         <|>
 277         eof
 278       )