6d35090 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Cleanup Muse reader and writer

6d35090Alexander Krotov9 years ago

src/Text/Pandoc/Readers/Muse.hs+19−37

compare with master

unifiedsplit

@@ -1,5 +1,6 @@

1{-# LANGUAGE NoImplicitPrelude #-}

2−{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE TupleSections #-}

3{-

4{-

@@ -174,7 +175,7 @@ parseHtmlContent tag = try $ do

174 pos <- getPosition

175 pos <- getPosition

175 (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])

176 (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])

176 manyTill spaceChar eol

177 manyTill spaceChar eol

177− content <- parseBlocksTill (try $ ((count (sourceColumn pos - 1) spaceChar) >> endtag))

178+ content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> endtag

178 manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline

179 manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline

179 return (htmlAttrToPandoc attr, content)

180 return (htmlAttrToPandoc attr, content)

180 where

181 where

@@ -274,9 +275,7 @@ parseBlocksTill end =

274 paraStart)

275 paraStart)

275 where

276 where

276 parseEnd = mempty <$ end

277 parseEnd = mempty <$ end

277− blockStart = do first <- blockElements

278+ blockStart = (B.<>) <$> blockElements <*> continuation

278− rest <- continuation

279− return $ first B.<> rest

280 listStart = do

279 listStart = do

281 updateState (\st -> st { museInPara = False })

280 updateState (\st -> st { museInPara = False })

282 (first, e) <- anyListUntil ((Left <$> end) <|> (Right <$> continuation))

281 (first, e) <- anyListUntil ((Left <$> end) <|> (Right <$> continuation))

@@ -299,10 +298,8 @@ listItemContentsUntil col pre end =

299 try listStart <|>

298 try listStart <|>

300 try paraStart

299 try paraStart

301 where

300 where

302− parsePre = do e <- pre

301+ parsePre = (mempty,) <$> pre

303− return (mempty, e)

304− parseEnd = do e <- end

302+ parseEnd = (mempty,) <$> end

305− return (mempty, e)

306 paraStart = do

303 paraStart = do

307 (first, e) <- paraUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end))

304 (first, e) <- paraUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end))

308 case e of

305 case e of

@@ -468,9 +465,7 @@ paraUntil end = do

468noteMarker :: PandocMonad m => MuseParser m String

465noteMarker :: PandocMonad m => MuseParser m String

469noteMarker = try $ do

466noteMarker = try $ do

470 char '['

467 char '['

471− first <- oneOf "123456789"

472− rest <- manyTill digit (char ']')

468+ (:) <$> oneOf "123456789" <*> manyTill digit (char ']')

473− return $ first:rest

474

469

475-- Amusewiki version of note

470-- Amusewiki version of note

476-- Parsing is similar to list item, except that note marker is used instead of list marker

471-- Parsing is similar to list item, except that note marker is used instead of list marker

@@ -713,11 +708,7 @@ elementsToTable = foldM museAppendElement emptyTable

713 where emptyTable = MuseTable mempty mempty mempty mempty

708 where emptyTable = MuseTable mempty mempty mempty mempty

714

709

715table :: PandocMonad m => MuseParser m (F Blocks)

710table :: PandocMonad m => MuseParser m (F Blocks)

716−table = try $ do

711+table = try $ fmap museToPandocTable <$> (elementsToTable <$> tableElements)

717− rows <- tableElements

718− let tbl = elementsToTable rows

719− let pandocTbl = museToPandocTable <$> tbl :: F Blocks

720− return pandocTbl

721

712

722tableParseElement :: PandocMonad m => MuseParser m MuseTableElement

713tableParseElement :: PandocMonad m => MuseParser m MuseTableElement

723tableParseElement = tableParseHeader

714tableParseElement = tableParseHeader

@@ -831,16 +822,14 @@ enclosedInlines start end = try $

831 trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter))

822 trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter))

832

823

833inlineTag :: PandocMonad m

824inlineTag :: PandocMonad m

834− => (Inlines -> Inlines)

835− -> String

825+ => String

836 -> MuseParser m (F Inlines)

826 -> MuseParser m (F Inlines)

837−inlineTag f tag = try $ do

827+inlineTag tag = try $ do

838 htmlTag (~== TagOpen tag [])

828 htmlTag (~== TagOpen tag [])

839− res <- manyTill inline (void $ htmlTag (~== TagClose tag))

829+ mconcat <$> manyTill inline (void $ htmlTag (~== TagClose tag))

840− return $ f <$> mconcat res

841

830

842strongTag :: PandocMonad m => MuseParser m (F Inlines)

831strongTag :: PandocMonad m => MuseParser m (F Inlines)

843−strongTag = inlineTag B.strong "strong"

832+strongTag = fmap B.strong <$> inlineTag "strong"

844

833

845strong :: PandocMonad m => MuseParser m (F Inlines)

834strong :: PandocMonad m => MuseParser m (F Inlines)

846strong = fmap B.strong <$> emphasisBetween (string "**")

835strong = fmap B.strong <$> emphasisBetween (string "**")

@@ -854,16 +843,16 @@ underlined = do

854 fmap underlineSpan <$> emphasisBetween (char '_')

843 fmap underlineSpan <$> emphasisBetween (char '_')

855

844

856emphTag :: PandocMonad m => MuseParser m (F Inlines)

845emphTag :: PandocMonad m => MuseParser m (F Inlines)

857−emphTag = inlineTag B.emph "em"

846+emphTag = fmap B.emph <$> inlineTag "em"

858

847

859superscriptTag :: PandocMonad m => MuseParser m (F Inlines)

848superscriptTag :: PandocMonad m => MuseParser m (F Inlines)

860−superscriptTag = inlineTag B.superscript "sup"

849+superscriptTag = fmap B.superscript <$> inlineTag "sup"

861

850

862subscriptTag :: PandocMonad m => MuseParser m (F Inlines)

851subscriptTag :: PandocMonad m => MuseParser m (F Inlines)

863−subscriptTag = inlineTag B.subscript "sub"

852+subscriptTag = fmap B.subscript <$> inlineTag "sub"

864

853

865strikeoutTag :: PandocMonad m => MuseParser m (F Inlines)

854strikeoutTag :: PandocMonad m => MuseParser m (F Inlines)

866−strikeoutTag = inlineTag B.strikeout "del"

855+strikeoutTag = fmap B.strikeout <$> inlineTag "del"

867

856

868verbatimTag :: PandocMonad m => MuseParser m (F Inlines)

857verbatimTag :: PandocMonad m => MuseParser m (F Inlines)

869verbatimTag = return . B.text . snd <$> htmlElement "verbatim"

858verbatimTag = return . B.text . snd <$> htmlElement "verbatim"

@@ -891,9 +880,7 @@ code = try $ do

891 return $ return $ B.code contents

880 return $ return $ B.code contents

892

881

893codeTag :: PandocMonad m => MuseParser m (F Inlines)

882codeTag :: PandocMonad m => MuseParser m (F Inlines)

894−codeTag = do

883+codeTag = return . uncurry B.codeWith <$> htmlElement "code"

895− (attrs, content) <- htmlElement "code"

896− return $ return $ B.codeWith attrs content

897

884

898inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)

885inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines)

899inlineLiteralTag =

886inlineLiteralTag =

@@ -904,10 +891,7 @@ inlineLiteralTag =

904 rawInline (attrs, content) = B.rawInline (format attrs) content

891 rawInline (attrs, content) = B.rawInline (format attrs) content

905

892

906str :: PandocMonad m => MuseParser m (F Inlines)

893str :: PandocMonad m => MuseParser m (F Inlines)

907−str = do

908− result <- many1 alphaNum

909− updateLastStrPos

894+str = return . B.str <$> many1 alphaNum <* updateLastStrPos

910− return $ return $ B.str result

911

895

912symbol :: PandocMonad m => MuseParser m (F Inlines)

896symbol :: PandocMonad m => MuseParser m (F Inlines)

913symbol = return . B.str <$> count 1 nonspaceChar

897symbol = return . B.str <$> count 1 nonspaceChar

@@ -929,9 +913,7 @@ link = try $ do

929 isImageUrl = (`elem` imageExtensions) . takeExtension

913 isImageUrl = (`elem` imageExtensions) . takeExtension

930

914

931linkContent :: PandocMonad m => MuseParser m (F Inlines)

915linkContent :: PandocMonad m => MuseParser m (F Inlines)

932−linkContent = do

933− char '['

934− trimInlinesF . mconcat <$> manyTill inline (string "]")

916+linkContent = char '[' >> trimInlinesF . mconcat <$> manyTill inline (string "]")

935

917

936linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines))

918linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines))

937linkText = do

919linkText = do

src/Text/Pandoc/Writers/Muse.hs+5−5

@@ -286,7 +286,7 @@ startsWithMarker f (' ':xs) = startsWithMarker f xs

286startsWithMarker f (x:xs) =

287 f x && (startsWithMarker f xs || startsWithDot xs)

288 where

289− startsWithDot ('.':[]) = True

289+ startsWithDot ['.'] = True

290 startsWithDot ('.':c:_) = isSpace c

291 startsWithDot _ = False

292startsWithMarker _ [] = False

@@ -369,8 +369,8 @@ fixOrEscape (Str ";") = True

369fixOrEscape (Str s) = startsWithMarker isDigit s ||

370 startsWithMarker isAsciiLower s ||

371 startsWithMarker isAsciiUpper s

372−fixOrEscape (Space) = True

372+fixOrEscape Space = True

373−fixOrEscape (SoftBreak) = True

373+fixOrEscape SoftBreak = True

374fixOrEscape _ = False

375

376-- | Convert list of Pandoc inline elements to Muse

@@ -382,9 +382,9 @@ renderInlineList True [] = pure "<verbatim></verbatim>"

382renderInlineList False [] = pure ""

383renderInlineList start (x:xs) = do r <- inlineToMuse x

384 opts <- gets stOptions

385− lst' <- renderInlineList (x == SoftBreak && writerWrapText opts == WrapPreserve) xs --hcat <$> mapM inlineToMuse xs

385+ lst' <- renderInlineList (x == SoftBreak && writerWrapText opts == WrapPreserve) xs

386 if start && fixOrEscape x

387− then pure ((text "<verbatim></verbatim>") <> r <> lst')

387+ then pure (text "<verbatim></verbatim>" <> r <> lst')

388 else pure (r <> lst')

389

390-- | Normalize and convert list of Pandoc inline elements to Muse.