From: pho Date: Fri, 12 Oct 2007 05:33:01 +0000 (+0900) Subject: The experimental change worked well. X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=87e8b02490f9ca337c1a25de4454d4ad6d1492c6;p=Rakka.git The experimental change worked well. darcs-hash:20071012053301-62b54-4c062bd45a3526cca4d3e1fb0f6d6d51a03a4a14.gz --- diff --git a/Rakka/Wiki.hs b/Rakka/Wiki.hs index 3011b13..9e80df4 100644 --- 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 5aa5db4..4cb150f 100644 --- 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 1382769..8d219d2 100644 --- 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 52e430a..0125419 100644 --- 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 "" @@ -72,25 +81,28 @@ testData = [ (parseWiki "" , (parseWiki "foo" ~?= - (Right [Inline (Text "foo")])) + (Right [ Paragraph [ Text "foo" ] + ])) - , (parseWiki "foo" + , (parseWiki "bar" ~?= - (Right [Inline (Text "foo")])) + (Right [ Paragraph [ Text "bar" ] + ])) , (parseWiki "foobar" ~?= - (Right [ Inline (Text "foo") - , Inline (Text "bar") + (Right [ Paragraph [ Text "foo" + , Text "bar" + ] ])) , (parseWiki "=h=" ~?= - (Right [Block (Heading 1 "h")])) + (Right [ Heading 1 "h" ])) , (parseWiki "=h= " ~?= - (Right [Block (Heading 1 "h")])) + (Right [ Heading 1 "h" ])) , (parseWiki " 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 + ] ])) ]