Преобразование простой разметки в HTML


Это будет достаточно длительный и универсальный, так что извиняюсь заранее.

Я читал много о Haskell, но я никогда не запрограммирован с ним ничего за рамки простых экспериментов в ГГц. Поэтому, я хотел, наконец, попробовать и сделать некоторые упражнения кодирования, который был простой, но нетривиальный и в итоге выбрали проблему "затворник" из книги под названием красноречивым на языке JavaScript.

Цель состоит в том, чтобы сделать программу, которая принимает текстовый документ с простой пользовательской разметки и форматы в HTML в соответствии со следующими правилами:

  1. Абзацы разделяются пустыми строками.
  2. Абзац, который начинается с '%' символ-заголовка. Чем больше '%' символов, тем меньше заголовок.
  3. Внутри абзацы, фрагменты текста можно подчеркнуть, поставив их между звездочками.
  4. Сноски записываются в фигурных скобках.

Так, например, в текстовый документ

% Заголовок

%% Рубрике

Текст с *упором*.

Другой {пример сноски} пункт.

будут отформатированы как

<h1>Heading</h1>
<h2>Sub-heading</h2>
<p>Text with <i>emphasis</i>.</p>
<p>Another<a href="#footnote1"><sup>1</sup></a> paragraph.</p>
<p><small><a name="footnote1">1. an example footnote</a></small></p>

Основная программа должна читать текстовый документ из stdin и вывод в HTML в стандартный вывод.

Это казалось достаточно простой задачей на первых порах (я предполагаю, что с помощью Python, язык у меня много опыта, я мог бы закончил его примерно за 15-30 минут), но когда я забрался глубже в реализации, я понял, что я понятия не имею, как сделать что-то подобное на Haskell. Сноски казалась особенно сложной задачей, как вы должны накапливать их на стороне, а дом со всем документом в целом, и я не знал, как выразить, что в функциональном плане (по крайней мере, не без перетаскивания дополнительных сносок аргументом в каждый вызов функции).

Я взломал эту проблему в течение нескольких вечеров, перечитывая Хаскелл учебники и просматривая стандартные библиотеки, и в итоге решение, которое работает правильно, с некоторыми допущениями (например, вложенная разметка не поддерживается). Однако, мое решение кажется чрезмерно сложным для такой простой задачи и потребляет сравнительно большое количество памяти.

Итак, мой вопрос: как я могу упростить программу и превратить его в более идиоматические Хаскелл? В formatText функция особенно то, что получилось очень некрасиво, на мой взгляд. Я никого не жду, чтобы переписать всю программу, но мелкие исправления здесь и там будет принята с благодарностью.

Во-вторых, как бы я сделать программу более эффективной памяти? Текущая реализация выделяет около 400 КБ кучи для каждого 1Кб ввода текста, который не проблема для этой программы, но я думаю, что это указывает на то, что я делаю что-то глупое. Я читал статьи о снижении потребление памяти, заставляя строгость, но это не очевидно для меня, где строгость должны быть применены в моей программе для лучшего эффекта.

Спасибо!

import Char
import Data.List
import Control.Monad.State

data Footnote   = Footnote  Int String
data Footnotes  = Footnotes Int [Footnote]
type TrackNotes = State Footnotes
type HTML       = String

-- |Enclose content in the given HTML element
--  e.g. html "span" "foo" -> "<span>foo</span>"
html :: String -> String -> HTML
html tag content = foldl1' (++) ["<", tag, ">", content, "</", tag, ">"]

-- |Generate a HTML link element
ahref :: String -> String -> HTML
ahref link txt = foldl1' (++) ["<a href=\"", link, "\">", txt, "</a>"]

-- |Replace <, > and & with HTML entities
htmlEscape :: String -> HTML
htmlEscape ""     = ""
htmlEscape (x:xs) = prefix $! htmlEscape xs
    where prefix = case x of
            '&' -> showString "&amp;"
            '<' -> showString "&lt;"
            '>' -> showString "&gt;"
            _   -> (x:)

-- |Add a new footnote
addFootnote :: String -> TrackNotes Int
addFootnote s = State $ \(Footnotes i ns) ->(i, Footnotes (i+1) $ ns ++ [Footnote i s])

-- |Format a text section into HTML
formatSection :: String -> TrackNotes HTML
formatSection s = case s of
    ('%'):xs -> formatHeading s
    _        -> formatParagraph s

-- |Format a text heading into HTML heading
formatHeading :: String -> TrackNotes HTML
formatHeading s = liftM headingTag content
    where headingTag = html ("h" ++ show level)
          level      = length prefix
          content    = formatText $ htmlEscape $ dropWhile isSpace postfix
          (prefix,postfix) = span (=='%') s

-- |Format a text paragraph into HTML paragraph
formatParagraph :: String -> TrackNotes HTML
formatParagraph = liftM (html "p") . formatText . htmlEscape

-- |Format inline markup in text contents, e.g. "*foo* bar" -> "<i>foo</i> bar"
formatText :: String -> TrackNotes HTML
formatText "" = return ""
formatText s  = do
    (content,rest) <- processTag $ postfix
    rest' <- formatText $ rest
    return $ prefix ++ (content ++ rest')

    where (prefix,postfix) = break (`elem` "*{") s

          processTag         "" = return ("", "")
          processTag (tag:rest) = do
            html' <- format $ between
            return (html', tail')
            where (format, endChar) = case tag of
                    '*' -> (formatEmph, '*')
                    '{' -> (formatNote, '}')
                  (between, _:tail') = break (==endChar) rest

          formatEmph = return . html "i"
          formatNote s = do
            idx <- liftM show $ addFootnote s
            let link = "#footnote" ++ idx
            let text = html "sup" idx
            return $ ahref link text

-- |Split a string into sections.
--  Two consecutive line breaks form a section break.
splitSections :: String -> [String]
splitSections = sections . lines
    where sections (x:[]:xs) = x : sections xs
          sections  (x:y:xs) = sections $ (x ++ ('\n' : y)) : xs
          sections         x = x

-- | Format a footnote at the end of the document
formatFootnote :: Footnote -> HTML
formatFootnote (Footnote i s) = html "p" $ html "small" $ anchor
    where anchor = "<a name=\"footnote" ++ show i ++ "\">" ++ text ++ "</a>"
          text   = show i ++ ". " ++ s

-- |Format a text document into HTML document
formatDocument :: String -> String
formatDocument txt   = unlines $ sections ++ footnotes
    where (sections, state) = runState stateMonad (Footnotes 1 [])
          stateMonad        = mapM formatSection $ splitSections txt
          Footnotes _ notes = state
          footnotes         = map formatFootnote notes

main = interact formatDocument

Обновление: я переписал программу так, что парсинг и вывод отдельно по предложению sepp2k, и хотя это делает программу немного дольше, он держит отдельные функции намного проще.

import Char
import Data.List
import Data.Maybe
import Control.Monad.State

type HTML = String
type HeadingLevel = Int

{----------------------------------------------------------------
 Data types and functions for parsing the markup to a parse tree
-----------------------------------------------------------------}
data Section = Heading HeadingLevel [DocNode] | Paragraph [DocNode]
data DocNode = PlainText String | Emphasis [DocNode] | Footnote [DocNode]

parseMarkup :: String -> [Section]
parseMarkup = mapMaybe parseSection . splitSections

parseSection :: String -> Maybe Section
parseSection "" = Nothing
parseSection s  = case s of
    ('%':_) -> Just $ parseHeading s
    _       -> Just $ Paragraph $ parseNodes s

parseHeading :: String -> Section
parseHeading s = Heading lvl nodes
    where lvl   = length prefix
          nodes = parseNodes $ dropWhile isSpace postfix
          (prefix,postfix) = span (=='%') s

parseNodes :: String -> [DocNode]
parseNodes "" = []
parseNodes s  = fst $ parseNodes' Nothing $ zipper s
    where parseNodes' g ((i,(c:t)):_) | (g == Just c) = ([PlainText i], t)
          parseNodes' _  [(i,"")]  = ([PlainText i], "")
          parseNodes' g ((i,t):xs) = case t of
            ('*':_) -> continue Emphasis '*' i t
            ('{':_) -> continue Footnote '}' i t
            _       -> parseNodes' g xs

          continue f end "" t = parseNonText f end $ tail t
          continue f end i t  = (PlainText i : moreNodes, rest)
            where (moreNodes, rest) = parseNonText f end $ tail t

          parseNonText f end t = ((f nodes) : moreNodes, rest')
            where (nodes, rest)      = parseNodes' (Just end) $ zipper t
                  (moreNodes, rest') = parseNodes' Nothing $ zipper rest


{------------------------------------------------
 Data types and functions for tracking footnotes
-------------------------------------------------}
data Footnotes  = Footnotes Int [String]
type TrackNotes = State Footnotes

addFootnote :: String -> TrackNotes Int
addFootnote s = State $ \(Footnotes i ns) ->(i, Footnotes (i+1) $ ns ++ [s])

{---------------------------------------
 Functions for converting nodes to HTML
----------------------------------------}
docToHTML :: [Section] -> HTML
docToHTML ss = unlines $ sections ++ footnotes
    where (sections, state)   = runState stateMonad $ Footnotes 1 []
          stateMonad          = mapM sectionToHTML ss
          (Footnotes _ notes) = state
          footnotes           = map formatFootnote $ zip notes [1..]

sectionToHTML :: Section -> TrackNotes HTML
sectionToHTML (Heading lvl nodes) = liftM htag $ nodesToHTML nodes
    where htag = html $ "h" ++ show lvl
sectionToHTML (Paragraph nodes) = liftM ptag $ nodesToHTML nodes
    where ptag = html "p"

nodesToHTML :: [DocNode] -> TrackNotes HTML
nodesToHTML = liftM (foldl' (++) "") . mapM nodeToHTML

-- | Convert a single DocNode to HTML
nodeToHTML :: DocNode -> TrackNotes HTML
nodeToHTML (PlainText s)    = return s
nodeToHTML (Emphasis nodes) = liftM (html "i") $ nodesToHTML nodes
nodeToHTML (Footnote nodes) = do
    content <- nodesToHTML nodes 
    idx  <- liftM show $ addFootnote content
    let link = "#footnote" ++ idx
    let text = html "sup" idx
    return $ ahref link text

-- | Format a footnote at the end of the document
formatFootnote :: (String, Int) -> HTML
formatFootnote (s,i) = html "p" $ html "small" $ anchor
    where anchor = "<a name=\"footnote" ++ show i ++ "\">" ++ text ++ "</a>"
          text   = show i ++ ". " ++ s

-- |Enclose content in the given HTML element
--  e.g. html "span" "foo" -> "<span>foo</span>"
html :: String -> String -> HTML
html tag content = foldl1' (++) ["<", tag, ">", content, "</", tag, ">"]

-- |Generate a HTML link element
ahref :: String -> String -> HTML
ahref link txt = foldl1' (++) ["<a href=\"", link, "\">", txt, "</a>"]

-- |Replace <, > and & with HTML entities
htmlEscape :: String -> HTML
htmlEscape ""     = ""
htmlEscape (x:xs) = prefix $! htmlEscape xs
    where prefix = case x of
            '&' -> showString "&amp;"
            '<' -> showString "&lt;"
            '>' -> showString "&gt;"
            _   -> (x:)

{------------------------------
 Miscellanous string utilities
-------------------------------}

-- |Split a string into sections.
--  Two consecutive line breaks form a section break.
splitSections :: String -> [String]
splitSections = sections . lines
    where sections (x:[]:xs) = x : sections xs
          sections  (x:y:xs) = sections $ (x ++ ('\n' : y)) : xs
          sections         x = x

-- | A "zipper" for navigating a string
--   Generates a list of (init,tail) pairs that traverse the list
--   E.g. zipper "foo" -> [("","foo"), ("f","oo"), ("fo","o"), ("foo","")]
zipper :: String -> [(String,String)]
zipper s = zip (inits s) (tails s)

{-----
 Main
------}
formatDoc :: String -> HTML
formatDoc = docToHTML . parseMarkup

main = interact formatDoc


647
14
задан 6 марта 2011 в 12:03 Источник Поделиться
Комментарии
1 ответ

Одним из преимуществ Хаскелла, что есть хорошее количество качественных библиотек парсер для него. Используя для этого случая может быть немного перебор, но так как это в любом случае упражнения это может быть хороший шанс, чтобы забрать библиотеку парсера (например, парсек) как хорошо. Это, безусловно, может пригодиться в дальнейшем. Кроме того, используя такую библиотеку, вы могли бы поддержать вложенной разметки без каких-либо проблем.


О памяти: Хаскелл строк, будучи (ленивый) связанные списки персонажей, просто не очень эффективной памяти. По этой причине его часто рекомендуют использовать bytestrings или данных.Текст в пользу простых строк, Если вам нужно памяти, эффективной обработки строк.



Сноски казалась особенно сложной задачей, как вы должны накапливать их на стороне, а дом со всем документом в целом, и я не знал, как выразить, что в функциональном плане (по крайней мере, не без перетаскивания дополнительных сносок аргументом в каждый вызов функции).

Как вы уже выяснили, одним из решений для отслеживания состояния через программу без добавления дополнительных аргументов в состояние монады. Однако в этом случае, я считаю, что это сделало программу более сложной, чем это необходимо.

Я думаю, что дополнительным аргументом сноски (и второй, чтобы их сосчитать) были самым простым решением здесь.


Как общий дизайн, обратите внимание, я думаю, что два-шаг подход позволит сделать код более управляемый и расширяемый: сначала разобрать строку во внутреннее представление (я бы назвал это дерево, за исключением того, что пока вы не поддерживает вложенные разметки, это не дерево), а затем написать функцию, которая превращает это представление в HTML.

Таким образом, вы отдельный код, который делает разбор кода, который производит HTML-код, который является хорошим стилем. Она также позволяет добавлять позже другой формат без необходимости дублировать код парсинга. Следует также легче поддерживать вложенные разметку, используя такой подход и это также делает его проще для замены ручного парсинга кода с библиотекой разбора, если вы решите это сделать.

7
ответ дан 6 марта 2011 в 03:03 Источник Поделиться