X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Rakka%2FWiki%2FParser.hs;h=912237c7eda8db5b2f7de3ca79e7ad5d257be6fd;hb=f57c5c5ae6c95e68b11400718e7ce5de4ea1317a;hp=0433612ba5746bcd98312f5993b6847831336717;hpb=7c3065043cdfbd96539a9bf6bff9b1d4281c0b2a;p=Rakka.git

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 0433612..912237c 100644
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -5,8 +5,9 @@ module Rakka.Wiki.Parser
     where
 
 import           Data.Maybe
+import           Network.URI hiding (fragment)
 import           Rakka.Wiki
-import           Text.ParserCombinators.Parsec
+import           Text.ParserCombinators.Parsec hiding (label)
 
 
 type CommandTypeOf = String -> Maybe CommandType
@@ -33,7 +34,7 @@ blockElement cmdTypeOf
                                  , horizontalLine
                                  , listElement cmdTypeOf
                                  , definitionList cmdTypeOf
-                                 , pdata
+                                 , verbatim
                                  , leadingSpaced cmdTypeOf
                                  , paragraph cmdTypeOf
                                  , blockCmd cmdTypeOf
@@ -72,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
@@ -90,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
@@ -104,6 +104,7 @@ listElement cmdTypeOf = listElement' [] >>= return . List
       toType :: Char -> ListType
       toType '*' = Bullet
       toType '#' = Numbered
+      toType _   = undefined
 
 
 definitionList :: CommandTypeOf -> Parser BlockElement
@@ -149,19 +150,19 @@ definitionList cmdTypeOf = 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])
+verbatim :: Parser BlockElement
+verbatim = do try (string "<!verbatim[")
+              many (oneOf " \t\n")
+              x <- verbatim'
+              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)
+      verbatim' :: Parser String
+      verbatim' = do try (many (oneOf " \t\n") >> string "]>")
+                     return []
+                  <|>
+                  do x  <- anyChar
+                     xs <- verbatim'
+                     return (x:xs)
 
 
 leadingSpaced :: CommandTypeOf -> Parser BlockElement
@@ -186,10 +187,6 @@ leadingSpaced cmdTypeOf = (char ' ' >> leadingSpaced' >>= return . Preformatted)
                        return []
 
 
-blockCommand :: Parser BlockElement
-blockCommand = pzero -- not implemented
-
-
 paragraph :: CommandTypeOf -> Parser BlockElement
 paragraph cmdTypeOf = paragraph' >>= return . Paragraph
     where
@@ -232,7 +229,11 @@ blockCmd cmdTypeOf
                                        , bCmdAttributes = tagAttrs
                                        , bCmdContents   = xs
                                        }
-                  _   -> pzero
+
+                  Just InlineCommandType
+                      -> pzero
+
+                  _   -> return $ undefinedCmdErr tagName
       )
       <|>
       (try $ do (tagName, tagAttrs) <- emptyTag
@@ -243,7 +244,11 @@ blockCmd cmdTypeOf
                                        , bCmdAttributes = tagAttrs
                                        , bCmdContents   = []
                                        }
-                  _   -> pzero
+
+                  Just InlineCommandType
+                      -> pzero
+
+                  _   -> return $ undefinedCmdErr tagName
       )
       <?>
       "block command"
@@ -259,28 +264,38 @@ blockCmd cmdTypeOf
                  <|>
                  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
+               foldr (<|>) pzero [ nowiki
                                  , apostrophes cmdTypeOf
                                  , text
+                                 , objLink
                                  , pageLink
+                                 , extLink
                                  , inlineCmd cmdTypeOf
                                  ]
 
 
-cdata :: Parser InlineElement
-cdata = try (string "<![CDATA[") >> cdata' >>= return . Text
+nowiki :: Parser InlineElement
+nowiki = try (string "<!nowiki[") >> nowiki' >>= return . Text
     where
-      cdata' :: Parser String
-      cdata' = do try (string "]]>")
-                  return []
-               <|>
-               do x  <- anyChar
-                  xs <- cdata'
-                  return (x:xs)
+      nowiki' :: Parser String
+      nowiki' = do try (string "]>")
+                   return []
+                <|>
+                do x  <- anyChar
+                   xs <- nowiki'
+                   return (x:xs)
 
 
 text :: Parser InlineElement
@@ -326,13 +341,24 @@ 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 "|]")
+             label <- option Nothing
+                      (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
+             string "]]]"
+             return $ ObjectLink page label
+          <?>
+          "object link"
+
+
 pageLink :: Parser InlineElement
 pageLink = do try (string "[[")
               page     <- option Nothing 
                           (many1 (noneOf "#|]") >>= return . Just)
               fragment <- option Nothing
                           (char '#' >> many1 (noneOf "|]") >>= return . Just)
-              text     <- option Nothing
+              label    <- option Nothing
                           (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
 
               case (page, fragment) of
@@ -340,11 +366,25 @@ pageLink = do try (string "[[")
                 (_, _)             -> return ()
 
               string "]]"
-              return $ PageLink page fragment text
+              return $ PageLink page fragment label
            <?>
            "page link"
 
 
+extLink :: Parser InlineElement
+extLink = do char '['
+             uriStr <- many1 (noneOf " \t]")
+             skipMany (oneOf " \t")
+             label  <- option Nothing
+                       (many1 (noneOf "]") >>= return . Just)
+             
+             case parseURI uriStr of
+               Just uri -> char ']' >> return (ExternalLink uri label)
+               Nothing  -> pzero <?> "absolute URI"
+          <?>
+          "external link"
+
+
 inlineCmd :: CommandTypeOf -> Parser InlineElement
 inlineCmd cmdTypeOf
     = (try $ do (tagName, tagAttrs) <- openTag