Wrote many...

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

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index dd87751d29f53e65de60a06e1a404565941b846b..6e4edeb4bc5c604aab1f6e97c0080471c1ebeff4 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -5,6 +5,7 @@ module Rakka.Wiki.Parser
     where
 
 import           Data.Maybe
+import           Network.URI
 import           Rakka.Wiki
 import           Text.ParserCombinators.Parsec
 
@@ -14,7 +15,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 +26,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
@@ -73,16 +73,15 @@ horizontalLine = try ( do count 4 (char '-')
 
 
 listElement :: CommandTypeOf -> Parser BlockElement
-listElement cmdTypeOf = listElement' [] >>= return . List
+listElement cmdTypeOf = listElement' []
     where
-      listElement' :: [Char] -> Parser ListElement
+      listElement' :: [Char] -> Parser BlockElement
       listElement' stack
           = do t  <- oneOf "*#"
                ws
                xs <- items (stack ++ [t])
-               return (ListElement (toType t) xs)
+               return (List (toType t) xs)
 
-      -- ListItem の終了條件は、
       items :: [Char] -> Parser [ListItem]
       items stack = do xs     <- many1 $ inlineElement cmdTypeOf
                        nested <- option Nothing
@@ -91,7 +90,7 @@ listElement cmdTypeOf = listElement' [] >>= return . List
                                             string stack
                                             listElement' stack >>= return . Just
                        rest <- items stack
-                       return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
+                       return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest
                     <|>
                     (try $ do skipMany comment
                               newline
@@ -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,13 +220,71 @@ 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
+                                       }
+
+                  Just InlineCommandType
+                      -> pzero
+
+                  _   -> return $ undefinedCmdErr tagName
+      )
+      <|>
+      (try $ do (tagName, tagAttrs) <- emptyTag
+                case cmdTypeOf tagName of
+                  Just BlockCommandType
+                      -> return $ BlockCmd $ BlockCommand {
+                                         bCmdName       = tagName
+                                       , bCmdAttributes = tagAttrs
+                                       , bCmdContents   = []
+                                       }
+
+                  Just InlineCommandType
+                      -> pzero
+
+                  _   -> return $ undefinedCmdErr tagName
+      )
+      <?>
+      "block command"
+    where
+      contents :: Parser [BlockElement]
+      contents = do x  <- blockElement cmdTypeOf
+                    xs <- contents
+                    return (x:xs)
+                 <|>
+                 (newline >> contents)
+                 <|>
+                 (comment >> contents)
+                 <|>
+                 return []
+
+      undefinedCmdErr :: String -> BlockElement
+      undefinedCmdErr name
+          = Div [("class", "error")]
+            [ Block (Paragraph [Text ("The command `" ++ name ++ "' is not defined. " ++
+                                      "Make sure you haven't mistyped.")
+                               ])
+            ]
+
+
 inlineElement :: CommandTypeOf -> Parser InlineElement
 inlineElement cmdTypeOf
     = try $ do skipMany comment
                foldr (<|>) pzero [ cdata
                                  , apostrophes cmdTypeOf
                                  , text
+                                 , objLink
                                  , pageLink
+                                 , extLink
                                  , inlineCmd cmdTypeOf
                                  ]
 
@@ -288,6 +344,17 @@ apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4,
       apos n = count n (char '\'') >> notFollowedBy (char '\'')
 
 
+objLink :: Parser InlineElement
+objLink = do try (string "[[[")
+             page <- many1 (noneOf "|]")
+             text <- option Nothing
+                     (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
+             string "]]]"
+             return $ ObjectLink page text
+          <?>
+          "object link"
+
+
 pageLink :: Parser InlineElement
 pageLink = do try (string "[[")
               page     <- option Nothing 
@@ -307,6 +374,20 @@ pageLink = do try (string "[[")
            "page link"
 
 
+extLink :: Parser InlineElement
+extLink = do char '['
+             uriStr <- many1 (noneOf " \t]")
+             skipMany (oneOf " \t")
+             text <- option Nothing
+                     (many1 (noneOf "]") >>= return . Just)
+             
+             case parseURI uriStr of
+               Just uri -> char ']' >> return (ExternalLink uri text)
+               Nothing  -> pzero <?> "absolute URI"
+          <?>
+          "external link"
+
+
 inlineCmd :: CommandTypeOf -> Parser InlineElement
 inlineCmd cmdTypeOf
     = (try $ do (tagName, tagAttrs) <- openTag
@@ -317,7 +398,7 @@ inlineCmd cmdTypeOf
                             return $ InlineCmd $ InlineCommand {
                                          iCmdName       = tagName
                                        , iCmdAttributes = tagAttrs
-                                       , iCmdContents   =  xs
+                                       , iCmdContents   = xs
                                        }
                   _   -> pzero
       )
@@ -332,6 +413,8 @@ inlineCmd cmdTypeOf
                                        }
                   _   -> pzero
       )
+      <?>
+      "inline command"
     where
       contents :: Parser [InlineElement]
       contents = do x  <- inlineElement cmdTypeOf
@@ -408,7 +491,7 @@ comment = (try (string "<!--") >> skipTillEnd 1)
 
 
 blockSymbols :: [Char]
-blockSymbols = " =-*#;"
+blockSymbols = " =-*#;<"
 
 
 inlineSymbols :: [Char]