Implemented block commands

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

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index dd87751d29f53e65de60a06e1a404565941b846b..313521c23cf89971862f4091657d9ef22bef5348 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -14,7 +14,7 @@ type CommandTypeOf = String -> Maybe CommandType
 
 wikiPage :: CommandTypeOf -> Parser WikiPage
 wikiPage cmdTypeOf
-    = do xs <- many $ try (blockElement cmdTypeOf)
+    = do xs <- many (blockElement cmdTypeOf)
          skipMany ( comment
                     <|>
                     (newline >> return ())
@@ -25,20 +25,19 @@ wikiPage cmdTypeOf
 
 blockElement :: CommandTypeOf -> Parser BlockElement
 blockElement cmdTypeOf
-    = skipMany ( comment
-                 <|>
-                 (newline >> return ())
-               )
-      >>
-      ( foldr (<|>) pzero [ heading
-                          , horizontalLine
-                          , listElement cmdTypeOf
-                          , definitionList cmdTypeOf
-                          , pdata
-                          , leadingSpaced cmdTypeOf
-                          , paragraph cmdTypeOf
-                          ]
-      )
+    = try $ do skipMany ( comment
+                          <|>
+                          (newline >> return ())
+                        )
+               foldr (<|>) pzero [ heading
+                                 , horizontalLine
+                                 , listElement cmdTypeOf
+                                 , definitionList cmdTypeOf
+                                 , pdata
+                                 , leadingSpaced cmdTypeOf
+                                 , paragraph cmdTypeOf
+                                 , blockCmd cmdTypeOf
+                                 ]
 
 
 heading :: Parser BlockElement
@@ -205,16 +204,15 @@ paragraph cmdTypeOf = paragraph' >>= return . Paragraph
                             <|>
                             try ( do newline
                                      ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
-                                     ((blockCommand              >> pzero) <|> return ())
                                      ys <- (paragraph' <|> return [])
                                      return (Text "\n" : ys)
-                                  -- \n があり、その次に \n、ブロックタ
-                                  -- グまたは blockSymbols があれば、
-                                  -- fail して 最初の newline を讀んだ
-                                  -- æ\89\80ã\81¾ã\81§å\8d·ã\81\8dæ\88»ã\81\99ã\80\82
+                                  -- \n があり、その次に \n または
+                                  -- blockSymbols があれば、fail して
+                                  -- 最初の newline を讀んだ所まで卷き
+                                  -- 戻す。
                                 )
                             <|>
-                            try paragraph'
+                            paragraph'
                             -- それ以外の場合は次の inlineElement から
                             -- を讀んで見る。但し一つも無くても良い。
                             <|>
@@ -222,6 +220,44 @@ paragraph cmdTypeOf = paragraph' >>= return . Paragraph
                       return (x:xs)
 
 
+blockCmd :: CommandTypeOf -> Parser BlockElement
+blockCmd cmdTypeOf
+    = (try $ do (tagName, tagAttrs) <- openTag
+                case cmdTypeOf tagName of
+                  Just BlockCommandType
+                      -> do xs <- contents
+                            closeTag tagName
+                            return $ BlockCmd $ BlockCommand {
+                                         bCmdName       = tagName
+                                       , bCmdAttributes = tagAttrs
+                                       , bCmdContents   = xs
+                                       }
+                  _   -> pzero
+      )
+      <|>
+      (try $ do (tagName, tagAttrs) <- emptyTag
+                case cmdTypeOf tagName of
+                  Just BlockCommandType
+                      -> return $ BlockCmd $ BlockCommand {
+                                         bCmdName       = tagName
+                                       , bCmdAttributes = tagAttrs
+                                       , bCmdContents   = []
+                                       }
+                  _   -> pzero
+      )
+      <?>
+      "block command"
+    where
+      contents :: Parser [BlockElement]
+      contents = do x  <- try $ blockElement cmdTypeOf
+                    xs <- contents
+                    return (x:xs)
+                 <|>
+                 (comment >> contents)
+                 <|>
+                 return []
+
+
 inlineElement :: CommandTypeOf -> Parser InlineElement
 inlineElement cmdTypeOf
     = try $ do skipMany comment
@@ -317,7 +353,7 @@ inlineCmd cmdTypeOf
                             return $ InlineCmd $ InlineCommand {
                                          iCmdName       = tagName
                                        , iCmdAttributes = tagAttrs
-                                       , iCmdContents   =  xs
+                                       , iCmdContents   = xs
                                        }
                   _   -> pzero
       )
@@ -332,6 +368,8 @@ inlineCmd cmdTypeOf
                                        }
                   _   -> pzero
       )
+      <?>
+      "inline command"
     where
       contents :: Parser [InlineElement]
       contents = do x  <- inlineElement cmdTypeOf
@@ -408,7 +446,7 @@ comment = (try (string "<!--") >> skipTillEnd 1)
 
 
 blockSymbols :: [Char]
-blockSymbols = " =-*#;"
+blockSymbols = " =-*#;<"
 
 
 inlineSymbols :: [Char]