{-# 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 = 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 = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a b. (a -> b) -> a -> b
$ 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 =
  forall (m :: * -> *) a.
PandocMonad m =>
Muse m a -> WriterEnv -> WriterState -> m a
evalMuse (forall (m :: * -> *). PandocMonad m => Pandoc -> Muse m Text
pandocToMuse Pandoc
document) WriterEnv
env 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 <- 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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
               forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse)
               Meta
meta
  Doc Text
body <- forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
blocks
  Doc Text
notes <- forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
  let main :: Doc Text
main = Doc Text
body forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth 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 -> 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' <- forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuseWithNotes Block
b
  Doc Text
bs' <- forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
b' forall a. Semigroup a => a -> a -> a
<> forall a. Int -> Doc a
blanklines Int
n forall a. Semigroup a => a -> a -> a
<> Doc Text
bs'
catWithBlankLines [Block]
_ Int
_ = 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]
_) = 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]
_) =
  forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs (if ListNumberStyle
style1' 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]
_) = forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs Int
2
flatBlockListToMuse bs :: [Block]
bs@(Block
_ : [Block]
_) = forall (m :: * -> *).
PandocMonad m =>
[Block] -> Int -> Muse m (Doc Text)
catWithBlankLines [Block]
bs Int
0
flatBlockListToMuse [] = forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text
caption' <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
caption
  [Doc Text]
headers' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse Notes
headers
  [[Doc Text]]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse) [Notes]
rows
  let widthsInChars :: [Int]
widthsInChars = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (IsString a, HasChars a) => Doc a -> Int
offset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headers' forall a. a -> [a] -> [a]
: [[Doc Text]]
rows')
  let hpipeBlocks :: Text -> [Doc Text] -> Doc Text
hpipeBlocks Text
sep [Doc Text]
blocks = forall a. [Doc a] -> Doc a
hcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc Text
sep' [Doc Text]
blocks
        where sep' :: Doc Text
sep' = forall a. HasChars a => Int -> Doc a -> Doc a
lblock (Text -> Int
T.length Text
sep) forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Notes
row -> Text -> [Doc Text] -> Doc Text
makeRow Text
rowSeparator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse Notes
row) [Notes]
rows
  let body :: Doc Text
body = forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows''
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else forall a. a -> a
id) ((if Bool
noHeaders then forall a. Doc a
empty else Doc Text
head')
                                             forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body
                                             forall a. Doc a -> Doc a -> Doc a
$$ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption then forall a. Doc a
empty else Doc Text
"|+ " forall a. Semigroup a => a -> a -> a
<> Doc Text
caption' forall a. Semigroup a => a -> a -> a
<> Doc Text
" +|"))
         forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
  where noHeaders :: Bool
noHeaders = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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 =
  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
                     }) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
blockToMuse (Para [Inline]
inlines) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToMuse (LineBlock [[Inline]]
lns) = do
  [Doc Text]
lns' <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOneLine :: Bool
envOneLine = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [[Inline]]
lns
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasChars a => a -> Doc a
literal Text
"> " forall a. Semigroup a => a -> a -> a
<>) [Doc Text]
lns') forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToMuse (CodeBlock (Text
_,[Text]
_,[(Text, Text)]
_) Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<example>" forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</example>" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToMuse (RawBlock (Format Text
format) Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"<literal style=\"" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
format forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" forall a. Doc a -> Doc a -> Doc a
$$
           forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</literal>" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToMuse (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline
        forall a. Semigroup a => a -> a -> a
<> Doc Text
"<quote>"
        forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
0 Doc Text
contents -- nest 0 to remove trailing blank lines
        forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"</quote>"
        forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToMuse (OrderedList (Int
start, ListNumberStyle
style, ListNumberDelim
_) Notes
items) = do
  let markers :: [Text]
markers = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
items) forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
                                      (Int
start, ListNumberStyle
style, ListNumberDelim
Period)
  [Doc Text]
contents <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> Muse m (Doc Text)
orderedListItemToMuse [Text]
markers Notes
items
  Bool
topLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else forall a. a -> a
id) (forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) forall a. Doc a -> Doc a -> Doc a
$$ 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 = forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker forall a. Num a => a -> a -> a
+ Int
1) (forall a. HasChars a => a -> Doc a
literal Text
marker forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
item
blockToMuse (BulletList Notes
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
bulletListItemToMuse Notes
items
  Bool
topLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else forall a. a -> a
id) (forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) forall a. Doc a -> Doc a -> Doc a
$$ 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
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
          forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
item
blockToMuse (DefinitionList [([Inline], Notes)]
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], Notes) -> Muse m (Doc Text)
definitionListItemToMuse [([Inline], Notes)]
items
  Bool
topLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
topLevel then forall a. IsString a => Int -> Doc a -> Doc a
nest Int
1 else forall a. a -> a
id) (forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents) forall a. Doc a -> Doc a -> Doc a
$$ 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
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
          Doc Text
label' <- 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 }) forall a b. (a -> b) -> a -> b
$ 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
          forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
ind (forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
label') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
descriptionToMuse Notes
defs
          where offset' :: Doc Text -> Int
offset' Doc Text
d = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 forall a. a -> [a] -> NonEmpty a
:| forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length
                                         (Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render 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 = forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
4 Doc Text
" :: " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Bool
topLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Doc Text
contents <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOneLine :: Bool
envOneLine = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse' [Inline]
inlines
  Set Text
ids <- 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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stIds :: Set Text
stIds = 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
|| (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers WriterOptions
opts Bool -> Bool -> Bool
&& Text
ident forall a. Eq a => a -> a -> Bool
== Text
autoId)
                 then forall a. Doc a
empty
                 else Doc Text
"#" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
  let header' :: Doc Text
header' = if Bool
topLevel then forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"*") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space else forall a. Monoid a => a
mempty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
header' forall a. Semigroup a => a -> a -> a
<> Doc Text
contents) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
-- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors
blockToMuse Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"----" forall a. Doc a -> Doc a -> Doc a
$$ 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 forall a. Ord a => a -> a -> Bool
> Int
1
    then forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Notes -> [Notes] -> Muse m (Doc Text)
simpleTable [Inline]
caption Notes
headers [Notes]
rows
    else do
      WriterOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
      forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> m (Doc a)
gridTable WriterOptions
opts forall {m :: * -> *}.
PandocMonad m =>
WriterOptions
-> [Block] -> ReaderT WriterEnv (StateT WriterState m) (Doc Text)
blocksToDoc Bool
True (forall a b. (a -> b) -> [a] -> [b]
map (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 =
      forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envOptions :: WriterOptions
envOptions = WriterOptions
opts }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
blocks
    numcols :: Int
numcols = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
              (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns forall a. a -> [a] -> NonEmpty a
:| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length (Notes
headersforall a. a -> [a] -> [a]
:[Notes]
rows))
    isSimple :: Bool
isSimple = [Notes] -> Bool
onlySimpleTableCells (Notes
headers forall a. a -> [a] -> [a]
: [Notes]
rows) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
blockToMuse (Div (Text, [Text], [(Text, Text)])
_ [Block]
bs) = forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
flatBlockListToMuse [Block]
bs
blockToMuse (Figure (Text, [Text], [(Text, Text)])
attr Caption
capt [Block]
body) = do
  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 <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Notes
stNotes
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: Notes
stNotes = forall a. Monoid a => a
mempty }
  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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteNum :: Int
stNoteNum = WriterState -> Int
stNoteNum WriterState
st forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
notes }
  forall a. [Doc a] -> Doc a
vsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM 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 <- forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker) (forall a. HasChars a => a -> Doc a
literal Text
marker) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    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
                       }) (forall (m :: * -> *). PandocMonad m => [Block] -> Muse m (Doc Text)
blockListToMuse [Block]
note)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
res forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
  where
    marker :: Text
marker = Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
num 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  WriterOptions
opts <- 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 <- forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse Block
hdr
        if Bool
topLevel Bool -> Bool -> Bool
&& WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfSection
          then do
            Doc Text
notes <- forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
notes forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
b
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
b
      hdrToMuse Block
b = forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
blockToMuse Block
b
  Doc Text
b <- forall (m :: * -> *). PandocMonad m => Block -> Muse m (Doc Text)
hdrToMuse Block
blk
  if Bool
topLevel Bool -> Bool -> Bool
&& WriterOptions -> ReferenceLocation
writerReferenceLocation WriterOptions
opts forall a. Eq a => a -> a -> Bool
== ReferenceLocation
EndOfBlock
    then do
           Doc Text
notes <- forall (m :: * -> *). PandocMonad m => Muse m (Doc Text)
currentNotesToMuse
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
b forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
    else 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>" forall a. Semigroup a => a -> a -> a
<>
  Text -> Text -> Text -> Text
T.replace Text
"</verbatim>" Text
"<</verbatim><verbatim>/verbatim>" Text
s 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 forall a b. (a -> b) -> a -> b
$ \Char
c ->
  if Char
c 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 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 (Text -> Char
T.head Text
xs)
  Maybe (Char, Text)
_              -> Bool
False
  where
    f' :: Char -> Bool
f' Char
c = Char
c 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 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' 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 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' 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideLinkDescription
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
s Bool -> Bool -> Bool
||
           (Char -> Bool) -> Text -> Bool
T.any (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 <- forall (m :: * -> *). PandocMonad m => Text -> Muse m Bool
shouldEscapeText Text
s
  forall (m :: * -> *) a. Monad m => a -> m a
return 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) = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList [Inline]
xs
preprocessInlineList (Inline
x:[Inline]
xs) = (Inline
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList [Inline]
xs
preprocessInlineList [] = 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
xforall a. a -> [a] -> [a]
:[Inline]
xs)
normalizeInlineList (Str Text
x1 : Str Text
x2 : [Inline]
xs)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str (Text
x1 forall a. Semigroup a => a -> a -> a
<> Text
x2) forall a. a -> [a] -> [a]
: [Inline]
xs
normalizeInlineList (Emph [Inline]
x1 : Emph [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Emph ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Strong [Inline]
x1 : Strong [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strong ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Strikeout [Inline]
x1 : Strikeout [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strikeout ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Superscript [Inline]
x1 : Superscript [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (Subscript [Inline]
x1 : Subscript [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Subscript ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (SmallCaps [Inline]
x1 : SmallCaps [Inline]
x2 : [Inline]
ils)
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
SmallCaps ([Inline]
x1 forall a. Semigroup a => a -> a -> a
<> [Inline]
x2) 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 forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
nullAttr (Text
x1 forall a. Semigroup a => a -> a -> a
<> Text
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
normalizeInlineList (RawInline Format
f1 Text
x1 : RawInline Format
f2 Text
x2 : [Inline]
ils) | Format
f1 forall a. Eq a => a -> a -> Bool
== Format
f2
  = [Inline] -> [Inline]
normalizeInlineList forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
f1 (Text
x1 forall a. Semigroup a => a -> a -> a
<> Text
x2) forall a. a -> [a] -> [a]
: [Inline]
ils
-- Do not join Span's during normalization
normalizeInlineList (Inline
x:[Inline]
xs) = Inline
x 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
" " forall a. a -> [a] -> [a]
: Inline
n forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixNotes [Inline]
rest
fixNotes (Inline
SoftBreak : n :: Inline
n@Note{} : [Inline]
rest) = Text -> Inline
Str Text
" " forall a. a -> [a] -> [a]
: Inline
n forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixNotes [Inline]
rest
fixNotes (Inline
x:[Inline]
xs)                        = Inline
x 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 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 forall a. Ord a => a -> a -> Bool
>= Int
4 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
== Char
'-') Text
s

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

stringEndsWithSpace :: Text -> Bool
stringEndsWithSpace :: Text -> Bool
stringEndsWithSpace = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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 (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 (Text -> Char
T.head Text
xs)
      Just (Char
'>', Text
xs)
        | Text -> Bool
T.null Text
xs -> Bool
True
        | Bool
otherwise -> Char -> Bool
isSpace (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 <- forall (m :: * -> *). PandocMonad m => Text -> Muse m Bool
shouldEscapeText Text
s
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
esc Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum (Text -> Char
T.head Text
s)
inlineListStartsWithAlnum [Inline]
_ = 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 [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
""
renderInlineList (Inline
x:[Inline]
xs) = do
  Bool
start <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInlineStart
  Bool
afterSpace <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envAfterSpace
  Bool
topLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Bool
insideAsterisks <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideAsterisks
  Bool
nearAsterisks <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envNearAsterisks
  Bool
useTags <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  Bool
alnumNext <- forall (m :: * -> *). PandocMonad m => [Inline] -> Muse m Bool
inlineListStartsWithAlnum [Inline]
xs
  let newUseTags :: Bool
newUseTags = Bool
useTags Bool -> Bool -> Bool
|| Bool
alnumNext
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
newUseTags }

  Doc Text
r <- 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
|| (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
xs Bool -> Bool -> Bool
&& Bool
insideAsterisks)
                          }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse Inline
x
  WriterOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  let isNewline :: Bool
isNewline = (Inline
x forall a. Eq a => a -> a -> Bool
== Inline
SoftBreak Bool -> Bool -> Bool
&& WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve) Bool -> Bool -> Bool
|| Inline
x forall a. Eq a => a -> a -> Bool
== Inline
LineBreak
  Doc Text
lst' <- 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 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
                             }) forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. HasChars a => a -> Doc a
literal Text
"<verbatim></verbatim>" forall a. Semigroup a => a -> a -> a
<> Doc Text
r forall a. Semigroup a => a -> a -> a
<> Doc Text
lst')
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
r 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixNotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> m [Inline]
preprocessInlineList (forall a b. (a -> b) -> [a] -> [b]
map (Inline -> Inline
removeKeyValues forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
replaceSmallCaps) [Inline]
lst)
  Bool
insideAsterisks <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInsideAsterisks
  Bool
start <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInlineStart
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst'
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"<verbatim></verbatim>"
    else forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envNearAsterisks :: Bool
envNearAsterisks = Bool
insideAsterisks }) forall a b. (a -> b) -> a -> b
$ 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envTopLevel
  Bool
afterSpace <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envAfterSpace
  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
                     }) forall a b. (a -> b) -> a -> b
$ 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideAsterisks :: Bool
envInsideAsterisks = Bool
inAsterisks }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
useTags }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
b forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
e
  where inAsterisks :: Bool
inAsterisks = Text -> Char
T.last Text
b forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
|| Text -> Char
T.head Text
e forall a. Eq a => a -> a -> Bool
== Char
'*'
        useTags :: Bool
useTags = Text -> Char
T.last Text
e 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 <- forall (m :: * -> *). PandocMonad m => Text -> Muse m Text
conditionalEscapeText forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceNewlines Text
str
  let useTags :: Bool
useTags = Char -> Bool
isAlphaNum forall a b. (a -> b) -> a -> b
$ Text -> Char
T.last Text
escapedStr -- escapedStr is never empty because empty strings are escaped
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
useTags }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
escapedStr
inlineToMuse (Emph [Strong [Inline]
lst]) = do
  Bool
useTags <- 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<em>**" Text
"**</em>" [Inline]
lst'
    else if 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"*<strong>" Text
"</strong>*" [Inline]
lst'
           else forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"***" Text
"***" [Inline]
lst'
inlineToMuse (Emph [Inline]
lst) = do
  Bool
useTags <- 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
|| 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<em>" Text
"</em>" [Inline]
lst'
    else forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"*" Text
"*" [Inline]
lst'
inlineToMuse (Strong [Emph [Inline]
lst]) = do
  Bool
useTags <- 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<strong>*" Text
"*</strong>" [Inline]
lst'
    else if 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"**<em>" Text
"</em>**" [Inline]
lst'
           else 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_amuse WriterOptions
opts
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"_" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
     else forall (m :: * -> *). PandocMonad m => Inline -> Muse m (Doc Text)
inlineToMuse ([Inline] -> Inline
Emph [Inline]
lst)
inlineToMuse (Strong [Inline]
lst) = do
  Bool
useTags <- 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
|| 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 forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"<strong>" Text
"</strong>" [Inline]
lst'
    else forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> [Inline] -> Muse m (Doc Text)
emphasis Text
"**" Text
"**" [Inline]
lst'
inlineToMuse (Strikeout [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<del>" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"</del>"
inlineToMuse (Superscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<sup>" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"</sup>"
inlineToMuse (Subscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<sub>" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"</sub>"
inlineToMuse SmallCaps {} =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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 <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"‘" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
inlineToMuse (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
lst
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"“" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
inlineToMuse Cite {} =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall a. Eq a => a -> a -> Bool
== Char
'=') Text
str
              Bool -> Bool -> Bool
|| Char -> Bool
isSpace (Text -> Char
T.head Text
str) Bool -> Bool -> Bool
|| Char -> Bool
isSpace (Text -> Char
T.last Text
str)
             then Doc Text
"<code>" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text -> Text -> Text
T.replace Text
"</code>" Text
"<</code><code>/code>" Text
str) forall a. Semigroup a => a -> a -> a
<> Doc Text
"</code>"
             else Doc Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToMuse Math{} =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<literal style=\"" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
f forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"</literal>"
inlineToMuse Inline
LineBreak = do
  Bool
oneline <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envOneLine
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
oneline then Doc Text
"<br>" else Doc Text
"<br>" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
inlineToMuse Inline
Space = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToMuse Inline
SoftBreak = do
  Bool
oneline <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envOneLine
  WrapOption
wrapText <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterEnv -> WriterOptions
envOptions
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
oneline Bool -> Bool -> Bool
&& WrapOption
wrapText forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve then forall a. Doc a
cr else 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 forall a. Eq a => a -> a -> Bool
== Text
src -> do
             forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeLink Text
x) forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
        [Inline]
_ -> do Doc Text
contents <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
txt
                forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeLink Text
src) forall a. Semigroup a => a -> a -> a
<> Doc Text
"][" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents 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:" 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 = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
imageExtensions) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeExtension 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)) =
  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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOptions
  Doc Text
alt <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
inlines
  Doc Text
title' <- if Text -> Bool
T.null Text
title
            then if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
inlines
                 then forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
""
                 else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[" forall a. Semigroup a => a -> a -> a
<> Doc Text
alt forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
            else do Text
s <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInsideLinkDescription :: Bool
envInsideLinkDescription = Bool
True }) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => Text -> Muse m Text
conditionalEscapeText Text
title
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
s 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) | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_amuse WriterOptions
opts -> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
round Double
x :: Integer)
                Maybe Dimension
_ -> Text
""
  let leftalign :: Text
leftalign = if Text
"align-left" 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" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                   then Text
" r"
                   else Text
""
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
urlEscapeBrackets Text
source forall a. Semigroup a => a -> a -> a
<> Text
width forall a. Semigroup a => a -> a -> a
<> Text
leftalign forall a. Semigroup a => a -> a -> a
<> Text
rightalign) forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" forall a. Semigroup a => a -> a -> a
<> Doc Text
title' forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToMuse (Note [Block]
contents) = do
  -- add to notes in state
  Notes
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Notes
stNotes
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: Notes
stNotes = [Block]
contentsforall a. a -> [a] -> [a]
:Notes
notes
                     , stUseTags :: Bool
stUseTags = Bool
False
                     }
  Int
n <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteNum
  let ref :: Text
ref = forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length Notes
notes
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ref forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
inlineToMuse (Span (Text
anchor,[Text]
names,[(Text, Text)]
kvs) [Inline]
inlines) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
[Inline] -> Muse m (Doc Text)
inlineListToMuse [Inline]
inlines
  let (Doc Text
contents', Bool
hasDir) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                              Just Text
"rtl" -> (Doc Text
"<<<" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
">>>", Bool
True)
                              Just Text
"ltr" -> (Doc Text
">>>" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents 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 forall a. Monoid a => a
mempty
                     else forall a. HasChars a => a -> Doc a
literal (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
anchor) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stUseTags :: Bool
stUseTags = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
anchorDoc forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
inlines Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
anchor)
                         then forall a. Monoid a => a
mempty
                         else (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
names then (if Bool
hasDir then Doc Text
contents' else Doc Text
"<class>" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents' forall a. Semigroup a => a -> a -> a
<> Doc Text
"</class>")
                               else Doc Text
"<class name=\"" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. [a] -> a
head [Text]
names) forall a. Semigroup a => a -> a -> a
<> Doc Text
"\">" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents' forall a. Semigroup a => a -> a -> a
<> Doc Text
"</class>"))