diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Muse.hs')
-rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 6acc88b3d..3b64fe5ef 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -45,7 +45,7 @@ import Control.Monad.Reader import Control.Monad.Except (throwError) import Data.Bifunctor import Data.Default -import Data.List (intercalate) +import Data.List (intercalate, transpose) import Data.List.Split (splitOn) import qualified Data.Map as M import qualified Data.Set as Set @@ -135,9 +135,6 @@ parseMuse = do -- * Utility functions -commonPrefix :: String -> String -> String -commonPrefix xs ys = map fst $ takeWhile (uncurry (==)) $ zip xs ys - -- | Trim up to one newline from the beginning of the string. lchop :: String -> String lchop ('\n':xs) = xs @@ -147,11 +144,14 @@ lchop s = s rchop :: String -> String rchop = reverse . lchop . reverse +unindent :: String -> String +unindent = rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop + dropSpacePrefix :: [String] -> [String] -dropSpacePrefix lns = - map (drop maxIndent) lns - where flns = filter (not . all (== ' ')) lns - maxIndent = if null flns then maximum (map length lns) else length $ takeWhile (== ' ') $ foldl1 commonPrefix flns +dropSpacePrefix lns = drop maxIndent <$> lns + where isSpaceChar c = c == ' ' || c == '\t' + maxIndent = length $ takeWhile (isSpaceChar . head) $ takeWhile same $ transpose lns + same = and . (zipWith (==) <*> drop 1) atStart :: PandocMonad m => MuseParser m () atStart = do @@ -380,15 +380,15 @@ amuseHeadingUntil end = try $ do example :: PandocMonad m => MuseParser m (F Blocks) example = try $ pure . B.codeBlock <$ string "{{{" - <* optional blankline - <*> manyTill anyChar (try (optional blankline *> string "}}}")) + <* many spaceChar + <*> (unindent <$> manyTill anyChar (string "}}}")) -- | Parse an @\<example>@ tag. exampleTag :: PandocMonad m => MuseParser m (F Blocks) exampleTag = try $ fmap pure $ B.codeBlockWith <$ many spaceChar <*> (htmlAttrToPandoc <$> openTag "example") - <*> (rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop <$> manyTill anyChar (closeTag "example")) + <*> (unindent <$> manyTill anyChar (closeTag "example")) <* manyTill spaceChar eol -- | Parse a @\<literal>@ tag as a raw block. @@ -398,7 +398,7 @@ literalTag = try $ fmap pure $ B.rawBlock <$ many spaceChar <*> (fromMaybe "html" . lookup "style" <$> openTag "literal") -- FIXME: Emacs Muse inserts <literal> without style into all output formats, but we assume HTML <* manyTill spaceChar eol - <*> (rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop <$> manyTill anyChar (closeTag "literal")) + <*> (unindent <$> manyTill anyChar (closeTag "literal")) <* manyTill spaceChar eol -- | Parse @\<center>@ tag. |