aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Muse.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers/Muse.hs')
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs24
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.