Rakka.Wiki.Formatter
Rakka.Wiki.Parser
Data-Files:
- defaultPages/Main_Page
+ defaultPages/Help/Syntax
+ defaultPages/MainPage
+ defaultPages/StyleSheet/Default
schemas/rakka-page-1.0.rng
( WikiPage
, BlockElement(..)
, InlineElement(..)
+
+ , ListElement(..)
+ , ListType(..)
+ , ListItem
)
where
headingLevel :: !Int
, headingText :: !String
}
+ | HorizontalLine
+ | List !ListElement
+ | LeadingSpaced ![InlineElement]
| Paragraph ![InlineElement]
deriving (Eq, Show)
, linkText :: !(Maybe String)
}
deriving (Eq, Show)
+
+
+data ListElement
+ = ListElement {
+ listType :: !ListType
+ , listItems :: ![ListItem]
+ }
+ deriving (Eq, Show)
+
+
+data ListType
+ = Bullet
+ | Numbered
+ deriving (Eq, Show)
+
+
+type ListItem = [Either ListElement InlineElement]
-> case block of
Heading level text
-> formatHeading -< (level, text)
+
+ HorizontalLine
+ -> eelem "hr" -< ()
+
+ List list
+ -> formatListElement -< (baseURI, list)
+
+ LeadingSpaced inlines
+ -> formatLeadingSpaced -< (baseURI, inlines)
Paragraph inlines
-> formatParagraph -< (baseURI, inlines)
-> selem ("h" ++ show level) [txt text] -<< ()
+formatListElement :: (ArrowXml a, ArrowChoice a) => a (URI, ListElement) XmlTree
+formatListElement
+ = proc (baseURI, list)
+ -> let tag = case listType list of
+ Bullet -> "ul"
+ Numbered -> "ol"
+ in
+ ( eelem tag
+ += ( (constA baseURI &&& constL (listItems list))
+ >>>
+ formatListItem
+ )
+ ) -<< ()
+ where
+ formatListItem :: (ArrowXml a, ArrowChoice a) => a (URI, ListItem) XmlTree
+ formatListItem
+ = proc (baseURI, item)
+ -> eelem "li"
+ += ( (arr fst &&& arrL snd)
+ >>>
+ formatListItem'
+ ) -< (baseURI, item)
+
+ formatListItem' :: (ArrowXml a, ArrowChoice a) => a (URI, Either ListElement InlineElement) XmlTree
+ formatListItem'
+ = proc (baseURI, x)
+ -> case x of
+ Left nestedList -> formatListElement -< (baseURI, nestedList)
+ Right inline -> formatInline -< (baseURI, inline )
+
+
+formatLeadingSpaced :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
+formatLeadingSpaced
+ = eelem "pre"
+ += ( (arr fst &&& arrL snd)
+ >>>
+ formatInline
+ )
+
+
formatParagraph :: (ArrowXml a, ArrowChoice a) => a (URI, [InlineElement]) XmlTree
formatParagraph
= eelem "p"
)
where
+import Data.Maybe
import Rakka.Wiki
import Text.ParserCombinators.Parsec
)
>>
( heading
+ <|>
+ horizontalLine
+ <|>
+ listElement
+ <|>
+ leadingSpaced
<|>
paragraph
)
return (Heading n (x:xs))
+horizontalLine :: Parser BlockElement
+horizontalLine = try $ do count 4 (char '-')
+ many (char '-')
+ ws
+ eol
+ return HorizontalLine
+
+
+listElement :: Parser BlockElement
+listElement = listElement' [] >>= return . List
+ where
+ listElement' :: [Char] -> Parser ListElement
+ listElement' stack
+ = try $ do t <- oneOf "*#"
+ ws
+ xs <- items (stack ++ [t])
+ return (ListElement (toType t) xs)
+
+ -- ListItem の終了條件は、
+ items :: [Char] -> Parser [ListItem]
+ items stack = do xs <- many1 inlineElement
+ nested <- option Nothing
+ $ try $ do newline
+ string stack
+ listElement' stack >>= return . Just
+ rest <- items stack
+ return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
+ <|>
+ (try $ do newline
+ string stack
+ ws
+ items stack
+ )
+ <|>
+ return []
+{-
+ items stack = do nested <- listElement' stack
+ rest <- items stack
+ return (Left nested : rest)
+ <|>
+ do xs <- many1 inlineElement
+ rest <- items stack
+ return (Right xs : rest)
+ <|>
+ try ( newline
+ >>
+ string stack
+ >>
+ items stack
+ )
+ <|>
+ return []
+-}
+
+ toType :: Char -> ListType
+ toType '*' = Bullet
+ toType '#' = Numbered
+
+
+leadingSpaced :: Parser BlockElement
+leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
+ where
+ leadingSpaced' :: Parser [InlineElement]
+ leadingSpaced' = do x <- inlineElement
+ xs <- leadingSpaced'
+ return (x:xs)
+ <|>
+ try ( newline
+ >>
+ char ' '
+ >>
+ leadingSpaced'
+ >>=
+ return . (Text "\n" :)
+ )
+ <|>
+ return []
+
+
+blockTag :: Parser BlockElement
+blockTag = pzero -- not implemented
+
+
paragraph :: Parser BlockElement
paragraph = paragraph' >>= return . Paragraph
where
<|>
try ( do newline
((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
+ ((blockTag >> pzero) <|> return ())
ys <- (paragraph' <|> return [])
return (Text "\n" : ys)
- -- \n があり、その次に \n または
- -- blockSymbols があれば、fail して
- -- 最初の newline を讀んだ所まで卷き
- -- 戻す。
+ -- \n があり、その次に \n、ブロックタ
+ -- グまたは blockSymbols があれば、
+ -- fail して 最初の newline を讀んだ
+ -- æ\89\80ã\81¾ã\81§å\8d·ã\81\8dæ\88»ã\81\99ã\80\82
)
<|>
try paragraph'
blockSymbols :: [Char]
-blockSymbols = "="
+blockSymbols = " =-*#"
inlineSymbols :: [Char]
is a
preformatted
text.
- [[Foo|Wiki markup is interpretted in here.]]
+ [[Foo|Wiki markup is interpreted here.]]
== Horizontal Line ==
----
type="text/x-rakka"
isBoring="yes">
<textData>= Main Page =
-This is the main page.
+This is the main page.
Hello, world!
Another paragraph...
===== Heading 5 =====
+== Leading spaces ==
+ This
+ is a
+ preformatted
+ text.
+ [[Foo|Wiki markup is interpreted here.]]
+
+== Horizontal Line ==
+----
+
+== Listing ==
+* foo
+* bar
+** baz
+
+# foo
+## bar
+### baz
+
+* foo
+*# bar
+*#* baz
+*# bar
+
== Link ==
[[Page]]
[[page]]
* {
padding: 0;
margin: 0;
-
- list-style-type: none;
}
/* layout */
padding: 25px 30px;
}
+.body ul, .body ol {
+ list-style-position: inside;
+ margin: 1em 0;
+}
+.body ul ul, .body ul ol, .body ol ul, .body ol ol {
+ margin: 0;
+}
+
+.body li {
+ margin: 3px 5px;
+}
+.body li li {
+ margin-left: 20px;
+}
+
.side-bar .content {
padding: 20px;
}
}
.side-bar ul, .side-bar ol {
+ list-style-type: none;
margin-top: 0.4em;
}
, PageLink (Just "Bar") Nothing Nothing
]
]))
+
+ , (parseWiki " foo"
+ ~?=
+ (Right [ LeadingSpaced [ Text "foo" ] ]))
+
+ , (parseWiki " foo\n bar\n"
+ ~?=
+ (Right [ LeadingSpaced [ Text "foo"
+ , Text "\n"
+ , Text " bar"
+ ]
+ ]))
+
+ , (parseWiki "foo\n bar\nbaz"
+ ~?=
+ (Right [ Paragraph [ Text "foo" ]
+ , LeadingSpaced [ Text "bar" ]
+ , Paragraph [ Text "baz" ]
+ ]))
+
+ , (parseWiki "----"
+ ~?=
+ (Right [ HorizontalLine ]))
+
+ , (parseWiki "\nfoo\nbar\n----\n"
+ ~?=
+ (Right [ Paragraph [ Text "foo"
+ , Text "\n"
+ , Text "bar"
+ ]
+ , HorizontalLine
+ ]))
+
+ , (parseWiki "a----b"
+ ~?=
+ (Right [ Paragraph [ Text "a----b" ] ]))
+
+ , (parseWiki "* a"
+ ~?=
+ (Right [ List (ListElement Bullet [[Right (Text "a")]]) ]))
+
+ , (parseWiki "* a*"
+ ~?=
+ (Right [ List (ListElement Bullet [[Right (Text "a*")]]) ]))
+
+ , (parseWiki "* a\n* b\n"
+ ~?=
+ (Right [ List (ListElement Bullet [ [Right (Text "a")]
+ , [Right (Text "b")]
+ ])
+ ]))
+
+ , (parseWiki "*a\n*#b\n*#c\n"
+ ~?=
+ (Right [ List (ListElement Bullet [ [ Right (Text "a")
+ , Left (ListElement Numbered [ [Right (Text "b")]
+ , [Right (Text "c")]
+ ])
+ ]
+ ])
+ ]))
+
+ , (parseWiki "*a\n#b"
+ ~?=
+ (Right [ List (ListElement Bullet [ [Right (Text "a")] ])
+ , List (ListElement Numbered [ [Right (Text "b")] ])
+ ]))
]
projects / Rakka.git / commitdiff