The experimental change worked well.

darcs-hash:20071012053301-62b54-4c062bd45a3526cca4d3e1fb0f6d6d51a03a4a14.gz

diff --git a/Rakka/Wiki.hs b/Rakka/Wiki.hs
index 3011b136a4568a41ff1e92492161cefd7855d0a1..9e80df45271fda486f47f2ee1fdb2dccb8d611aa 100644 (file)
--- a/Rakka/Wiki.hs
+++ b/Rakka/Wiki.hs
@@ -1,6 +1,5 @@
 module Rakka.Wiki
     ( WikiPage
-    , WikiElement(..)
     , BlockElement(..)
     , InlineElement(..)
     )
@@ -9,13 +8,7 @@ module Rakka.Wiki
 import           Rakka.Page
 
 
-type WikiPage = [WikiElement]
-
-
-data WikiElement
-    = Block  !BlockElement
-    | Inline !InlineElement
-    deriving (Eq, Show)
+type WikiPage = [BlockElement]
 
 
 data BlockElement
@@ -23,7 +16,7 @@ data BlockElement
         headingLevel :: !Int
       , headingText  :: !String
       }
-    | EmptyLine
+    | Paragraph ![InlineElement]
     deriving (Eq, Show)
 
 

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 5aa5db4ac90e5d81a13ac28eedd086e90a585766..4cb150fa74b458b3a9431aa2248154123f239039 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -40,9 +40,9 @@ formatWikiPage env
             Left  err
                 -> formatParseError -< err
 
-            Right elems
+            Right blocks
                 -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
-                      formatWikiElements -< (baseURI, elems)
+                      formatWikiBlocks -< (baseURI, blocks)
 
 
 formatParseError :: ArrowXml a => a ParseError XmlTree

diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 13827690070fd7d2031b471f39fd315920026d51..8d219d2a8e39b19b3a77893ce60ca99cb01db8a7 100644 (file)
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -1,5 +1,5 @@
 module Rakka.Wiki.Formatter
-    ( formatWikiElements
+    ( formatWikiBlocks
     )
     where
 
@@ -15,40 +15,22 @@ import           Text.XML.HXT.Arrow.XmlArrow
 import           Text.XML.HXT.DOM.TypeDefs
 
 
--- 複數の Inline を一つに纏める
-packParagraph :: [WikiElement] -> [Either BlockElement [InlineElement]]
-packParagraph elems = map pack grp
-    where
-      grp :: [[WikiElement]]
-      grp = groupBy criteria elems
-
-      criteria :: WikiElement -> WikiElement -> Bool
-      criteria (Inline _) (Inline _) = True
-      criteria _ _                   = False
-
-      pack :: [WikiElement] -> Either BlockElement [InlineElement]
-      pack (Block b : []) = Left b
-      pack xs             = Right [ case x of
-                                      Inline i -> i | x <- xs ]
-                                                       
-
-formatWikiElements :: (ArrowXml a, ArrowChoice a) => a (URI, [WikiElement]) XmlTree
-formatWikiElements
-    = proc (baseURI, elems)
-    -> do chunk <- arrL id -< packParagraph elems
-          case chunk of
-            Left  x  -> formatBlock     -< x
-            Right xs -> formatParagraph -< (baseURI, xs)
+formatWikiBlocks :: (ArrowXml a, ArrowChoice a) => a (URI, [BlockElement]) XmlTree
+formatWikiBlocks
+    = proc (baseURI, blocks)
+    -> do block <- arrL id -< blocks
+          formatBlock -< (baseURI, block)
 
 
-formatBlock :: (ArrowXml a, ArrowChoice a) => a BlockElement XmlTree
+formatBlock :: (ArrowXml a, ArrowChoice a) => a (URI, BlockElement) XmlTree
 formatBlock 
-    = proc b
-    -> case b of
+    = proc (baseURI, block)
+    -> case block of
          Heading level text
              -> formatHeading -< (level, text)
-         EmptyLine
-             -> none -< ()
+                
+         Paragraph inlines
+             -> formatParagraph -< (baseURI, inlines)
 
 
 formatHeading :: ArrowXml a => a (Int, String) XmlTree

diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs
index 52e430a7e4cc12df5771fe0fe9c3695563b6df7d..0125419c45d6d3fda915dfb8785462ec3572b00e 100644 (file)
--- a/Rakka/Wiki/Parser.hs
+++ b/Rakka/Wiki/Parser.hs
@@ -8,66 +8,88 @@ import           Text.ParserCombinators.Parsec
 
 
 wikiPage :: Parser WikiPage
-wikiPage = do xs <- many (try wikiElement)
-              skipMany comment
+wikiPage = do xs <- many (try blockElement)
+              skipMany ( comment
+                         <|>
+                         (newline >> return ())
+                       )
               eof
               return xs
 
 
-wikiElement :: Parser WikiElement
-wikiElement = skipMany comment >>
-              ( try (blockElement >>= return . Block)
-                <|>
-                try (inlineElement >>= return . Inline)
-              )
-
-
 blockElement :: Parser BlockElement
-blockElement = ( try heading
+blockElement = skipMany ( comment
+                          <|>
+                          (newline >> return ())
+                        )
+               >>
+               ( heading
                  <|>
-                 try emptyLine
+                 paragraph
                )
 
 
 heading :: Parser BlockElement
-heading = foldr (<|>) pzero (map (try . heading') [1..5])
+heading = foldr (<|>) pzero (map heading' [1..5])
           <?>
           "heading"
     where
       heading' :: Int -> Parser BlockElement
-      heading' n = do count n (char '=')
-                      notFollowedBy (char '=')
+      heading' n = do try $ do count n (char '=')
+                               notFollowedBy (char '=')
                       ws
                       x  <- notFollowedBy (char '=') >> anyChar
-                      xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
+                      xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
+                                                            <?>
+                                                            ("trailing " ++ take n (repeat '='))
+                                                          )
+                                             )
                       ws
                       eol
                       return (Heading n (x:xs))
 
 
-emptyLine :: Parser BlockElement
-emptyLine = count 2 newline >> many newline >> return EmptyLine
-            <?>
-            "empty line"
+paragraph :: Parser BlockElement
+paragraph = paragraph' >>= return . Paragraph
+    where
+      paragraph' :: Parser [InlineElement]
+      paragraph' = do x  <- inlineElement
+                      xs <- try ( do newline
+                                     eof
+                                     return []
+                                  -- \n で文字列が終はってゐたら、ここ
+                                  -- で終了。
+                                )
+                            <|>
+                            try ( do newline
+                                     ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
+                                     ys <- (paragraph' <|> return [])
+                                     return (Text "\n" : ys)
+                                  -- \n があり、その次に \n または
+                                  -- blockSymbols があれば、fail して
+                                  -- 最初の newline を讀んだ所まで卷き
+                                  -- 戻す。
+                                )
+                            <|>
+                            try paragraph'
+                            -- それ以外の場合は次の inlineElement から
+                            -- を讀んで見る。但し一つも無くても良い。
+                            <|>
+                            return [] -- 全部失敗したらここで終了。
+                      return (x:xs)
 
 
 inlineElement :: Parser InlineElement
-inlineElement = ( try text
+inlineElement = skipMany comment
+                >>
+                ( try text
                   <|>
                   try pageLink
                 )
 
 
 text :: Parser InlineElement
-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:)
+text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text
 
 
 pageLink :: Parser InlineElement
@@ -105,6 +127,10 @@ comment = (try (string "<!--") >> skipTillEnd 1)
                           )
 
 
+blockSymbols :: [Char]
+blockSymbols = "="
+
+
 inlineSymbols :: [Char]
 inlineSymbols = "<["
 
@@ -117,7 +143,7 @@ ws = skipMany ( (oneOf " \t" >> return ())
 
 -- end of line
 eol :: Parser ()
-eol = ( (many1 newline >> return ())
+eol = ( (newline >> return ())
         <|>
         eof
       )

diff --git a/test/WikiParserTest.hs b/test/WikiParserTest.hs
index b4e95b181f302dacb3e4ea2140946ca0c6cd8409..8585019f288e8b7fd866d2e55f422963dd2fcb7f 100644 (file)
--- a/test/WikiParserTest.hs
+++ b/test/WikiParserTest.hs
@@ -20,50 +20,59 @@ testData = [ (parseWiki ""
               ~?=
               (Right []))
 
+           , (parseWiki "\n"
+              ~?=
+              (Right []))
+
            , (parseWiki "=heading="
               ~?=
-              (Right [Block (Heading 1 "heading")]))
+              (Right [ Heading 1 "heading" ]))
 
            , (parseWiki "==      heading  ==  \n"
               ~?=
-              (Right [Block (Heading 2 "heading")]))
+              (Right [ Heading 2 "heading" ]))
 
            , (parseWiki "===== hello world =====\n"
               ~?=
-              (Right [Block (Heading 5 "hello world")]))
+              (Right [ Heading 5 "hello world" ]))
 
            , (parseWiki "a =not a heading="
               ~?=
-              (Right [Inline (Text "a =not a heading=")]))
+              (Right [ Paragraph [ Text "a =not a heading=" ]
+                     ]))
 
            , (parseWiki "=h=\n\n=h="
               ~?=
-              (Right [ Block (Heading 1 "h")
-                     , Block (Heading 1 "h")
+              (Right [ Heading 1 "h"
+                     , Heading 1 "h"
+                     ]))
+           , (parseWiki "foo\nbar"
+              ~?=
+              (Right [ Paragraph [ Text "foo"
+                                 , Text "\n"
+                                 , Text "bar"
+                                 ]
                      ]))
-
            , (parseWiki "foo\nbar\n\nbaz\n"
               ~?=
-              (Right [ Inline (Text "foo")
-                     , Inline (Text "\n")
-                     , Inline (Text "bar")
-                     , Block EmptyLine
-                     , Inline (Text "baz")
-                     , Inline (Text "\n")
+              (Right [ Paragraph [ Text "foo"
+                                 , Text "\n"
+                                 , Text "bar"
+                                 ]
+                     , Paragraph [ Text "baz"
+                                 ]
                      ]))
 
            , (parseWiki "foo\n\n\nbar"
               ~?=
-              (Right [ Inline (Text "foo")
-                     , Block EmptyLine
-                     , Inline (Text "bar")
+              (Right [ Paragraph [ Text "foo" ]
+                     , Paragraph [ Text "bar" ]
                      ]))
 
            , (parseWiki "foo\n=h="
               ~?=
-              (Right [ Inline (Text "foo")
-                     , Inline (Text "\n")
-                     , Block (Heading 1 "h")
+              (Right [ Paragraph [ Text "foo" ]
+                     , Heading 1 "h"
                      ]))
 
            , (parseWiki "<!-- comment -->"
@@ -72,25 +81,28 @@ testData = [ (parseWiki ""
 
            , (parseWiki "<!-- comment -->foo"
               ~?=
-              (Right [Inline (Text "foo")]))
+              (Right [ Paragraph [ Text "foo" ]
+                     ]))
 
-           , (parseWiki "foo<!-- comment -->"
+           , (parseWiki "bar<!-- comment -->"
               ~?=
-              (Right [Inline (Text "foo")]))
+              (Right [ Paragraph [ Text "bar" ]
+                     ]))
 
            , (parseWiki "foo<!-- comment -->bar"
               ~?=
-              (Right [ Inline (Text "foo")
-                     , Inline (Text "bar")
+              (Right [ Paragraph [ Text "foo"
+                                 , Text "bar"
+                                 ]
                      ]))
 
            , (parseWiki "<!-- comment -->=h="
               ~?=
-              (Right [Block (Heading 1 "h")]))
+              (Right [ Heading 1 "h" ]))
 
            , (parseWiki "=h= <!---->"
               ~?=
-              (Right [Block (Heading 1 "h")]))
+              (Right [ Heading 1 "h" ]))
 
            , (parseWiki "<!-- <!-- nested --> comment -->"
               ~?=
@@ -98,35 +110,42 @@ testData = [ (parseWiki ""
 
            , (parseWiki "[[Page]]"
               ~?= 
-              (Right [Inline (PageLink (Just "Page") Nothing Nothing)]))
+              (Right [ Paragraph [ PageLink (Just "Page") Nothing Nothing ]
+                     ]))
 
            , (parseWiki "[[Page|Link to \"Page\"]]"
               ~?=
-              (Right [Inline (PageLink (Just "Page") Nothing (Just "Link to \"Page\""))]))
+              (Right [ Paragraph [ PageLink (Just "Page") Nothing (Just "Link to \"Page\"") ]
+                     ]))
 
            , (parseWiki "[[Page#foo]]"
               ~?= 
-              (Right [Inline (PageLink (Just "Page") (Just "foo") Nothing)]))
+              (Right [ Paragraph [ PageLink (Just "Page") (Just "foo") Nothing ]
+                     ]))
 
            , (parseWiki "[[#foo]]"
               ~?= 
-              (Right [Inline (PageLink Nothing (Just "foo") Nothing)]))
+              (Right [ Paragraph [ PageLink Nothing (Just "foo") Nothing ]
+                     ]))
 
            , (parseWiki "[[Page#foo|Link to \"Page#foo\"]]"
               ~?=
-              (Right [Inline (PageLink (Just "Page") (Just "foo") (Just "Link to \"Page#foo\""))]))
+              (Right [ Paragraph [ PageLink (Just "Page") (Just "foo") (Just "Link to \"Page#foo\"") ]
+                     ]))
 
            , (parseWiki "foo [[Bar]] baz"
               ~?=
-              (Right [ Inline (Text "foo ")
-                     , Inline (PageLink (Just "Bar") Nothing Nothing)
-                     , Inline (Text " baz")
+              (Right [ Paragraph [ Text "foo "
+                                 , PageLink (Just "Bar") Nothing Nothing
+                                 , Text " baz"
+                                 ]
                      ]))
 
            , (parseWiki "[[Foo]]\n[[Bar]]"
               ~?= 
-              (Right [ Inline (PageLink (Just "Foo") Nothing Nothing)
-                     , Inline (Text "\n")
-                     , Inline (PageLink (Just "Bar") Nothing Nothing)
+              (Right [ Paragraph [ PageLink (Just "Foo") Nothing Nothing
+                                 , Text "\n"
+                                 , PageLink (Just "Bar") Nothing Nothing
+                                 ]
                      ]))
            ]