The experimental change worked well.

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

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