X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Rakka%2FWiki%2FParser.hs;h=968e6451673a72ad680a5b9c4c391d68b3cdfc81;hb=1647278f9393f7382b6e8b8a5e9e14ce50aae718;hp=b5ec74d509f9ec8e2f840bbf8f9851499e0a1406;hpb=8a7556db44cd91ac0bb52279472bcc2abaa3f18e;p=Rakka.git

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index b5ec74d..968e645 100644
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -3,69 +3,124 @@ module Rakka.Wiki.Parser
     )
     where
 
+import           Data.Char
 import           Rakka.Wiki
 import           Text.ParserCombinators.Parsec
 
 
 wikiPage :: Parser WikiPage
-wikiPage = do xs <- many wikiElement
+wikiPage = do xs <- many (try wikiElement)
+              skipMany comment
               eof
               return xs
 
 
 wikiElement :: Parser WikiElement
-wikiElement = ( try (blockElement >>= return . Block)
+wikiElement = skipMany comment >>
+              ( try (blockElement >>= return . Block)
                 <|>
                 try (inlineElement >>= return . Inline)
               )
 
 
 blockElement :: Parser BlockElement
-blockElement = ( try header
+blockElement = ( try heading
                  <|>
                  try emptyLine
                )
 
 
-header :: Parser BlockElement
-header = foldr (<|>) pzero (map (try . header') [1..5])
+heading :: Parser BlockElement
+heading = foldr (<|>) pzero (map (try . heading') [1..5])
+          <?>
+          "heading"
     where
-      header' :: Int -> Parser BlockElement
-      header' n = do count n (char '=')
-                     notFollowedBy (char '=')
-                     ws
-                     x  <- notFollowedBy (char '=') >> anyChar
-                     xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
-                     ws
-                     eol
-                     return (Header n (x:xs))
+      heading' :: Int -> Parser BlockElement
+      heading' n = do count n (char '=')
+                      notFollowedBy (char '=')
+                      ws
+                      x  <- notFollowedBy (char '=') >> anyChar
+                      xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
+                      ws
+                      eol
+                      return (Heading n (x:xs))
 
 
 emptyLine :: Parser BlockElement
-emptyLine = newline >> return EmptyLine
+emptyLine = count 2 newline >> many newline >> return EmptyLine
+            <?>
+            "empty line"
 
 
 inlineElement :: Parser InlineElement
-inlineElement = text
+inlineElement = ( try text
+                  <|>
+                  try pageLink
+                )
 
 
 text :: Parser InlineElement
-text = do xs <- many1 (noneOf symbols)
-          nl <- option "" (count 1 newline)
-          return $ Text (xs ++ nl)
-
+text = text' >>= return . Text
+    where
+      text' :: Parser String
+      text' = do x <- noneOf inlineSymbols
+                 case x of
+                   -- 單獨の \n は受け入れる。
+                   '\n' -> return [x]
+                   -- それ以外では \n を受け入れない。
+                   _    -> many (noneOf ('\n':inlineSymbols)) >>= return . (x:)
+
+
+pageLink :: Parser InlineElement
+pageLink = do string "[["
+              page     <- option Nothing $
+                          do x  <- satisfy (\ c -> not (elem c "#|]" || isLower c))
+                             xs <- many (noneOf "#|]")
+                             return $ Just (x:xs)
+              fragment <- option Nothing
+                          (char '#' >> many1 (noneOf "|]") >>= return . Just)
+              text     <- option Nothing
+                          (char '|' >> many1 (noneOf "]") >>= return . Just)
+
+              case (page, fragment) of
+                (Nothing, Nothing) -> pzero
+                (_, _)             -> return ()
+
+              string "]]"
+              return $ PageLink page fragment text
+           <?>
+           "page link"
+
+
+comment :: Parser ()
+comment = (try (string "<!--") >> skipTillEnd 1)
+          <?>
+          "comment"
+    where
+      skipTillEnd :: Int -> Parser ()
+      skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
+                            <|>
+                            (try (string "-->") >> case level of
+                                                     1 -> return ()
+                                                     n -> skipTillEnd (n - 1))
+                            <|>
+                            (anyChar >> skipTillEnd level)
+                          )
 
-symbols :: [Char]
-symbols = "\n"
 
+inlineSymbols :: [Char]
+inlineSymbols = "<["
 
 -- white space
-ws :: Parser String
-ws = many (oneOf " \t")
+ws :: Parser ()
+ws = skipMany ( (oneOf " \t" >> return ())
+                <|>
+                comment
+              )
 
 -- end of line
 eol :: Parser ()
-eol = ( (newline >> return ())
+eol = ( (many1 newline >> return ())
         <|>
         eof
       )