implemented more markup stuffs

[Rakka.git] / Rakka / Wiki / Parser.hs

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 0125419c45d6d3fda915dfb8785462ec3572b00e..db26a497b7eb66e15107b12b8fcd023f4eddfaa5 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -3,6 +3,7 @@ module Rakka.Wiki.Parser
     )
     where
 
+import           Data.Maybe
 import           Rakka.Wiki
 import           Text.ParserCombinators.Parsec
 
@@ -24,6 +25,16 @@ blockElement = skipMany ( comment
                         )
                >>
                ( heading
+                 <|>
+                 horizontalLine
+                 <|>
+                 listElement
+                 <|>
+                 definitionList
+                 <|>
+                 pdata
+                 <|>
+                 leadingSpaced
                  <|>
                  paragraph
                )
@@ -49,6 +60,134 @@ heading = foldr (<|>) pzero (map heading' [1..5])
                       return (Heading n (x:xs))
 
 
+horizontalLine :: Parser BlockElement
+horizontalLine = try ( do count 4 (char '-')
+                          many (char '-')
+                          ws
+                          eol
+                          return HorizontalLine
+                     )
+                 <?>
+                 "horizontal line"
+
+
+listElement :: Parser BlockElement
+listElement = listElement' [] >>= return . List
+    where
+      listElement' :: [Char] -> Parser ListElement
+      listElement' stack
+          = try $ do t  <- oneOf "*#"
+                     ws
+                     xs <- items (stack ++ [t])
+                     return (ListElement (toType t) xs)
+
+      -- ListItem の終了條件は、
+      items :: [Char] -> Parser [ListItem]
+      items stack = do xs     <- many1 inlineElement
+                       nested <- option Nothing
+                                 $ try $ do newline
+                                            string stack
+                                            listElement' stack >>= return . Just
+                       rest <- items stack
+                       return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
+                    <|>
+                    (try $ do newline
+                              string stack
+                              ws
+                              items stack
+                    )
+                    <|>
+                    return []
+
+      toType :: Char -> ListType
+      toType '*' = Bullet
+      toType '#' = Numbered
+
+
+definitionList :: Parser BlockElement
+definitionList = many1 definition >>= return . DefinitionList
+    where
+      definition :: Parser Definition
+      definition = do char ';'
+                      ws
+                      tHead <- inlineElement
+                      tRest <- term
+                      d     <- description
+                      return (Definition (tHead:tRest) d)
+                   <?>
+                   "definition list"
+
+      term :: Parser [InlineElement]
+      term = (char ':' >> ws >> return [])
+             <|>
+             (newline >> char ':' >> ws >> return [])
+             <|>
+             do x  <- inlineElement
+                xs <- term
+                return (x:xs)
+             <?>
+             "term to be defined"
+
+      description :: Parser [InlineElement]
+      description = do x  <- inlineElement
+                       xs <- description
+                       return (x:xs)
+                    <|>
+                    try ( do newline
+                             char ':'
+                             ws
+                             xs <- description
+                             return (Text "\n" : xs)
+                        )
+                    <|>
+                    (newline >> return [])
+                    <|>
+                    (eof >> return [])
+                    <?>
+                    "description of term"
+
+
+pdata :: Parser BlockElement
+pdata = do try (string "<![PDATA[")
+           many (oneOf " \t\n")
+           x <- pdata'
+           return (Preformatted [Text x])
+    where
+      pdata' :: Parser String
+      pdata' = do try (many (oneOf " \t\n") >> string "]]>")
+                  return []
+               <|>
+               do x  <- anyChar
+                  xs <- pdata'
+                  return (x:xs)
+
+
+leadingSpaced :: Parser BlockElement
+leadingSpaced = (char ' ' >> leadingSpaced' >>= return . Preformatted)
+                <?>
+                "leading space"
+    where
+      leadingSpaced' :: Parser [InlineElement]
+      leadingSpaced' = do x  <- inlineElement
+                          xs <- leadingSpaced'
+                          return (x:xs)
+                       <|>
+                       try ( newline
+                             >>
+                             char ' '
+                             >>
+                             leadingSpaced'
+                             >>=
+                             return . (Text "\n" :)
+                           )
+                       <|>
+                       return []
+
+
+blockTag :: Parser BlockElement
+blockTag = pzero -- not implemented
+
+
 paragraph :: Parser BlockElement
 paragraph = paragraph' >>= return . Paragraph
     where
@@ -63,12 +202,13 @@ paragraph = paragraph' >>= return . Paragraph
                             <|>
                             try ( do newline
                                      ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
+                                     ((blockTag                  >> pzero) <|> return ())
                                      ys <- (paragraph' <|> return [])
                                      return (Text "\n" : ys)
-                                  -- \n があり、その次に \n または
-                                  -- blockSymbols があれば、fail して
-                                  -- 最初の newline を讀んだ所まで卷き
-                                  -- 戻す。
+                                  -- \n があり、その次に \n、ブロックタ
+                                  -- グまたは blockSymbols があれば、
+                                  -- fail して 最初の newline を讀んだ
+                                  -- æ\89\80ã\81¾ã\81§å\8d·ã\81\8dæ\88»ã\81\99ã\80\82
                                 )
                             <|>
                             try paragraph'
@@ -82,18 +222,73 @@ paragraph = paragraph' >>= return . Paragraph
 inlineElement :: Parser InlineElement
 inlineElement = skipMany comment
                 >>
-                ( try text
+                ( cdata
+                  <|>
+                  apostrophes
                   <|>
-                  try pageLink
+                  text
+                  <|>
+                  pageLink
                 )
 
 
+cdata :: Parser InlineElement
+cdata = try (string "<![CDATA[") >> cdata' >>= return . Text
+    where
+      cdata' :: Parser String
+      cdata' = do try (string "]]>")
+                  return []
+               <|>
+               do x  <- anyChar
+                  xs <- cdata'
+                  return (x:xs)
+
+
 text :: Parser InlineElement
-text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text
+text = ( char ':'
+         >>
+         many (noneOf ('\n':inlineSymbols))
+         >>=
+         return . Text . (':' :)
+         -- 定義リストとの關係上、コロンは先頭にしか來れない。
+       )
+       <|>
+       ( many1 (noneOf ('\n':inlineSymbols))
+         >>=
+         return . Text
+       )
+       <?>
+       "text"
+
+
+apostrophes :: Parser InlineElement
+apostrophes = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, apos5])
+    where
+      apos1 = apos 1 >> return (Text "'")
+
+      apos2 = do apos 2
+                 xs <- many1 inlineElement
+                 apos 2
+                 return (Italic xs)
+
+      apos3 = do apos 3
+                 xs <- many1 inlineElement
+                 apos 3
+                 return (Bold xs)
+
+      apos4 = apos 4 >> return (Text "'")
+
+      apos5 = do apos 5
+                 xs <- many1 inlineElement
+                 apos 5
+                 return (Italic [Bold xs])
+
+      apos :: Int -> Parser ()
+      apos n = count n (char '\'') >> notFollowedBy (char '\'')
 
 
 pageLink :: Parser InlineElement
-pageLink = do string "[["
+pageLink = do try (string "[[")
               page     <- option Nothing 
                           (many1 (noneOf "#|]") >>= return . Just)
               fragment <- option Nothing
@@ -128,11 +323,11 @@ comment = (try (string "<!--") >> skipTillEnd 1)
 
 
 blockSymbols :: [Char]
-blockSymbols = "="
+blockSymbols = " =-*#;"
 
 
 inlineSymbols :: [Char]
-inlineSymbols = "<["
+inlineSymbols = "<[:'"
 
 -- white space
 ws :: Parser ()