implemented more markup stuffs

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

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 017df8952fb09bfce930ca4c2ecd950f50ed8b3d..db26a497b7eb66e15107b12b8fcd023f4eddfaa5 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -32,6 +32,8 @@ blockElement = skipMany ( comment
                  <|>
                  definitionList
                  <|>
+                 pdata
+                 <|>
                  leadingSpaced
                  <|>
                  paragraph
@@ -59,11 +61,14 @@ heading = foldr (<|>) pzero (map heading' [1..5])
 
 
 horizontalLine :: Parser BlockElement
-horizontalLine = try $ do count 4 (char '-')
+horizontalLine = try ( do count 4 (char '-')
                           many (char '-')
                           ws
                           eol
                           return HorizontalLine
+                     )
+                 <?>
+                 "horizontal line"
 
 
 listElement :: Parser BlockElement
@@ -142,8 +147,25 @@ definitionList = many1 definition >>= return . DefinitionList
                     "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 . LeadingSpaced
+leadingSpaced = (char ' ' >> leadingSpaced' >>= return . Preformatted)
+                <?>
+                "leading space"
     where
       leadingSpaced' :: Parser [InlineElement]
       leadingSpaced' = do x  <- inlineElement
@@ -200,29 +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 = ( char ':'
          >>
-         many (noneOf ('\n':':':inlineSymbols))
+         many (noneOf ('\n':inlineSymbols))
          >>=
          return . Text . (':' :)
-         -- 定義リストとの關係上、コロンは先頭にしか存在できない。
+         -- 定義リストとの關係上、コロンは先頭にしか來れない。
        )
        <|>
-       ( many1 (noneOf ('\n':':':inlineSymbols))
+       ( 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
@@ -261,7 +327,7 @@ blockSymbols = " =-*#;"
 
 
 inlineSymbols :: [Char]
-inlineSymbols = "<["
+inlineSymbols = "<[:'"
 
 -- white space
 ws :: Parser ()