+ pure ∘ Heading n $ T.pack (x:xs)
+
+horizontalLine :: Parser BlockElement
+horizontalLine = try ( do _ <- count 4 (char '-')
+ _ <- many (char '-')
+ ws
+ eol
+ return HorizontalLine
+ )
+ <?>
+ "horizontal line"
+
+
+listElement :: CommandTypeOf -> Parser BlockElement
+listElement cmdTypeOf = listElement' []
+ where
+ listElement' :: [Char] -> Parser BlockElement
+ listElement' stack
+ = do t <- oneOf "*#"
+ ws
+ xs <- items (stack ++ [t])
+ return (List (toType t) xs)
+
+ items :: [Char] -> Parser [ListItem]
+ items stack = do xs <- many1 $ inlineElement cmdTypeOf
+ nested <- option Nothing
+ $ try $ do skipMany comment
+ _ <- newline
+ _ <- string stack
+ liftM Just (listElement' stack)
+ rest <- items stack
+ return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest
+ <|>
+ (try $ do skipMany comment
+ _ <- newline
+ _ <- string stack
+ ws
+ items stack
+ )
+ <|>
+ return []
+
+ toType :: Char -> ListType
+ toType '*' = Bullet
+ toType '#' = Numbered
+ toType _ = undefined
+
+
+definitionList :: CommandTypeOf -> Parser BlockElement
+definitionList cmdTypeOf = liftM DefinitionList (many1 definition)
+ where
+ definition :: Parser Definition
+ definition = do _ <- char ';'
+ _ <- ws
+ tHead <- inlineElement cmdTypeOf
+ tRest <- term
+ d <- description
+ return (Definition (tHead:tRest) d)
+ <?>
+ "definition list"
+
+ term :: Parser [InlineElement]
+ term = (char ':' >> ws >> return [])
+ <|>
+ (newline >> char ':' >> ws >> return [])
+ <|>
+ do x <- inlineElement cmdTypeOf
+ xs <- term
+ return (x:xs)
+ <?>
+ "term to be defined"
+
+ description :: Parser [InlineElement]
+ description = do x <- inlineElement cmdTypeOf
+ xs <- description
+ return (x:xs)
+ <|>
+ try ( do _ <- newline
+ _ <- char ':'
+ _ <- ws
+ xs <- description
+ return (Text "\n" : xs)
+ )
+ <|>
+ (newline >> return [])
+ <|>
+ (eof >> return [])
+ <?>
+ "description of term"
+
+
+verbatim ∷ Parser BlockElement
+verbatim = try (string "<!verbatim[") *>
+ many (oneOf " \t\n") *>
+ (Preformatted ∘ (:[]) ∘ Text ∘ T.pack <$> verbatim')
+ where
+ verbatim' :: Parser String
+ verbatim' = try (many (oneOf " \t\n") *> string "]>") *> pure []
+ <|>
+ ((:) <$> anyChar ⊛ verbatim')
+
+
+leadingSpaced :: CommandTypeOf -> Parser BlockElement
+leadingSpaced cmdTypeOf = liftM Preformatted (char ' ' >> leadingSpaced')
+ <?>
+ "leading space"
+ where
+ leadingSpaced' :: Parser [InlineElement]
+ leadingSpaced' = do x <- inlineElement cmdTypeOf
+ xs <- leadingSpaced'
+ return (x:xs)
+ <|>
+ try ( liftM (Text "\n" :) ( newline
+ >>
+ char ' '
+ >>
+ leadingSpaced'
+ )
+ )
+ <|>
+ return []