{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.Muse
   Copyright   : Copyright (C) 2017-2020 Alexander Krotov
   License     : GNU GPL, version 2 or above

   Maintainer  : Alexander Krotov <ilabdsf@gmail.com>
   Stability   : stable
   Portability : portable

Conversion of 'Pandoc' documents to Muse.

This module is mostly intended for <https://amusewiki.org/ Amusewiki> markup support,
as described by <https://amusewiki.org/library/manual Text::Amuse markup manual>.
Original <https://www.gnu.org/software/emacs-muse/ Emacs Muse> markup support
is a secondary goal.

Where Text::Amuse markup
<https://metacpan.org/pod/Text::Amuse#DIFFERENCES-WITH-THE-ORIGINAL-EMACS-MUSE-MARKUP differs>
from <https://www.gnu.org/software/emacs-muse/manual/ Emacs Muse markup>,
Text::Amuse markup is supported.
For example, native tables are always used instead of Org Mode tables.
However, @\<literal style="html">@ tag is used for HTML raw blocks
even though it is supported only in Emacs Muse.
-}
module Text.Pandoc.Writers.Muse (writeMuse) where
import Control.Monad (zipWithM)
import Control.Monad.Except (throwError)
import Control.Monad.Reader
    ( asks, MonadReader(local), ReaderT(runReaderT) )
import Control.Monad.State.Strict
    ( StateT, gets, modify, evalStateT )
import Data.Char (isAlphaNum, isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.Default
import Data.List (intersperse, transpose)
import Data.List.NonEmpty (nonEmpty, NonEmpty(..))
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import System.FilePath (takeExtension)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared

type Notes = [[Block]]

type Muse m = ReaderT WriterEnv (StateT WriterState m)

data WriterEnv =
  WriterEnv { WriterEnv -> WriterOptions
envOptions               :: WriterOptions
            , WriterEnv -> Bool
envTopLevel              :: Bool
            , WriterEnv -> Bool
envInsideBlock           :: Bool
            , WriterEnv -> Bool
envInlineStart           :: Bool -- ^ True if there is only whitespace since last newline
            , WriterEnv -> Bool
envInsideLinkDescription :: Bool -- ^ Escape ] if True
            , WriterEnv -> Bool
envAfterSpace            :: Bool -- ^ There is whitespace (not just newline) before
            , WriterEnv -> Bool
envOneLine               :: Bool -- ^ True if newlines are not allowed
            , WriterEnv -> Bool
envInsideAsterisks       :: Bool -- ^ True if outer element is emphasis with asterisks
            , WriterEnv -> Bool
envNearAsterisks         :: Bool -- ^ Rendering inline near asterisks
            }

data WriterState =
  WriterState { WriterState -> Notes
stNotes   :: Notes
              , WriterState -> Int
stNoteNum :: Int
              , WriterState -> Set Text
stIds     :: Set.Set Text
              , WriterState -> Bool
stUseTags :: Bool -- ^ Use tags for emphasis, for example because previous character is a letter
              }

instance Default WriterState
  where def :: WriterState
def = WriterState { stNotes :: Notes
stNotes = []
                          , stNoteNum :: Int
stNoteNum = Int
1
                          , stIds :: Set Text
stIds = Set Text
forall a. Set a
Set.empty
                          , stUseTags :: Bool
stUseTags = Bool
False
                          }

evalMuse :: PandocMonad m => Muse m a -> WriterEnv -> WriterState -> m a
evalMuse :: forall (m :: * -> *) a.
PandocMonad m =>
Muse m a -> WriterEnv -> WriterState -> m a
evalMuse Muse m a
document WriterEnv
env = StateT WriterState m a -> WriterState -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT WriterState m a -> WriterState -> m a)
-> StateT WriterState m a -> WriterState -> m a
forall a b. (a -> b) -> a -> b
$ Muse m a -> WriterEnv -> StateT WriterState m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Muse m a
document WriterEnv
env

-- | Convert Pandoc to Muse.
writeMuse :: PandocMonad m
          => WriterOptions
          -> Pandoc
          -> m Text
writeMuse :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMuse WriterOptions
opts Pandoc
document =
  Muse m Text -> WriterEnv -> WriterState -> m Text
forall (m :: * -> *) a.
PandocMonad m =>
Muse m a -> WriterEnv -> WriterState -> m a
evalMuse (Pandoc -> Muse m Text
forall (m :: * -> *). PandocMonad m => Pandoc -> Muse m Text
pandocToMuse Pandoc
document) WriterEnv
env WriterState
forall a. Default a => a
def
  where env :: WriterEnv
env = WriterEnv { envOptions :: WriterOptions
envOptions = WriterOptions
opts
                        , envTopLevel :: Bool
envTopLevel = Bool
True
                        , envInsideBlock :: Bool
envInsideBlock = Bool
False
                        , envInlineStart :: Bool
envInlineStart = Bool
True
                        , envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
False
                        , envAfterSpace :: Bool
envAfterSpace = Bool
False
                        , envOneLine :: Bool
envOneLine = Bool
False
                        , envInsideAsterisks :: Bool
envInsideAsterisks = Bool
False
                        , envNearAsterisks :: Bool
envNearAsterisks = Bool
False
                        }

-- | Return Muse representation of document.
pandocToMuse :: PandocMonad m
             => Pandoc
             -> Muse m Text
pandocToMuse :: forall (m :: * -> *). PandocMonad m => Pandoc -> Muse m Text
pandocToMuse (Pandoc Meta
meta [Block]
blocks) = do
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  Context Text
metadata <- WriterOptions
-> ([Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline]
    -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> Meta
-> ReaderT WriterEnv (StateT WriterState m) (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
               [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse
               ((Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b.
(a -> b)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (ReaderT WriterEnv (StateT WriterState m) (Doc Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Inline]
    -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> [Inline]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse)
               Meta
meta
  Doc Text
body <- [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
blocks
  Doc Text
notes <- ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
  let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main Context Text
metadata
  Text -> Muse m Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Muse m Text) -> Text -> Muse m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Helper function for flatBlockListToMuse
-- | Render all blocks and insert blank lines between the first two
catWithBlankLines :: PandocMonad m
                  => [Block]       -- ^ List of block elements
                  -> Int           -- ^ Number of blank lines
                  -> Muse m (Doc Text)
catWithBlankLines :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines (Block
b : [Block]
bs) Int
n = do
  Doc Text
b' <- Block -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuseWithNotes Block
b
  Doc Text
bs' <- [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
bs
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
b' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text
forall a. Int -> Doc a
blanklines Int
n Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
bs'
catWithBlankLines [Block]
_ Int
_ = [Char] -> Muse m (Doc Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"Expected at least one block"

-- | Convert list of Pandoc block elements to Muse
-- | without setting envTopLevel.
flatBlockListToMuse :: PandocMonad m
                => [Block]       -- ^ List of block elements
                -> Muse m (Doc Text)
flatBlockListToMuse :: forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse bs :: [Block]
bs@(BulletList Notes
_ : BulletList Notes
_ : [Block]
_) = [Block] -> Int -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs Int
2
flatBlockListToMuse bs :: [Block]
bs@(OrderedList (Int
_, ListNumberStyle
style1, ListNumberDelim
_) Notes
_ : OrderedList (Int
_, ListNumberStyle
style2, ListNumberDelim
_) Notes
_ : [Block]
_) =
  [Block] -> Int -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs (if ListNumberStyle
style1' ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
style2' then Int
2 else Int
0)
    where
      style1' :: ListNumberStyle
style1' = ListNumberStyle -> ListNumberStyle
normalizeStyle ListNumberStyle
style1
      style2' :: ListNumberStyle
style2' = ListNumberStyle -> ListNumberStyle
normalizeStyle ListNumberStyle
style2
      normalizeStyle :: ListNumberStyle -> ListNumberStyle
normalizeStyle ListNumberStyle
DefaultStyle = ListNumberStyle
Decimal
      normalizeStyle ListNumberStyle
s            = ListNumberStyle
s
flatBlockListToMuse bs :: [Block]
bs@(DefinitionList [([Inline], Notes)]
_ : DefinitionList [([Inline], Notes)]
_ : [Block]
_) = [Block] -> Int -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs Int
2
flatBlockListToMuse bs :: [Block]
bs@(Block
_ : [Block]
_) = [Block] -> Int -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs Int
0
flatBlockListToMuse [] = Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty

simpleTable :: PandocMonad m
            => [Inline]
            -> [[Block]]
            -> [[[Block]]]
            -> Muse m (Doc Text)
simpleTable :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Notes -> [Notes] -> Muse m (Doc Text)
simpleTable [Inline]
caption Notes
headers [Notes]
rows = do
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text
caption' <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
caption
  [Doc Text]
headers' <- ([Block] -> Muse m (Doc Text))
-> Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse Notes
headers
  [[Doc Text]]
rows' <- (Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> [Notes] -> ReaderT WriterEnv (StateT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Block] -> Muse m (Doc Text))
-> Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse) [Notes]
rows
  let widthsInChars :: [Int]
widthsInChars = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headers' [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rows')
  let hpipeBlocks :: Text -> [Doc Text] -> Doc Text
hpipeBlocks Text
sep [Doc Text]
blocks = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
sep' [Doc Text]
blocks
        where sep' :: Doc Text
sep' = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Text -> Int
T.length Text
sep) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
sep
  let makeRow :: Text -> [Doc Text] -> Doc Text
makeRow Text
sep = Text -> [Doc Text] -> Doc Text
hpipeBlocks Text
sep ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc Text -> Doc Text) -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
widthsInChars
  let head' :: Doc Text
head' = Text -> [Doc Text] -> Doc Text
makeRow Text
" || " [Doc Text]
headers'
  [Doc Text]
rows'' <- (Notes -> Muse m (Doc Text))
-> [Notes] -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Notes
row -> Text -> [Doc Text] -> Doc Text
makeRow Text
rowSeparator ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> Muse m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> Muse m (Doc Text))
-> Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse Notes
row) [Notes]
rows
  let body :: Doc Text
body = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows''
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else Doc Text -> Doc Text
forall a. a -> a
id) ((if Bool
noHeaders then Doc Text
forall a. Doc a
empty else Doc Text
head')
                                             Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body
                                             Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption then Doc Text
forall a. Doc a
empty else Doc Text
"|+ " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" +|"))
         Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
  where noHeaders :: Bool
noHeaders = ([Block] -> Bool) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
headers
        rowSeparator :: Text
rowSeparator = if Bool
noHeaders then Text
" | " else Text
" |  "

-- | Convert list of Pandoc block elements to Muse.
blockListToMuse :: PandocMonad m
                => [Block]       -- ^ List of block elements
                -> Muse m (Doc Text)
blockListToMuse :: forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse =
  (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envTopLevel :: Bool
envTopLevel = Bool -> Bool
not (WriterEnv -> Bool
envInsideBlock WriterEnv
env)
                     , envInsideBlock :: Bool
envInsideBlock = Bool
True
                     }) (ReaderT WriterEnv (StateT WriterState m) (Doc Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ([Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> [Block]
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse

-- | Convert Pandoc block element to Muse.
blockToMuse :: PandocMonad m
            => Block         -- ^ Block element
            -> Muse m (Doc Text)
blockToMuse :: forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse (Plain [Inline]
inlines) = [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
blockToMuse (Para [Inline]
inlines) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMuse (LineBlock [[Inline]]
lns) = do
  [Doc Text]
lns' <- (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOneLine :: Bool
envOneLine = Bool
True }) (ReaderT WriterEnv (StateT WriterState m) [Doc Text]
 -> ReaderT WriterEnv (StateT WriterState m) [Doc Text])
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Muse m (Doc Text))
-> [[Inline]]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [[Inline]]
lns
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"> " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) [Doc Text]
lns') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMuse (CodeBlock (Text
_,[Text]
_,[(Text, Text)]
_) Text
str) =
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<example>" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</example>" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToMuse (RawBlock (Format Text
format) Text
str) =
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"<literal style=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
format Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</literal>" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToMuse (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
blocks
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline
        Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"<quote>"
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 Doc Text
contents -- nest 0 to remove trailing blank lines
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</quote>"
        Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToMuse (OrderedList (Int
start, ListNumberStyle
style, ListNumberDelim
_) Notes
items) = do
  let markers :: [Text]
markers = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Notes -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
items) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
                                      (Int
start, ListNumberStyle
style, ListNumberDelim
Period)
  [Doc Text]
contents <- (Text -> [Block] -> Muse m (Doc Text))
-> [Text]
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Text -> [Block] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> Muse m (Doc Text)
orderedListItemToMuse [Text]
markers Notes
items
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else Doc Text -> Doc Text
forall a. a -> a
id) ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
  where orderedListItemToMuse :: PandocMonad m
                              => Text     -- marker for list item
                              -> [Block]  -- list item (list of blocks)
                              -> Muse m (Doc Text)
        orderedListItemToMuse :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> Muse m (Doc Text)
orderedListItemToMuse Text
marker [Block]
item = Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space)
          (Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
item
blockToMuse (BulletList Notes
items) = do
  [Doc Text]
contents <- ([Block] -> Muse m (Doc Text))
-> Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
bulletListItemToMuse Notes
items
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else Doc Text -> Doc Text
forall a. a -> a
id) ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
  where bulletListItemToMuse :: PandocMonad m
                             => [Block]
                             -> Muse m (Doc Text)
        bulletListItemToMuse :: forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
bulletListItemToMuse [Block]
item = do
          (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
          Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Doc Text -> Doc Text) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
item
blockToMuse (DefinitionList [([Inline], Notes)]
items) = do
  [Doc Text]
contents <- (([Inline], Notes) -> Muse m (Doc Text))
-> [([Inline], Notes)]
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], Notes) -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], Notes) -> Muse m (Doc Text)
definitionListItemToMuse [([Inline], Notes)]
items
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else Doc Text -> Doc Text
forall a. a -> a
id) ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
  where definitionListItemToMuse :: PandocMonad m
                                 => ([Inline], [[Block]])
                                 -> Muse m (Doc Text)
        definitionListItemToMuse :: forall (m :: * -> *).
PandocMonad m =>
([Inline], Notes) -> Muse m (Doc Text)
definitionListItemToMuse ([Inline]
label, Notes
defs) = do
          (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
          Doc Text
label' <- (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOneLine :: Bool
envOneLine = Bool
True, envAfterSpace :: Bool
envAfterSpace = Bool
True }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
label
          let ind :: Int
ind = Doc Text -> Int
offset' Doc Text
label' -- using Text.DocLayout.offset results in round trip failures
          Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
ind (Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
label') (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> Muse m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> Muse m (Doc Text))
-> Notes -> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
descriptionToMuse Notes
defs
          where offset' :: Doc Text -> Int
offset' Doc Text
d = NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length
                                         (Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
d))
        descriptionToMuse :: PandocMonad m
                          => [Block]
                          -> Muse m (Doc Text)
        descriptionToMuse :: forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
descriptionToMuse [Block]
desc = Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
4 Doc Text
" :: " (Doc Text -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
desc
blockToMuse (Header Int
level (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
inlines) = do
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text
contents <- (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOneLine :: Bool
envOneLine = Bool
True }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
  Set Text
ids <- (WriterState -> Set Text)
-> ReaderT WriterEnv (StateT WriterState m) (Set Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set Text
stIds
  let autoId :: Text
autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
ids
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIds :: Set Text
stIds = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
autoId Set Text
ids }

  let attr' :: Doc Text
attr' = if Text -> Bool
T.null Text
ident Bool -> Bool -> Bool
|| (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers WriterOptions
opts Bool -> Bool -> Bool
&& Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId)
                 then Doc Text
forall a. Doc a
empty
                 else Doc Text
"#" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
  let header' :: Doc Text
header' = if Bool
topLevel then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"*") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space else Doc Text
forall a. Monoid a => a
mempty
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
header' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
-- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors
blockToMuse Block
HorizontalRule = Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"----" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToMuse (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  if Bool
isSimple Bool -> Bool -> Bool
&& Int
numcols Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then [Inline] -> Notes -> [Notes] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Notes -> [Notes] -> Muse m (Doc Text)
simpleTable [Inline]
caption Notes
headers [Notes]
rows
    else do
      WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
      WriterOptions
-> (WriterOptions -> [Block] -> Muse m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> Muse m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> Muse m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
blocksToDoc Bool
True ((Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Alignment -> Alignment
forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns) [Double]
widths Notes
headers [Notes]
rows
  where
    ([Inline]
caption, [Alignment]
aligns, [Double]
widths, Notes
headers, [Notes]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], Notes, [Notes])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
    blocksToDoc :: WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
blocksToDoc WriterOptions
opts [Block]
blocks =
      (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOptions :: WriterOptions
envOptions = WriterOptions
opts }) (ReaderT WriterEnv (StateT WriterState m) (Doc Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
blocks
    numcols :: Int
numcols = NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
              ([Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Notes -> Int) -> [Notes] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Notes -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Notes
headersNotes -> [Notes] -> [Notes]
forall a. a -> [a] -> [a]
:[Notes]
rows))
    isSimple :: Bool
isSimple = [Notes] -> Bool
onlySimpleTableCells (Notes
headers Notes -> [Notes] -> [Notes]
forall a. a -> [a] -> [a]
: [Notes]
rows) Bool -> Bool -> Bool
&& (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
blockToMuse (Div (Text, [Text], [(Text, Text)])
_ [Block]
bs) = [Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
bs
blockToMuse (Figure (Text, [Text], [(Text, Text)])
attr Caption
capt [Block]
body) = do
  Block -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse ((Text, [Text], [(Text, Text)]) -> Caption -> [Block] -> Block
figureDiv (Text, [Text], [(Text, Text)])
attr Caption
capt [Block]
body)

-- | Return Muse representation of notes collected so far.
currentNotesToMuse :: PandocMonad m
                   => Muse m (Doc Text)
currentNotesToMuse :: forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse = do
  Notes
notes <- Notes -> Notes
forall a. [a] -> [a]
reverse (Notes -> Notes)
-> ReaderT WriterEnv (StateT WriterState m) Notes
-> ReaderT WriterEnv (StateT WriterState m) Notes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Notes)
-> ReaderT WriterEnv (StateT WriterState m) Notes
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Notes
stNotes
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: Notes
stNotes = Notes
forall a. Monoid a => a
mempty }
  Notes -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Notes -> Muse m (Doc Text)
notesToMuse Notes
notes

-- | Return Muse representation of notes.
notesToMuse :: PandocMonad m
            => Notes
            -> Muse m (Doc Text)
notesToMuse :: forall (m :: * -> *). PandocMonad m => Notes -> Muse m (Doc Text)
notesToMuse Notes
notes = do
  Int
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteNum :: Int
stNoteNum = WriterState -> Int
stNoteNum WriterState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Notes -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
notes }
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
-> Muse m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> Muse m (Doc Text))
-> [Int]
-> Notes
-> ReaderT WriterEnv (StateT WriterState m) [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> [Block] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> Muse m (Doc Text)
noteToMuse [Int
n ..] Notes
notes

-- | Return Muse representation of a note.
noteToMuse :: PandocMonad m
           => Int
           -> [Block]
           -> Muse m (Doc Text)
noteToMuse :: forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> Muse m (Doc Text)
noteToMuse Int
num [Block]
note = do
  Doc Text
res <- Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker) (Doc Text -> Doc Text) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideBlock :: Bool
envInsideBlock = Bool
True
                       , envInlineStart :: Bool
envInlineStart = Bool
True
                       , envAfterSpace :: Bool
envAfterSpace = Bool
True
                       }) ([Block] -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
note)
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
res Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
  where
    marker :: Text
marker = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] "

-- | Return Muse representation of block and accumulated notes.
blockToMuseWithNotes :: PandocMonad m
                     => Block
                     -> Muse m (Doc Text)
blockToMuseWithNotes :: forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuseWithNotes Block
blk = do
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  let hdrToMuse :: Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
hdrToMuse hdr :: Block
hdr@Header{} = do
        Doc Text
b <- Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse Block
hdr
        if Bool
topLevel Bool -> Bool -> Bool
&& WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfSection
          then do
            Doc Text
notes <- ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
            Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
notes Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
b
          else
            Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
b
      hdrToMuse Block
b = Block -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse Block
b
  Doc Text
b <- Block -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
hdrToMuse Block
blk
  if Bool
topLevel Bool -> Bool -> Bool
&& WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts ReferenceLocation -> ReferenceLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfBlock
    then do
           Doc Text
notes <- Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
           Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
b Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
    else Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
b

-- | Escape special characters for Muse.
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText Text
s =
  Text
"<verbatim>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"</verbatim>" Text
"<</verbatim><verbatim>/verbatim>" Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  Text
"</verbatim>"

-- | Replace newlines with spaces
replaceNewlines :: Text -> Text
replaceNewlines :: Text -> Text
replaceNewlines = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c ->
  if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Char
' ' else Char
c

startsWithMarker :: (Char -> Bool) -> Text -> Bool
startsWithMarker :: (Char -> Bool) -> Text -> Bool
startsWithMarker Char -> Bool
f Text
t = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
f' Text
t of
  Just (Char
'.', Text
xs) -> Text -> Bool
T.null Text
xs Bool -> Bool -> Bool
|| Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
xs)
  Maybe (Char, Text)
_              -> Bool
False
  where
    f' :: Char -> Bool
f' Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char -> Bool
f Char
c

containsNotes :: Char -> Char -> Text -> Bool
containsNotes :: Char -> Char -> Text -> Bool
containsNotes Char
left Char
right = [Char] -> Bool
p ([Char] -> Bool) -> (Text -> [Char]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack -- This ought to be a parser
  where p :: [Char] -> Bool
p (Char
left':[Char]
xs)
          | Char
left' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
left = [Char] -> Bool
q [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
p [Char]
xs
          | Bool
otherwise = [Char] -> Bool
p [Char]
xs
        p [Char]
""       = Bool
False
        q :: [Char] -> Bool
q (Char
x:[Char]
xs)
          | Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"123456789"::String) = [Char] -> Bool
r [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
p [Char]
xs
          | Bool
otherwise = [Char] -> Bool
p [Char]
xs
        q [] = Bool
False
        r :: [Char] -> Bool
r (Char
'0':[Char]
xs) = [Char] -> Bool
r [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
p [Char]
xs
        r [Char]
xs       = [Char] -> Bool
s [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
q [Char]
xs Bool -> Bool -> Bool
|| [Char] -> Bool
p [Char]
xs
        s :: [Char] -> Bool
s (Char
right':[Char]
xs)
          | Char
right' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
right = Bool
True
          | Bool
otherwise = [Char] -> Bool
p [Char]
xs
        s []      = Bool
False

-- | Return True if string should be escaped with <verbatim> tags
shouldEscapeText :: PandocMonad m
                   => Text
                   -> Muse m Bool
shouldEscapeText :: forall (m :: * -> *). PandocMonad m => Text -> Muse m Bool
shouldEscapeText Text
s = do
  Bool
insideLink <- (WriterEnv -> Bool) -> Muse m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideLinkDescription
  Bool -> Muse m Bool
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Muse m Bool) -> Bool -> Muse m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
s Bool -> Bool -> Bool
||
           (Char -> Bool) -> Text -> Bool
T.any (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"#*<=|" :: String)) Text
s Bool -> Bool -> Bool
||
           Text
"::" Text -> Text -> Bool
`T.isInfixOf` Text
s Bool -> Bool -> Bool
||
           Text
"~~" Text -> Text -> Bool
`T.isInfixOf` Text
s Bool -> Bool -> Bool
||
           Text
"[[" Text -> Text -> Bool
`T.isInfixOf` Text
s Bool -> Bool -> Bool
||
           Text
">>>" Text -> Text -> Bool
`T.isInfixOf` Text
s Bool -> Bool -> Bool
||
           (Text
"]" Text -> Text -> Bool
`T.isInfixOf` Text
s Bool -> Bool -> Bool
&& Bool
insideLink) Bool -> Bool -> Bool
||
           Char -> Char -> Text -> Bool
containsNotes Char
'[' Char
']' Text
s Bool -> Bool -> Bool
||
           Char -> Char -> Text -> Bool
containsNotes Char
'{' Char
'}' Text
s

-- | Escape special characters for Muse if needed.
conditionalEscapeText :: PandocMonad m
                        => Text
                        -> Muse m Text
conditionalEscapeText :: forall (m :: * -> *). PandocMonad m => Text -> Muse m Text
conditionalEscapeText Text
s = do
  Bool
shouldEscape <- Text -> Muse m Bool
forall (m :: * -> *). PandocMonad m => Text -> Muse m Bool
shouldEscapeText Text
s
  Text -> Muse m Text
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Muse m Text) -> Text -> Muse m Text
forall a b. (a -> b) -> a -> b
$ if Bool
shouldEscape
             then Text -> Text
escapeText Text
s
             else Text
s

-- Expand Math and Cite before normalizing inline list
preprocessInlineList :: PandocMonad m
                     => [Inline]
                     -> m [Inline]
preprocessInlineList :: forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList (Math MathType
t Text
str:[Inline]
xs) = [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
(++) ([Inline] -> [Inline] -> [Inline])
-> m [Inline] -> m ([Inline] -> [Inline])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str m ([Inline] -> [Inline]) -> m [Inline] -> m [Inline]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Inline] -> m [Inline]
forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList [Inline]
xs
-- Amusewiki does not support <cite> tag,
-- and Emacs Muse citation support is limited
-- (https://www.gnu.org/software/emacs-muse/manual/html_node/Citations.html#Citation)
-- so just fallback to expanding inlines.
preprocessInlineList (Cite [Citation]
_  [Inline]
lst:[Inline]
xs) = ([Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++) ([Inline] -> [Inline]) -> m [Inline] -> m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList [Inline]
xs
preprocessInlineList (Inline
x:[Inline]
xs) = (Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:) ([Inline] -> [Inline]) -> m [Inline] -> m [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList [Inline]
xs
preprocessInlineList [] = [Inline] -> m [Inline]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

replaceSmallCaps :: Inline -> Inline
replaceSmallCaps :: Inline -> Inline
replaceSmallCaps (SmallCaps [Inline]
lst) = [Inline] -> Inline
Emph [Inline]
lst
replaceSmallCaps Inline
x               = Inline
x

removeKeyValues :: Inline -> Inline
removeKeyValues :: Inline -> Inline
removeKeyValues (Code (Text
i, [Text]
cls, [(Text, Text)]
_) Text
xs) = (Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text
i, [Text]
cls, []) Text
xs
-- Do not remove attributes from Link
-- Do not remove attributes, such as "width", from Image
-- Do not remove attributes, such as "dir", from Span
removeKeyValues Inline
x                     = Inline
x

normalizeInlineList :: [Inline] -> [Inline]
normalizeInlineList :: [Inline] -> [Inline]
normalizeInlineList (Str Text
"" : [Inline]
xs)
  = [Inline] -> [Inline]
normalizeInlineList [Inline]
xs
normalizeInlineList (Inline
x : Str Text
"" : [Inline]
xs)
  = [Inline] -> [Inline]
normalizeInlineList (Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
xs)
normalizeInlineList (Str Text
x1 : Str Text
x2 : [Inline]
xs)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text
x1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs
normalizeInlineList (Emph [Inline]
x1 : Emph [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Emph ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Strong [Inline]
x1 : Strong [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strong ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Strikeout [Inline]
x1 : Strikeout [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strikeout ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Superscript [Inline]
x1 : Superscript [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Subscript [Inline]
x1 : Subscript [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Subscript ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (SmallCaps [Inline]
x1 : SmallCaps [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
SmallCaps ([Inline]
x1 [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Code (Text, [Text], [(Text, Text)])
_ Text
x1 : Code (Text, [Text], [(Text, Text)])
_ Text
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
nullAttr (Text
x1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (RawInline Format
f1 Text
x1 : RawInline Format
f2 Text
x2 : [Inline]
ils) | Format
f1 Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f2
  = [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
f1 (Text
x1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x2) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils
-- Do not join Span's during normalization
normalizeInlineList (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
normalizeInlineList [Inline]
xs
normalizeInlineList [] = []

fixNotes :: [Inline] -> [Inline]
fixNotes :: [Inline] -> [Inline]
fixNotes []                            = []
fixNotes (Inline
Space : n :: Inline
n@Note{} : [Inline]
rest)     = Text -> Inline
Str Text
" " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
n Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixNotes [Inline]
rest
fixNotes (Inline
SoftBreak : n :: Inline
n@Note{} : [Inline]
rest) = Text -> Inline
Str Text
" " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
n Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixNotes [Inline]
rest
fixNotes (Inline
x:[Inline]
xs)                        = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixNotes [Inline]
xs

startsWithSpace :: [Inline] -> Bool
startsWithSpace :: [Inline] -> Bool
startsWithSpace (Inline
Space:[Inline]
_)     = Bool
True
startsWithSpace (Inline
SoftBreak:[Inline]
_) = Bool
True
startsWithSpace (Str Text
s:[Inline]
_)     = Text -> Bool
stringStartsWithSpace Text
s
startsWithSpace [Inline]
_             = Bool
False

endsWithSpace :: [Inline] -> Bool
endsWithSpace :: [Inline] -> Bool
endsWithSpace [Inline
Space]     = Bool
True
endsWithSpace [Inline
SoftBreak] = Bool
True
endsWithSpace [Str Text
s]     = Text -> Bool
stringEndsWithSpace Text
s
endsWithSpace (Inline
_:[Inline]
xs)      = [Inline] -> Bool
endsWithSpace [Inline]
xs
endsWithSpace []          = Bool
False

urlEscapeBrackets :: Text -> Text
urlEscapeBrackets :: Text -> Text
urlEscapeBrackets = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
  Char
']' -> Text
"%5D"
  Char
_   -> Char -> Text
T.singleton Char
c

isHorizontalRule :: Text -> Bool
isHorizontalRule :: Text -> Bool
isHorizontalRule Text
s = Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
s

stringStartsWithSpace :: Text -> Bool
stringStartsWithSpace :: Text -> Bool
stringStartsWithSpace = Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isSpace (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, Text) -> Bool)
-> (Text -> Maybe (Char, Text)) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

stringEndsWithSpace :: Text -> Bool
stringEndsWithSpace :: Text -> Bool
stringEndsWithSpace = Bool -> ((Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isSpace (Char -> Bool) -> ((Text, Char) -> Char) -> (Text, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Char) -> Char
forall a b. (a, b) -> b
snd) (Maybe (Text, Char) -> Bool)
-> (Text -> Maybe (Text, Char)) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Text, Char)
T.unsnoc

fixOrEscape :: Bool -> Inline -> Bool
fixOrEscape :: Bool -> Inline -> Bool
fixOrEscape Bool
b (Str Text
s) = Bool -> Text -> Bool
fixOrEscapeStr Bool
b Text
s
  where
    fixOrEscapeStr :: Bool -> Text -> Bool
fixOrEscapeStr Bool
sp Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
'-', Text
xs)
        | Text -> Bool
T.null Text
xs -> Bool
sp
        | Bool
otherwise -> (Bool
sp Bool -> Bool -> Bool
&& Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
xs)) Bool -> Bool -> Bool
|| Text -> Bool
isHorizontalRule Text
t
      Just (Char
';', Text
xs)
        | Text -> Bool
T.null Text
xs -> Bool -> Bool
not Bool
sp
        | Bool
otherwise -> Bool -> Bool
not Bool
sp Bool -> Bool -> Bool
&& Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
xs)
      Just (Char
'>', Text
xs)
        | Text -> Bool
T.null Text
xs -> Bool
True
        | Bool
otherwise -> Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
xs)
      Maybe (Char, Text)
_             -> (Bool
sp Bool -> Bool -> Bool
&& ((Char -> Bool) -> Text -> Bool
startsWithMarker Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
||
                               (Char -> Bool) -> Text -> Bool
startsWithMarker Char -> Bool
isAsciiLower Text
s Bool -> Bool -> Bool
||
                               (Char -> Bool) -> Text -> Bool
startsWithMarker Char -> Bool
isAsciiUpper Text
s))
                       Bool -> Bool -> Bool
|| Text -> Bool
stringStartsWithSpace Text
s
fixOrEscape Bool
_ Inline
Space = Bool
True
fixOrEscape Bool
_ Inline
SoftBreak = Bool
True
fixOrEscape Bool
_ Inline
_ = Bool
False

inlineListStartsWithAlnum :: PandocMonad m
                          => [Inline]
                          -> Muse m Bool
inlineListStartsWithAlnum :: forall (m :: * -> *). PandocMonad m => [Inline] -> Muse m Bool
inlineListStartsWithAlnum (Str Text
s:[Inline]
_) = do
  Bool
esc <- Text -> Muse m Bool
forall (m :: * -> *). PandocMonad m => Text -> Muse m Bool
shouldEscapeText Text
s
  Bool -> Muse m Bool
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Muse m Bool) -> Bool -> Muse m Bool
forall a b. (a -> b) -> a -> b
$ Bool
esc Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum (HasCallStack => Text -> Char
Text -> Char
T.head Text
s)
inlineListStartsWithAlnum [Inline]
_ = Bool -> Muse m Bool
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Convert list of Pandoc inline elements to Muse
renderInlineList :: PandocMonad m
                 => [Inline]
                 -> Muse m (Doc Text)
renderInlineList :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
renderInlineList [] = Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
""
renderInlineList (Inline
x:[Inline]
xs) = do
  Bool
start <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInlineStart
  Bool
afterSpace <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envAfterSpace
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Bool
insideAsterisks <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideAsterisks
  Bool
nearAsterisks <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envNearAsterisks
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  Bool
alnumNext <- [Inline] -> ReaderT WriterEnv (StateT WriterState m) Bool
forall (m :: * -> *). PandocMonad m => [Inline] -> Muse m Bool
inlineListStartsWithAlnum [Inline]
xs
  let newUseTags :: Bool
newUseTags = Bool
useTags Bool -> Bool -> Bool
|| Bool
alnumNext
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
newUseTags }

  Doc Text
r <- (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInlineStart :: Bool
envInlineStart = Bool
False
                          , envInsideAsterisks :: Bool
envInsideAsterisks = Bool
False
                          , envNearAsterisks :: Bool
envNearAsterisks = Bool
nearAsterisks Bool -> Bool -> Bool
|| ([Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
xs Bool -> Bool -> Bool
&& Bool
insideAsterisks)
                          }) (ReaderT WriterEnv (StateT WriterState m) (Doc Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Inline -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse Inline
x
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  let isNewline :: Bool
isNewline = (Inline
x Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
SoftBreak Bool -> Bool -> Bool
&& WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve) Bool -> Bool -> Bool
|| Inline
x Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak
  Doc Text
lst' <- (WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInlineStart :: Bool
envInlineStart = Bool
isNewline
                             , envAfterSpace :: Bool
envAfterSpace = Inline
x Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
topLevel Bool -> Bool -> Bool
&& Bool
isNewline)
                             , envNearAsterisks :: Bool
envNearAsterisks = Bool
False
                             }) (ReaderT WriterEnv (StateT WriterState m) (Doc Text)
 -> ReaderT WriterEnv (StateT WriterState m) (Doc Text))
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
-> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
renderInlineList [Inline]
xs
  if Bool
start Bool -> Bool -> Bool
&& Bool -> Inline -> Bool
fixOrEscape Bool
afterSpace Inline
x
    then Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"<verbatim></verbatim>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lst')
    else Doc Text -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lst')

-- | Normalize and convert list of Pandoc inline elements to Muse.
inlineListToMuse :: PandocMonad m
                 => [Inline]
                 -> Muse m (Doc Text)
inlineListToMuse :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst = do
  [Inline]
lst' <- [Inline] -> [Inline]
normalizeInlineList ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixNotes ([Inline] -> [Inline])
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
-> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> ReaderT WriterEnv (StateT WriterState m) [Inline]
forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map (Inline -> Inline
removeKeyValues (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
replaceSmallCaps) [Inline]
lst)
  Bool
insideAsterisks <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideAsterisks
  Bool
start <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInlineStart
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False } -- Previous character is likely a '>' or some other markup
  if Bool
start Bool -> Bool -> Bool
&& [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst'
    then Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"<verbatim></verbatim>"
    else (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envNearAsterisks :: Bool
envNearAsterisks = Bool
insideAsterisks }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
renderInlineList [Inline]
lst'

inlineListToMuse' :: PandocMonad m => [Inline] -> Muse m (Doc Text)
inlineListToMuse' :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
lst = do
  Bool
topLevel <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Bool
afterSpace <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envAfterSpace
  (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInlineStart :: Bool
envInlineStart = Bool
True
                     , envAfterSpace :: Bool
envAfterSpace = Bool
afterSpace Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
topLevel
                     }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst

emphasis :: PandocMonad m => Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis :: forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
b Text
e [Inline]
lst = do
  Doc Text
contents <- (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideAsterisks :: Bool
envInsideAsterisks = Bool
inAsterisks }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
useTags }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
b Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
e
  where inAsterisks :: Bool
inAsterisks = HasCallStack => Text -> Char
Text -> Char
T.last Text
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| HasCallStack => Text -> Char
Text -> Char
T.head Text
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'
        useTags :: Bool
useTags = HasCallStack => Text -> Char
Text -> Char
T.last Text
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>'

-- | Convert Pandoc inline element to Muse.
inlineToMuse :: PandocMonad m
             => Inline
             -> Muse m (Doc Text)
inlineToMuse :: forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse (Str Text
str) = do
  Text
escapedStr <- Text -> Muse m Text
forall (m :: * -> *). PandocMonad m => Text -> Muse m Text
conditionalEscapeText (Text -> Muse m Text) -> Text -> Muse m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceNewlines Text
str
  let useTags :: Bool
useTags = Char -> Bool
isAlphaNum (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.last Text
escapedStr -- escapedStr is never empty because empty strings are escaped
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
useTags }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
escapedStr
inlineToMuse (Emph [Strong [Inline]
lst]) = do
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  let lst' :: [Inline]
lst' = [Inline] -> [Inline]
normalizeInlineList [Inline]
lst
  if Bool
useTags
    then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<em>**" Text
"**</em>" [Inline]
lst'
    else if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
endsWithSpace [Inline]
lst'
           then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"*<strong>" Text
"</strong>*" [Inline]
lst'
           else Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"***" Text
"***" [Inline]
lst'
inlineToMuse (Emph [Inline]
lst) = do
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  let lst' :: [Inline]
lst' = [Inline] -> [Inline]
normalizeInlineList [Inline]
lst
  if Bool
useTags Bool -> Bool -> Bool
|| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
endsWithSpace [Inline]
lst'
    then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<em>" Text
"</em>" [Inline]
lst'
    else Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"*" Text
"*" [Inline]
lst'
inlineToMuse (Strong [Emph [Inline]
lst]) = do
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  let lst' :: [Inline]
lst' = [Inline] -> [Inline]
normalizeInlineList [Inline]
lst
  if Bool
useTags
    then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<strong>*" Text
"*</strong>" [Inline]
lst'
    else if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
endsWithSpace [Inline]
lst'
           then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"**<em>" Text
"</em>**" [Inline]
lst'
           else Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"***" Text
"***" [Inline]
lst'
-- Underline is only supported in Emacs Muse mode.
inlineToMuse (Underline [Inline]
lst) = do
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_amuse WriterOptions
opts
     then Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
     else Inline -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse ([Inline] -> Inline
Emph [Inline]
lst)
inlineToMuse (Strong [Inline]
lst) = do
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  let lst' :: [Inline]
lst' = [Inline] -> [Inline]
normalizeInlineList [Inline]
lst
  if Bool
useTags Bool -> Bool -> Bool
|| [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
startsWithSpace [Inline]
lst' Bool -> Bool -> Bool
|| [Inline] -> Bool
endsWithSpace [Inline]
lst'
    then Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<strong>" Text
"</strong>" [Inline]
lst'
    else Text -> Text -> [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"**" Text
"**" [Inline]
lst'
inlineToMuse (Strikeout [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<del>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</del>"
inlineToMuse (Superscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<sup>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</sup>"
inlineToMuse (Subscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<sub>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</sub>"
inlineToMuse SmallCaps {} =
  PandocError -> Muse m (Doc Text)
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> Muse m (Doc Text))
-> PandocError -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
    Text
"SmallCaps should be expanded before normalization"
inlineToMuse (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"‘" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
inlineToMuse (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"“" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
inlineToMuse Cite {} =
  PandocError -> Muse m (Doc Text)
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> Muse m (Doc Text))
-> PandocError -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
               Text
"Citations should be expanded before normalization"
inlineToMuse (Code (Text, [Text], [(Text, Text)])
_ Text
str) = do
  Bool
useTags <- (WriterState -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Bool
useTags Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
str Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') Text
str
              Bool -> Bool -> Bool
|| Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.head Text
str) Bool -> Bool -> Bool
|| Char -> Bool
isSpace (HasCallStack => Text -> Char
Text -> Char
T.last Text
str)
             then Doc Text
"<code>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"</code>" Text
"<</code><code>/code>" Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</code>"
             else Doc Text
"=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToMuse Math{} =
  PandocError -> Muse m (Doc Text)
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> Muse m (Doc Text))
-> PandocError -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
    Text
"Math should be expanded before normalization"
inlineToMuse (RawInline (Format Text
f) Text
str) = do
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<literal style=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
f Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</literal>"
inlineToMuse Inline
LineBreak = do
  Bool
oneline <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envOneLine
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Bool
oneline then Doc Text
"<br>" else Doc Text
"<br>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToMuse Inline
Space = do
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToMuse Inline
SoftBreak = do
  Bool
oneline <- (WriterEnv -> Bool)
-> ReaderT WriterEnv (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envOneLine
  WrapOption
wrapText <- (WriterEnv -> WrapOption)
-> ReaderT WriterEnv (StateT WriterState m) WrapOption
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((WriterEnv -> WrapOption)
 -> ReaderT WriterEnv (StateT WriterState m) WrapOption)
-> (WriterEnv -> WrapOption)
-> ReaderT WriterEnv (StateT WriterState m) WrapOption
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterEnv -> WriterOptions) -> WriterEnv -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterEnv -> WriterOptions
envOptions
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
oneline Bool -> Bool -> Bool
&& WrapOption
wrapText WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve then Doc Text
forall a. Doc a
cr else Doc Text
forall a. Doc a
space
inlineToMuse (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src, Text
_)) =
  case [Inline]
txt of
        [Str Text
x] | Text -> Text
escapeURI Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> do
             (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
             Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeLink Text
x) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
        [Inline]
_ -> do Doc Text
contents <- (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
txt
                (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
                Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeLink Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"][" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
  where escapeLink :: Text -> Text
escapeLink Text
lnk = if Text -> Bool
isImageUrl Text
lnk then Text
"URL:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEscapeBrackets Text
lnk else Text -> Text
urlEscapeBrackets Text
lnk
        -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el
        imageExtensions :: [[Char]]
imageExtensions = [[Char]
".eps", [Char]
".gif", [Char]
".jpg", [Char]
".jpeg", [Char]
".pbm", [Char]
".png", [Char]
".tiff", [Char]
".xbm", [Char]
".xpm"]
        isImageUrl :: Text -> Bool
isImageUrl = ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
imageExtensions) ([Char] -> Bool) -> (Text -> [Char]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeExtension ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
inlineToMuse (Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
source,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
title)) =
  Inline -> Muse m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse ((Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text
source,Text
title))
inlineToMuse (Image attr :: (Text, [Text], [(Text, Text)])
attr@(Text
_, [Text]
classes, [(Text, Text)]
_) [Inline]
inlines (Text
source, Text
title)) = do
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Doc Text
alt <- (WriterEnv -> WriterEnv) -> Muse m (Doc Text) -> Muse m (Doc Text)
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) (Muse m (Doc Text) -> Muse m (Doc Text))
-> Muse m (Doc Text) -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
inlines
  Doc Text
title' <- if Text -> Bool
T.null Text
title
            then if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
inlines
                 then Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
""
                 else Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
alt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
            else do Text
s <- (WriterEnv -> WriterEnv) -> Muse m Text -> Muse m Text
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (StateT WriterState m) a
-> ReaderT WriterEnv (StateT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) (Muse m Text -> Muse m Text) -> Muse m Text -> Muse m Text
forall a b. (a -> b) -> a -> b
$ Text -> Muse m Text
forall (m :: * -> *). PandocMonad m => Text -> Muse m Text
conditionalEscapeText Text
title
                    Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
s Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
  let width :: Text
width = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
                Just (Percent Double
x) | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_amuse WriterOptions
opts -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x :: Integer)
                Maybe Dimension
_ -> Text
""
  let leftalign :: Text
leftalign = if Text
"align-left" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                  then Text
" l"
                  else Text
""
  let rightalign :: Text
rightalign = if Text
"align-right" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                   then Text
" r"
                   else Text
""
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
urlEscapeBrackets Text
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
width Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
leftalign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rightalign) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToMuse (Note [Block]
contents) = do
  -- add to notes in state
  Notes
notes <- (WriterState -> Notes)
-> ReaderT WriterEnv (StateT WriterState m) Notes
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Notes
stNotes
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: Notes
stNotes = [Block]
contents[Block] -> Notes -> Notes
forall a. a -> [a] -> [a]
:Notes
notes
                     , stUseTags :: Bool
stUseTags = Bool
False
                     }
  Int
n <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
  let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Notes -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
notes
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToMuse (Span (Text
anchor,[Text]
names,[(Text, Text)]
kvs) [Inline]
inlines) = do
  Doc Text
contents <- [Inline] -> Muse m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
inlines
  let (Doc Text
contents', Bool
hasDir) = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                              Just Text
"rtl" -> (Doc Text
"<<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>>", Bool
True)
                              Just Text
"ltr" -> (Doc Text
">>>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"<<<", Bool
True)
                              Maybe Text
_ -> (Doc Text
contents, Bool
False)
  let anchorDoc :: Doc Text
anchorDoc = if Text -> Bool
T.null Text
anchor
                     then Doc Text
forall a. Monoid a => a
mempty
                     else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
anchor) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
  (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (StateT WriterState m) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (StateT WriterState m) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  Doc Text -> Muse m (Doc Text)
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Muse m (Doc Text)) -> Doc Text -> Muse m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
anchorDoc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
inlines Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
anchor)
                         then Doc Text
forall a. Monoid a => a
mempty
                         else (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
names then (if Bool
hasDir then Doc Text
contents' else Doc Text
"<class>" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</class>")
                               else Doc Text
"<class name=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
names) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"</class>"))