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                  leadingSpaced
  34                  <|>
  35                  paragraph
  36                )
  37
  38
  39 heading :: Parser BlockElement
  40 heading = foldr (<|>) pzero (map heading' [1..5])
  41           <?>
  42           "heading"
  43     where
  44       heading' :: Int -> Parser BlockElement
  45       heading' n = do try $ do count n (char '=')
  46                                notFollowedBy (char '=')
  47                       ws
  48                       x  <- notFollowedBy (char '=') >> anyChar
  49                       xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
  50                                                             <?>
  51                                                             ("trailing " ++ take n (repeat '='))
  52                                                           )
  53                                              )
  54                       ws
  55                       eol
  56                       return (Heading n (x:xs))
  57
  58
  59 horizontalLine :: Parser BlockElement
  60 horizontalLine = try $ do count 4 (char '-')
  61                           many (char '-')
  62                           ws
  63                           eol
  64                           return HorizontalLine
  65
  66
  67 listElement :: Parser BlockElement
  68 listElement = listElement' [] >>= return . List
  69     where
  70       listElement' :: [Char] -> Parser ListElement
  71       listElement' stack
  72           = try $ do t  <- oneOf "*#"
  73                      ws
  74                      xs <- items (stack ++ [t])
  75                      return (ListElement (toType t) xs)
  76
  77       -- ListItem の終了條件は、
  78       items :: [Char] -> Parser [ListItem]
  79       items stack = do xs     <- many1 inlineElement
  80                        nested <- option Nothing
  81                                  $ try $ do newline
  82                                             string stack
  83                                             listElement' stack >>= return . Just
  84                        rest <- items stack
  85                        return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
  86                     <|>
  87                     (try $ do newline
  88                               string stack
  89                               ws
  90                               items stack
  91                     )
  92                     <|>
  93                     return []
  94 {-
  95       items stack = do nested <- listElement' stack
  96                        rest   <- items stack
  97                        return (Left nested : rest)
  98                     <|>
  99                     do xs   <- many1 inlineElement
 100                        rest <- items stack
 101                        return (Right xs : rest)
 102                     <|>
 103                     try ( newline
 104                           >>
 105                           string stack
 106                           >>
 107                           items stack
 108                         )
 109                     <|>
 110                     return []
 111 -}
 112
 113       toType :: Char -> ListType
 114       toType '*' = Bullet
 115       toType '#' = Numbered
 116
 117
 118 leadingSpaced :: Parser BlockElement
 119 leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
 120     where
 121       leadingSpaced' :: Parser [InlineElement]
 122       leadingSpaced' = do x  <- inlineElement
 123                           xs <- leadingSpaced'
 124                           return (x:xs)
 125                        <|>
 126                        try ( newline
 127                              >>
 128                              char ' '
 129                              >>
 130                              leadingSpaced'
 131                              >>=
 132                              return . (Text "\n" :)
 133                            )
 134                        <|>
 135                        return []
 136
 137
 138 blockTag :: Parser BlockElement
 139 blockTag = pzero -- not implemented
 140
 141
 142 paragraph :: Parser BlockElement
 143 paragraph = paragraph' >>= return . Paragraph
 144     where
 145       paragraph' :: Parser [InlineElement]
 146       paragraph' = do x  <- inlineElement
 147                       xs <- try ( do newline
 148                                      eof
 149                                      return []
 150                                   -- \n で文字列が終はってゐたら、ここ
 151                                   -- で終了。
 152                                 )
 153                             <|>
 154                             try ( do newline
 155                                      ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
 156                                      ((blockTag                  >> pzero) <|> return ())
 157                                      ys <- (paragraph' <|> return [])
 158                                      return (Text "\n" : ys)
 159                                   -- \n があり、その次に \n、ブロックタ
 160                                   -- グまたは blockSymbols があれば、
 161                                   -- fail して 最初の newline を讀んだ
 162                                   -- 所まで卷き戻す。
 163                                 )
 164                             <|>
 165                             try paragraph'
 166                             -- それ以外の場合は次の inlineElement から
 167                             -- を讀んで見る。但し一つも無くても良い。
 168                             <|>
 169                             return [] -- 全部失敗したらここで終了。
 170                       return (x:xs)
 171
 172
 173 inlineElement :: Parser InlineElement
 174 inlineElement = skipMany comment
 175                 >>
 176                 ( try text
 177                   <|>
 178                   try pageLink
 179                 )
 180
 181
 182 text :: Parser InlineElement
 183 text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text
 184
 185
 186 pageLink :: Parser InlineElement
 187 pageLink = do string "[["
 188               page     <- option Nothing
 189                           (many1 (noneOf "#|]") >>= return . Just)
 190               fragment <- option Nothing
 191                           (char '#' >> many1 (noneOf "|]") >>= return . Just)
 192               text     <- option Nothing
 193                           (char '|' >> many1 (noneOf "]") >>= return . Just)
 194
 195               case (page, fragment) of
 196                 (Nothing, Nothing) -> pzero
 197                 (_, _)             -> return ()
 198
 199               string "]]"
 200               return $ PageLink page fragment text
 201            <?>
 202            "page link"
 203
 204
 205 comment :: Parser ()
 206 comment = (try (string "<!--") >> skipTillEnd 1)
 207           <?>
 208           "comment"
 209     where
 210       skipTillEnd :: Int -> Parser ()
 211       skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
 212                             <|>
 213                             (try (string "-->") >> case level of
 214                                                      1 -> return ()
 215                                                      n -> skipTillEnd (n - 1))
 216                             <|>
 217                             (anyChar >> skipTillEnd level)
 218                           )
 219
 220
 221 blockSymbols :: [Char]
 222 blockSymbols = " =-*#"
 223
 224
 225 inlineSymbols :: [Char]
 226 inlineSymbols = "<["
 227
 228 -- white space
 229 ws :: Parser ()
 230 ws = skipMany ( (oneOf " \t" >> return ())
 231                 <|>
 232                 comment
 233               )
 234
 235 -- end of line
 236 eol :: Parser ()
 237 eol = ( (newline >> return ())
 238         <|>
 239         eof
 240       )