implemented listing

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

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 0125419c45d6d3fda915dfb8785462ec3572b00e..83e3301fd62c8da175fcc1d38d0ca257879cb54c 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,12 @@ blockElement = skipMany ( comment
                         )
                >>
                ( heading
+                 <|>
+                 horizontalLine
+                 <|>
+                 listElement
+                 <|>
+                 leadingSpaced
                  <|>
                  paragraph
                )
@@ -49,6 +56,89 @@ 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
+
+
+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 []
+{-
+      items stack = do nested <- listElement' stack
+                       rest   <- items stack
+                       return (Left nested : rest)
+                    <|>
+                    do xs   <- many1 inlineElement
+                       rest <- items stack
+                       return (Right xs : rest)
+                    <|>
+                    try ( newline
+                          >>
+                          string stack
+                          >>
+                          items stack
+                        )
+                    <|>
+                    return []
+-}
+
+      toType :: Char -> ListType
+      toType '*' = Bullet
+      toType '#' = Numbered
+
+
+leadingSpaced :: Parser BlockElement
+leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
+    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 +153,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'
@@ -128,7 +219,7 @@ comment = (try (string "<!--") >> skipTillEnd 1)
 
 
 blockSymbols :: [Char]
-blockSymbols = "="
+blockSymbols = " =-*#"
 
 
 inlineSymbols :: [Char]