0dfe999 · typeable/pandoc

46import Prelude

47import Control.Monad.Reader

48import Control.Monad.State.Strict

49−import Data.Char (isSpace, isAlphaNum, isDigit, isAsciiUpper, isAsciiLower)

49+import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace)

50import Data.Default

51+import Data.List (intersperse, isInfixOf, transpose)

52+import qualified Data.Set as Set

51import Data.Text (Text)

53import Data.Text (Text)

52−import Data.List (intersperse, transpose, isInfixOf)

53import System.FilePath (takeExtension)

54import System.FilePath (takeExtension)

54import Text.Pandoc.Class (PandocMonad)

55import Text.Pandoc.Class (PandocMonad)

55import Text.Pandoc.Definition

56import Text.Pandoc.Definition

60import Text.Pandoc.Templates (renderTemplate')

61import Text.Pandoc.Templates (renderTemplate')

61import Text.Pandoc.Writers.Math

62import Text.Pandoc.Writers.Math

62import Text.Pandoc.Writers.Shared

63import Text.Pandoc.Writers.Shared

63−import qualified Data.Set as Set

64

65type Notes = [[Block]]

66

67type Muse m = ReaderT WriterEnv (StateT WriterState m)

68

69data WriterEnv =

70− WriterEnv { envOptions :: WriterOptions

70+ WriterEnv { envOptions :: WriterOptions

71− , envTopLevel :: Bool

71+ , envTopLevel :: Bool

72− , envInsideBlock :: Bool

72+ , envInsideBlock :: Bool

73− , envInlineStart :: Bool -- ^ True if there is only whitespace since last newline

73+ , envInlineStart :: Bool -- ^ True if there is only whitespace since last newline

74 , envInsideLinkDescription :: Bool -- ^ Escape ] if True

75− , envAfterSpace :: Bool -- ^ There is whitespace (not just newline) before

75+ , envAfterSpace :: Bool -- ^ There is whitespace (not just newline) before

76− , envOneLine :: Bool -- ^ True if newlines are not allowed

76+ , envOneLine :: Bool -- ^ True if newlines are not allowed

77− , envInsideAsterisks :: Bool -- ^ True if outer element is emphasis with asterisks

77+ , envInsideAsterisks :: Bool -- ^ True if outer element is emphasis with asterisks

78− , envNearAsterisks :: Bool -- ^ Rendering inline near asterisks

78+ , envNearAsterisks :: Bool -- ^ Rendering inline near asterisks

79 }

80

81data WriterState =

82− WriterState { stNotes :: Notes

82+ WriterState { stNotes :: Notes

83− , stIds :: Set.Set String

83+ , stIds :: Set.Set String

84− , stUseTags :: Bool -- ^ Use tags for emphasis, for example because previous character is a letter

84+ , stUseTags :: Bool -- ^ Use tags for emphasis, for example because previous character is a letter

85 }

86

87instance Default WriterState

158 style1' = normalizeStyle style1

159 style2' = normalizeStyle style2

160 normalizeStyle DefaultStyle = Decimal

161− normalizeStyle s = s

161+ normalizeStyle s = s

162flatBlockListToMuse bs@(DefinitionList _ : DefinitionList _ : _) = catWithBlankLines bs 2

163flatBlockListToMuse bs@(_ : _) = catWithBlankLines bs 0

164flatBlockListToMuse [] = return mempty

292noteToMuse num note =

293 hang (length marker) (text marker) <$>

294 local (\env -> env { envInsideBlock = True

295− , envInlineStart = True

295+ , envInlineStart = True

296− , envAfterSpace = True

296+ , envAfterSpace = True

297− }) (blockListToMuse note)

297+ }) (blockListToMuse note)

298 where

299 marker = "[" ++ show num ++ "] "

300

308-- | Replace newlines with spaces

309replaceNewlines :: String -> String

310replaceNewlines ('\n':xs) = ' ':replaceNewlines xs

311−replaceNewlines (x:xs) = x:replaceNewlines xs

311+replaceNewlines (x:xs) = x:replaceNewlines xs

312−replaceNewlines [] = []

312+replaceNewlines [] = []

313

314startsWithMarker :: (Char -> Bool) -> String -> Bool

315startsWithMarker f (' ':xs) = startsWithMarker f xs

316startsWithMarker f (x:xs) =

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

318 where

319− startsWithDot ['.'] = True

319+ startsWithDot ['.'] = True

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

321− startsWithDot _ = False

321+ startsWithDot _ = False

322startsWithMarker _ [] = False

323

324-- | Escape special characters for Muse if needed.

325containsFootnotes :: String -> Bool

326containsFootnotes = p

327 where p ('[':xs) = q xs || p xs

328− p (_:xs) = p xs

328+ p (_:xs) = p xs

329− p "" = False

329+ p "" = False

330 q (x:xs)

331 | x `elem` ("123456789"::String) = r xs || p xs

332 | otherwise = p xs

333 q [] = False

334 r ('0':xs) = r xs || p xs

335− r xs = s xs || q xs || p xs

335+ r xs = s xs || q xs || p xs

336 s (']':_) = True

337− s (_:xs) = p xs

337+ s (_:xs) = p xs

338− s [] = False

338+ s [] = False

339

340-- | Return True if string should be escaped with <verbatim> tags

341shouldEscapeString :: PandocMonad m

375

376replaceSmallCaps :: Inline -> Inline

377replaceSmallCaps (SmallCaps lst) = Emph lst

378−replaceSmallCaps x = x

378+replaceSmallCaps x = x

379

380removeKeyValues :: Inline -> Inline

381removeKeyValues (Code (i, cls, _) xs) = Code (i, cls, []) xs

382-- Do not remove attributes from Link

383-- Do not remove attributes, such as "width", from Image

384removeKeyValues (Span (i, cls, _) xs) = Span (i, cls, []) xs

385−removeKeyValues x = x

385+removeKeyValues x = x

386

387normalizeInlineList :: [Inline] -> [Inline]

388normalizeInlineList (Str "" : xs)

412normalizeInlineList [] = []

413

414fixNotes :: [Inline] -> [Inline]

415−fixNotes [] = []

415+fixNotes [] = []

416−fixNotes (Space : n@Note{} : rest) = Str " " : n : fixNotes rest

416+fixNotes (Space : n@Note{} : rest) = Str " " : n : fixNotes rest

417fixNotes (SoftBreak : n@Note{} : rest) = Str " " : n : fixNotes rest

418−fixNotes (x:xs) = x : fixNotes xs

418+fixNotes (x:xs) = x : fixNotes xs

419

420startsWithSpace :: [Inline] -> Bool

421−startsWithSpace (Space:_) = True

421+startsWithSpace (Space:_) = True

422startsWithSpace (SoftBreak:_) = True

423−startsWithSpace (Str s:_) = stringStartsWithSpace s

423+startsWithSpace (Str s:_) = stringStartsWithSpace s

424−startsWithSpace _ = False

424+startsWithSpace _ = False

425

426endsWithSpace :: [Inline] -> Bool

427−endsWithSpace [Space] = True

427+endsWithSpace [Space] = True

428endsWithSpace [SoftBreak] = True

429−endsWithSpace [Str s] = stringStartsWithSpace $ reverse s

429+endsWithSpace [Str s] = stringStartsWithSpace $ reverse s

430−endsWithSpace (_:xs) = endsWithSpace xs

430+endsWithSpace (_:xs) = endsWithSpace xs

431−endsWithSpace [] = False

431+endsWithSpace [] = False

432

433urlEscapeBrackets :: String -> String

434urlEscapeBrackets (']':xs) = '%':'5':'D':urlEscapeBrackets xs

435−urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs

435+urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs

436−urlEscapeBrackets [] = []

436+urlEscapeBrackets [] = []

437

438isHorizontalRule :: String -> Bool

439isHorizontalRule s = length s >= 4 && all (== '-') s

440

441stringStartsWithSpace :: String -> Bool

442stringStartsWithSpace (x:_) = isSpace x

443−stringStartsWithSpace "" = False

443+stringStartsWithSpace "" = False

444

445fixOrEscape :: Bool -> Inline -> Bool

446fixOrEscape sp (Str "-") = sp