{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- |
   Module      : Text.Pandoc.Writers.ICML
   Copyright   : Copyright (C) 2013-2020 github.com/mb21
   License     : GNU GPL, version 2 or above

   Stability   : alpha

Conversion of 'Pandoc' documents to Adobe InCopy ICML, a stand-alone XML format
which is a subset of the zipped IDML format for which the documentation is
available here: http://wwwimages.adobe.com/www.adobe.com/content/dam/Adobe/en/devnet/indesign/sdk/cs6/idml/idml-specification.pdf
InCopy is the companion word-processor to Adobe InDesign and ICML documents can be integrated
into InDesign with File -> Place.
-}
module Text.Pandoc.Writers.ICML (writeICML) where
import Control.Monad.Except (catchError)
import Control.Monad (liftM2)
import Control.Monad.State.Strict
    ( MonadTrans(lift), StateT(runStateT), MonadState(state, get, put) )
import Data.List (intersperse)
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Text (Text)
import Text.Pandoc.Class.PandocMonad (PandocMonad, fetchItem, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI (isURI)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML

type Style = [Text]
type Hyperlink = [(Int, Text)]

data WriterState = WriterState{
    WriterState -> Set Text
blockStyles  :: Set.Set Text
  , WriterState -> Set Text
inlineStyles :: Set.Set Text
  , WriterState -> Hyperlink
links        :: Hyperlink
  , WriterState -> Int
listDepth    :: Int
  , WriterState -> Int
maxListDepth :: Int
  }

type WS m = StateT WriterState m

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState{
    blockStyles :: Set Text
blockStyles  = Set Text
forall a. Set a
Set.empty
  , inlineStyles :: Set Text
inlineStyles = Set Text
forall a. Set a
Set.empty
  , links :: Hyperlink
links        = []
  , listDepth :: Int
listDepth    = Int
1
  , maxListDepth :: Int
maxListDepth = Int
0
  }

-- inline names (appear in InDesign's character styles pane)
emphName        :: Text
underlineName   :: Text
strongName      :: Text
strikeoutName   :: Text
superscriptName :: Text
subscriptName   :: Text
smallCapsName   :: Text
codeName        :: Text
linkName        :: Text
emphName :: Text
emphName        = Text
"Italic"
underlineName :: Text
underlineName   = Text
"Underline"
strongName :: Text
strongName      = Text
"Bold"
strikeoutName :: Text
strikeoutName   = Text
"Strikeout"
superscriptName :: Text
superscriptName = Text
"Superscript"
subscriptName :: Text
subscriptName   = Text
"Subscript"
smallCapsName :: Text
smallCapsName   = Text
"SmallCaps"
codeName :: Text
codeName        = Text
"Code"
linkName :: Text
linkName        = Text
"Link"

-- block element names (appear in InDesign's paragraph styles pane)
paragraphName     :: Text
figureName        :: Text
imgCaptionName    :: Text
codeBlockName     :: Text
blockQuoteName    :: Text
orderedListName   :: Text
bulletListName    :: Text
defListTermName   :: Text
defListDefName    :: Text
headerName        :: Text
tableName         :: Text
tableHeaderName   :: Text
tableCaptionName  :: Text
alignLeftName     :: Text
alignRightName    :: Text
alignCenterName   :: Text
firstListItemName :: Text
beginsWithName    :: Text
lowerRomanName    :: Text
upperRomanName    :: Text
lowerAlphaName    :: Text
upperAlphaName    :: Text
subListParName    :: Text
footnoteName      :: Text
citeName          :: Text
paragraphName :: Text
paragraphName     = Text
"Paragraph"
figureName :: Text
figureName        = Text
"Figure"
imgCaptionName :: Text
imgCaptionName    = Text
"Caption"
codeBlockName :: Text
codeBlockName     = Text
"CodeBlock"
blockQuoteName :: Text
blockQuoteName    = Text
"Blockquote"
orderedListName :: Text
orderedListName   = Text
"NumList"
bulletListName :: Text
bulletListName    = Text
"BulList"
defListTermName :: Text
defListTermName   = Text
"DefListTerm"
defListDefName :: Text
defListDefName    = Text
"DefListDef"
headerName :: Text
headerName        = Text
"Header"
tableName :: Text
tableName         = Text
"TablePar"
tableHeaderName :: Text
tableHeaderName   = Text
"TableHeader"
tableCaptionName :: Text
tableCaptionName  = Text
"TableCaption"
alignLeftName :: Text
alignLeftName     = Text
"LeftAlign"
alignRightName :: Text
alignRightName    = Text
"RightAlign"
alignCenterName :: Text
alignCenterName   = Text
"CenterAlign"
firstListItemName :: Text
firstListItemName = Text
"first"
beginsWithName :: Text
beginsWithName    = Text
"beginsWith-"
lowerRomanName :: Text
lowerRomanName    = Text
"lowerRoman"
upperRomanName :: Text
upperRomanName    = Text
"upperRoman"
lowerAlphaName :: Text
lowerAlphaName    = Text
"lowerAlpha"
upperAlphaName :: Text
upperAlphaName    = Text
"upperAlpha"
subListParName :: Text
subListParName    = Text
"subParagraph"
footnoteName :: Text
footnoteName      = Text
"Footnote"
citeName :: Text
citeName          = Text
"Cite"

-- | Convert Pandoc document to string in ICML format.
writeICML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeICML WriterOptions
opts Pandoc
doc = do
  let Pandoc Meta
meta [Block]
blocks = Pandoc -> Pandoc
ensureValidXmlIdentifiers Pandoc
doc
  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
      renderBlockMeta :: (WriterOptions -> [a] -> t -> StateT WriterState f b) -> t -> f b
renderBlockMeta WriterOptions -> [a] -> t -> StateT WriterState f b
f t
s = (b, WriterState) -> b
forall a b. (a, b) -> a
fst ((b, WriterState) -> b) -> f (b, WriterState) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT WriterState f b -> WriterState -> f (b, WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterOptions -> [a] -> t -> StateT WriterState f b
f WriterOptions
opts [] t
s) WriterState
defaultWriterState
      renderInlineMeta :: (WriterOptions -> [a] -> t -> t -> StateT WriterState f b)
-> t -> f b
renderInlineMeta WriterOptions -> [a] -> t -> t -> StateT WriterState f b
f t
s = (b, WriterState) -> b
forall a b. (a, b) -> a
fst ((b, WriterState) -> b) -> f (b, WriterState) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT WriterState f b -> WriterState -> f (b, WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterOptions -> [a] -> t -> t -> StateT WriterState f b
f WriterOptions
opts [] t
"" t
s) WriterState
defaultWriterState
  Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> 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
             ((WriterOptions
 -> [Text] -> [Block] -> StateT WriterState m (Doc Text))
-> [Block] -> m (Doc Text)
forall {f :: * -> *} {a} {t} {b}.
Functor f =>
(WriterOptions -> [a] -> t -> StateT WriterState f b) -> t -> f b
renderBlockMeta WriterOptions
-> [Text] -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML)
             ((WriterOptions
 -> [Text] -> Text -> [Inline] -> StateT WriterState m (Doc Text))
-> [Inline] -> m (Doc Text)
forall {f :: * -> *} {t} {a} {t} {b}.
(Functor f, IsString t) =>
(WriterOptions -> [a] -> t -> t -> StateT WriterState f b)
-> t -> f b
renderInlineMeta WriterOptions
-> [Text] -> Text -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML)
             Meta
meta
  (Doc Text
main, WriterState
st) <- StateT WriterState m (Doc Text)
-> WriterState -> m (Doc Text, WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterOptions
-> [Text] -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts [] [Block]
blocks) WriterState
defaultWriterState
  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 -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"charStyles" (WriterState -> Doc Text
charStylesToDoc WriterState
st)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"parStyles"  (WriterState -> Doc Text
parStylesToDoc WriterState
st)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hyperlinks" (Hyperlink -> Doc Text
hyperlinksToDoc (Hyperlink -> Doc Text) -> Hyperlink -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st) Context Text
metadata
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> 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
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then (Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else Doc Text -> Doc Text
forall a. a -> a
id) (Doc Text -> Doc Text) -> Doc Text -> Doc 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

-- | Auxiliary functions for parStylesToDoc and charStylesToDoc.
contains :: Text -> (Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
contains :: Text -> (Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
contains Text
s (Text
t, (Text
k,Text
v)) [(Text, Text)]
attrs =
  if Text
t Text -> Text -> Bool
`Text.isInfixOf` Text
s
     then case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
attrs of -- avoid duplicates, #9158
            Maybe Text
Nothing -> (Text
k, Text
v) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
            Just Text
_ -> [(Text, Text)]
attrs
     else [(Text, Text)]
attrs

-- | The monospaced font to use as default.
monospacedFont :: Doc Text
monospacedFont :: Doc Text
monospacedFont = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"AppliedFont" [(Text
"type", Text
"string")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"Courier New"

-- | How much to indent blockquotes etc.
defaultIndent :: Int
defaultIndent :: Int
defaultIndent = Int
20

-- | How much to indent numbered lists before the number.
defaultListIndent :: Int
defaultListIndent :: Int
defaultListIndent = Int
10

-- other constants
lineSeparator :: Text
lineSeparator :: Text
lineSeparator = Text
"&#x2028;"

-- | Convert a WriterState with its block styles to the ICML listing of Paragraph Styles.
parStylesToDoc :: WriterState -> Doc Text
parStylesToDoc :: WriterState -> Doc Text
parStylesToDoc WriterState
st = [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
$ (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
makeStyle ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toAscList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
blockStyles WriterState
st
  where
    makeStyle :: Text -> Doc Text
makeStyle Text
s =
      let countSubStrs :: Text -> Text -> Int
countSubStrs Text
sub Text
str = [(Text, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Text, Text)] -> Int) -> [(Text, Text)] -> Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [(Text, Text)]
Text -> Text -> [(Text, Text)]
Text.breakOnAll Text
sub Text
str
          attrs :: [(Text, Text)]
attrs = ((Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, (Text, Text))] -> [(Text, Text)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> (Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
contains Text
s) [] [
                               (Text
defListTermName, (Text
"BulletsAndNumberingListType", Text
"BulletList"))
                             , (Text
defListTermName, (Text
"FontStyle", Text
"Bold"))
                             , (Text
tableHeaderName, (Text
"FontStyle", Text
"Bold"))
                             , (Text
alignLeftName,   (Text
"Justification", Text
"LeftAlign"))
                             , (Text
alignRightName,  (Text
"Justification", Text
"RightAlign"))
                             , (Text
alignCenterName, (Text
"Justification", Text
"CenterAlign"))
                             , (Text
headerNameText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"1", (Text
"PointSize", Text
"36"))
                             , (Text
headerNameText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"2", (Text
"PointSize", Text
"30"))
                             , (Text
headerNameText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"3", (Text
"PointSize", Text
"24"))
                             , (Text
headerNameText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"4", (Text
"PointSize", Text
"18"))
                             , (Text
headerNameText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"5", (Text
"PointSize", Text
"14"))
                             ]
          -- what is the most nested list type, if any?
          (Bool
isBulletList, Bool
isOrderedList) = [Text] -> (Bool, Bool)
findList ([Text] -> (Bool, Bool)) -> [Text] -> (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') Text
s
            where
              findList :: [Text] -> (Bool, Bool)
findList [] = (Bool
False, Bool
False)
              findList (Text
x:[Text]
xs) | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bulletListName  = (Bool
True, Bool
False)
                              | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
orderedListName = (Bool
False, Bool
True)
                              | Bool
otherwise = [Text] -> (Bool, Bool)
findList [Text]
xs
          nBuls :: Int
nBuls = Text -> Text -> Int
countSubStrs Text
bulletListName Text
s
          nOrds :: Int
nOrds = Text -> Text -> Int
countSubStrs Text
orderedListName Text
s
          attrs' :: [(Text, Text)]
attrs' = [(Text, Text)]
numbering [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
listType [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
indent [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
attrs
            where
              numbering :: [(Text, Text)]
numbering | Bool
isOrderedList = [(Text
"NumberingExpression", Text
"^#.^t"), (Text
"NumberingLevel", Int -> Text
forall a. Show a => a -> Text
tshow Int
nOrds)]
                        | Bool
otherwise     = []
              listType :: [(Text, Text)]
listType | Bool
isOrderedList Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
subListParName Text -> Text -> Bool
`Text.isInfixOf` Text
s)
                           = [(Text
"BulletsAndNumberingListType", Text
"NumberedList")]
                       | Bool
isBulletList Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
subListParName Text -> Text -> Bool
`Text.isInfixOf` Text
s)
                           = [(Text
"BulletsAndNumberingListType", Text
"BulletList")]
                       | Bool
otherwise = []
              indent :: [(Text, Text)]
indent = [(Text
"LeftIndent", Int -> Text
forall a. Show a => a -> Text
tshow Int
indt)]
                where
                  nBlockQuotes :: Int
nBlockQuotes = Text -> Text -> Int
countSubStrs Text
blockQuoteName Text
s
                  nDefLists :: Int
nDefLists = Text -> Text -> Int
countSubStrs Text
defListDefName Text
s
                  indt :: Int
indt = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
defaultListIndentInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nBuls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nOrds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
defaultIndentInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nBlockQuotes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nDefLists)
          props :: Doc Text
props = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] (Doc Text
basedOn Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tabList Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
numbForm)
            where
              font :: Doc Text
font = if Text
codeBlockName Text -> Text -> Bool
`Text.isInfixOf` Text
s
                        then Doc Text
monospacedFont
                        else Doc Text
forall a. Doc a
empty
              basedOn :: Doc Text
basedOn = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BasedOn" [(Text
"type", Text
"object")] (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"$ID/NormalParagraphStyle") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
font
              tabList :: Doc Text
tabList = if Bool
isBulletList
                           then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"TabList" [(Text
"type",Text
"list")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ListItem" [(Text
"type",Text
"record")]
                                (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 [
                                    Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"Alignment" [(Text
"type",Text
"enumeration")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"LeftAlign"
                                  , Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"AlignmentCharacter" [(Text
"type",Text
"string")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"."
                                  , Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Leader" [(Text
"type",Text
"string")]
                                  , Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"Position" [(Text
"type",Text
"unit")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text
                                      (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
defaultListIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nBuls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nOrds)
                                  ]
                           else Doc Text
forall a. Doc a
empty
              makeNumb :: String -> Doc a
makeNumb String
name = Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"NumberingFormat" [(Text
"type", Text
"string")] (String -> Doc a
forall a. HasChars a => String -> Doc a
text String
name)
              numbForm :: Doc Text
numbForm | Text -> Text -> Bool
Text.isInfixOf Text
lowerRomanName Text
s = String -> Doc Text
forall a. HasChars a => String -> Doc a
makeNumb String
"i, ii, iii, iv..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
upperRomanName Text
s = String -> Doc Text
forall a. HasChars a => String -> Doc a
makeNumb String
"I, II, III, IV..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
lowerAlphaName Text
s = String -> Doc Text
forall a. HasChars a => String -> Doc a
makeNumb String
"a, b, c, d..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
upperAlphaName Text
s = String -> Doc Text
forall a. HasChars a => String -> Doc a
makeNumb String
"A, B, C, D..."
                       | Bool
otherwise = Doc Text
forall a. Doc a
empty
      in  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ParagraphStyle" ([(Text
"Self", Text
"ParagraphStyle/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s), (Text
"Name", Text
s)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
attrs') Doc Text
props

-- | Convert a WriterState with its inline styles to the ICML listing of Character Styles.
charStylesToDoc :: WriterState -> Doc Text
charStylesToDoc :: WriterState -> Doc Text
charStylesToDoc WriterState
st = [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
$ (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
makeStyle ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toAscList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
inlineStyles WriterState
st
  where
    makeStyle :: Text -> Doc Text
makeStyle Text
s =
      let attrs :: [(Text, Text)]
attrs = ((Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, (Text, Text))] -> [(Text, Text)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> (Text, (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
contains Text
s) [] [
                               (Text
strikeoutName,   (Text
"StrikeThru", Text
"true"))
                             , (Text
superscriptName, (Text
"Position", Text
"Superscript"))
                             , (Text
subscriptName,   (Text
"Position", Text
"Subscript"))
                             , (Text
smallCapsName,   (Text
"Capitalization", Text
"SmallCaps"))
                             ]
          attrs' :: [(Text, Text)]
attrs' | Text -> Text -> Bool
Text.isInfixOf Text
emphName Text
s Bool -> Bool -> Bool
&& Text -> Text -> Bool
Text.isInfixOf Text
strongName Text
s
                                               = (Text
"FontStyle", Text
"Bold Italic") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Text -> Text -> Bool
Text.isInfixOf Text
strongName Text
s = (Text
"FontStyle", Text
"Bold") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Text -> Text -> Bool
Text.isInfixOf Text
emphName Text
s   = (Text
"FontStyle", Text
"Italic") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Bool
otherwise                   = [(Text, Text)]
attrs
          props :: Doc Text
props = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
                    Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BasedOn" [(Text
"type", Text
"object")] (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"$ID/NormalCharacterStyle") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
font
                  where
                    font :: Doc Text
font =
                      if Text
codeName Text -> Text -> Bool
`Text.isInfixOf` Text
s
                         then Doc Text
monospacedFont
                         else Doc Text
forall a. Doc a
empty
      in  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyle" ([(Text
"Self", Text
"CharacterStyle/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s), (Text
"Name", Text
s)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
attrs') Doc Text
props

-- | Escape colon characters as %3a
escapeColons :: Text -> Text
escapeColons :: Text -> Text
escapeColons Text
txt = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
":" Text
"%3a" Text
txt

-- | figure out the link destination for a given URL
-- | HyperlinkURLDestination with more than one colon crashes CS6
makeDest :: Text -> Doc Text
makeDest :: Text -> Doc Text
makeDest Text
txt = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
  if Text
"#" Text -> Text -> Bool
`Text.isPrefixOf` Text
txt
  then Text
"HyperlinkTextDestination/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
escTxt
  else Text
"HyperlinkURLDestination/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
escTxt
  where
    escTxt :: Text
escTxt = Text -> Text
escapeColons (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
txt

-- | Convert a list of (identifier, url) pairs to the ICML listing of hyperlinks.
hyperlinksToDoc :: Hyperlink -> Doc Text
hyperlinksToDoc :: Hyperlink -> Doc Text
hyperlinksToDoc []     = Doc Text
forall a. Doc a
empty
hyperlinksToDoc ((Int, Text)
x:Hyperlink
xs) = (Int, Text) -> Doc Text
forall {a}. Show a => (a, Text) -> Doc Text
hyp (Int, Text)
x Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Hyperlink -> Doc Text
hyperlinksToDoc Hyperlink
xs
  where
    hyp :: (a, Text) -> Doc Text
hyp (a
ident, Text
url) = Doc Text
hdest Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
hlink
      where
        hdest :: Doc Text
hdest = if Text
"#" Text -> Text -> Bool
`Text.isPrefixOf` Text
url
                then Doc Text
forall a. Doc a
empty
                else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"HyperlinkURLDestination"
                  [(Text
"Self", Text
"HyperlinkURLDestination/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text -> Text
escapeColons Text
url), (Text
"Name",Text
"link"), (Text
"DestinationURL",Text
url), (Text
"DestinationUniqueKey",Text
"1")] -- HyperlinkURLDestination with more than one colon crashes CS6
        hlink :: Doc Text
hlink = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Hyperlink" [(Text
"Self",Text
"uf-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>a -> Text
forall a. Show a => a -> Text
tshow a
ident),  (Text
"Name",Text
url),
                    (Text
"Source",Text
"htss-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>a -> Text
forall a. Show a => a -> Text
tshow a
ident), (Text
"Visible",Text
"false"), (Text
"DestinationUniqueKey",Text
"1")]
                  (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" []
                  (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BorderColor" [(Text
"type",Text
"enumeration")] (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"Black")
                 Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"Destination" [(Text
"type",Text
"object")] (Text -> Doc Text
makeDest Text
url)

-- | Key for specifying user-defined styles
dynamicStyleKey :: Text
dynamicStyleKey :: Text
dynamicStyleKey = Text
"custom-style"

-- | Convert a list of Pandoc blocks to ICML.
blocksToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts [Text]
style [Block]
lst = do
  [Doc Text]
docs <- (Block -> WS m (Doc Text))
-> [Block] -> 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 (WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
style) [Block]
lst
  Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs [Doc Text]
docs

-- | Convert a Pandoc block element to ICML.
blockToICML :: PandocMonad m => WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
style (Plain [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts [Text]
style Text
"" [Inline]
lst
blockToICML WriterOptions
opts [Text]
style (Para [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
paragraphNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" [Inline]
lst
blockToICML WriterOptions
opts [Text]
style (LineBlock [[Inline]]
lns) =
  WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
style (Block -> WS m (Doc Text)) -> Block -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToICML WriterOptions
opts [Text]
style (CodeBlock Attr
_ Text
str) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
codeBlockNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" [Text -> Inline
Str Text
str]
blockToICML WriterOptions
_ [Text]
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"icml" = Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise          = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToICML WriterOptions
opts [Text]
style (BlockQuote [Block]
blocks) = WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts (Text
blockQuoteNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) [Block]
blocks
blockToICML WriterOptions
opts [Text]
style (OrderedList ListAttributes
attribs [[Block]]
lst) = WriterOptions
-> Text
-> [Text]
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text
-> [Text]
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
opts Text
orderedListName [Text]
style (ListAttributes -> Maybe ListAttributes
forall a. a -> Maybe a
Just ListAttributes
attribs) [[Block]]
lst
blockToICML WriterOptions
opts [Text]
style (BulletList [[Block]]
lst) = WriterOptions
-> Text
-> [Text]
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text
-> [Text]
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
opts Text
bulletListName [Text]
style Maybe ListAttributes
forall a. Maybe a
Nothing [[Block]]
lst
blockToICML WriterOptions
opts [Text]
style (DefinitionList [([Inline], [[Block]])]
lst) = [Doc Text] -> Doc Text
intersperseBrs ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WS m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([Inline], [[Block]]) -> WS m (Doc Text))
-> [([Inline], [[Block]])] -> 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 (WriterOptions -> [Text] -> ([Inline], [[Block]]) -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> ([Inline], [[Block]]) -> WS m (Doc Text)
definitionListItemToICML WriterOptions
opts [Text]
style) [([Inline], [[Block]])]
lst
blockToICML WriterOptions
opts [Text]
style (Header Int
lvl (Text
ident, [Text]
cls, [(Text, Text)]
_) [Inline]
lst) =
  let stl :: [Text]
stl = (Text
headerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lvl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unnumbered)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style
      unnumbered :: Text
unnumbered = if Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
                   then Text
" (unnumbered)"
                   else Text
""
  in WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts [Text]
stl Text
ident [Inline]
lst
blockToICML WriterOptions
_ [Text]
_ Block
HorizontalRule = Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- we could insert a page break instead
blockToICML WriterOptions
opts [Text]
style (Table Attr
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) =
        Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
      style' :: [Text]
style' = Text
tableName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
style
      noHeader :: Bool
noHeader  = ([Block] -> Bool) -> [[Block]] -> 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 [[Block]]
headers
      nrHeaders :: Text
nrHeaders = if Bool
noHeader
                     then Text
"0"
                     else Text
"1"
      nrRows :: Int
nrRows = [[[Block]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Block]]]
rows
      nrCols :: Int
nrCols = if [[[Block]]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[Block]]]
rows
                  then Int
0
                  else [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Block]] -> Int) -> [[Block]] -> Int
forall a b. (a -> b) -> a -> b
$ [[[Block]]] -> [[Block]]
forall a. HasCallStack => [a] -> a
head [[[Block]]]
rows
      rowsToICML :: [[[Block]]] -> t -> StateT WriterState m (Doc Text)
rowsToICML [] t
_ = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
      rowsToICML ([[Block]]
col:[[[Block]]]
rest) t
rowNr =
        (Doc Text -> Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) ([[Block]]
-> [Alignment] -> t -> Int -> StateT WriterState m (Doc Text)
forall {m :: * -> *} {t} {t}.
(PandocMonad m, Eq t, Num t, Num t, Show t, Show t) =>
[[Block]]
-> [Alignment] -> t -> t -> StateT WriterState m (Doc Text)
colsToICML [[Block]]
col [Alignment]
aligns t
rowNr (Int
0::Int)) (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[[Block]]] -> t -> StateT WriterState m (Doc Text)
rowsToICML [[[Block]]]
rest (t
rowNrt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
      colsToICML :: [[Block]]
-> [Alignment] -> t -> t -> StateT WriterState m (Doc Text)
colsToICML [] [Alignment]
_ t
_ t
_ = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
      colsToICML [[Block]]
_ [] t
_ t
_ = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
      colsToICML ([Block]
cell:[[Block]]
rest) (Alignment
alig:[Alignment]
restAligns) t
rowNr t
colNr = do
        let stl :: [Text]
stl  = if t
rowNr t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
noHeader
                      then Text
tableHeaderNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style'
                      else [Text]
style'
            stl' :: [Text]
stl' | Alignment
alig Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft = Text
alignLeftName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
stl
                 | Alignment
alig Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight = Text
alignRightName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
stl
                 | Alignment
alig Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter = Text
alignCenterName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
stl
                 | Bool
otherwise = [Text]
stl
        Doc Text
c <- WriterOptions
-> [Text] -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts [Text]
stl' [Block]
cell
        let cl :: StateT WriterState m (Doc Text)
cl = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Cell"
                   [(Text
"Name", t -> Text
forall a. Show a => a -> Text
tshow t
colNr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
":"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> t -> Text
forall a. Show a => a -> Text
tshow t
rowNr), (Text
"AppliedCellStyle",Text
"CellStyle/Cell")] Doc Text
c
        (Doc Text -> Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) StateT WriterState m (Doc Text)
cl (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Block]]
-> [Alignment] -> t -> t -> StateT WriterState m (Doc Text)
colsToICML [[Block]]
rest [Alignment]
restAligns t
rowNr (t
colNrt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
  in  do
      let tabl :: [[[Block]]]
tabl = if Bool
noHeader
                    then [[[Block]]]
rows
                    else [[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows
      Doc Text
cells <- [[[Block]]] -> Int -> WS m (Doc Text)
forall {m :: * -> *} {t}.
(PandocMonad m, Eq t, Num t, Show t) =>
[[[Block]]] -> t -> StateT WriterState m (Doc Text)
rowsToICML [[[Block]]]
tabl (Int
0::Int)
      let colWidths :: a -> [(a, Text)]
colWidths a
w =
            [(a
"SingleColumnWidth",a -> Text
forall a. Show a => a -> Text
tshow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ a
500 a -> a -> a
forall a. Num a => a -> a -> a
* a
w) | a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0]
      let tupToDoc :: (a, a) -> Doc a
tupToDoc (a, a)
tup = Text -> [(Text, Text)] -> Doc a
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Column" ([(Text, Text)] -> Doc a) -> [(Text, Text)] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Text
"Name",a -> Text
forall a. Show a => a -> Text
tshow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
tup) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: a -> [(Text, Text)]
forall {a} {a}.
(Ord a, IsString a, Show a, Num a) =>
a -> [(a, Text)]
colWidths ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
tup)
      let colDescs :: Doc Text
colDescs = [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
$ (Int -> Double -> Doc Text) -> [Int] -> [Double] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Int, Double) -> Doc Text) -> Int -> Double -> Doc Text
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int, Double) -> Doc Text
forall {a} {a} {a}.
(HasChars a, Ord a, Num a, Show a, Show a) =>
(a, a) -> Doc a
tupToDoc) [Int
0..Int
nrColsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Double]
widths
      let (Text
_,[Text]
_,[(Text, Text)]
kvs) = Attr
attr
      let dynamicStyle :: Text
dynamicStyle = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Table" (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs)
      let tableDoc :: WS m (Doc Text)
tableDoc = Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Table" [
                         (Text
"AppliedTableStyle",Text
"TableStyle/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dynamicStyle)
                       , (Text
"HeaderRowCount", Text
nrHeaders)
                       , (Text
"BodyRowCount", Int -> Text
forall a. Show a => a -> Text
tshow Int
nrRows)
                       , (Text
"ColumnCount", Int -> Text
forall a. Show a => a -> Text
tshow Int
nrCols)
                       ] (Doc Text
colDescs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells)
      (Doc Text -> Doc Text -> Doc Text)
-> WS m (Doc Text) -> WS m (Doc Text) -> WS m (Doc Text)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) WS m (Doc Text)
tableDoc (WS m (Doc Text) -> WS m (Doc Text))
-> WS m (Doc Text) -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
tableCaptionNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" [Inline]
caption
blockToICML WriterOptions
opts [Text]
style (Div (Text
_ident, [Text]
_, [(Text, Text)]
kvs) [Block]
lst) =
  let dynamicStyle :: [Text]
dynamicStyle = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs
  in  WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts ([Text]
dynamicStyle [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
style) [Block]
lst
blockToICML WriterOptions
opts [Text]
style (Figure Attr
attr capt :: Caption
capt@(Caption Maybe [Inline]
_ [Block]
longcapt) [Block]
body) =
  case [Block]
body of
    [Plain [img :: Inline
img@(Image {})]] -> do
      Doc Text
figure  <- WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
figureNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" [Inline
img]
      Doc Text
caption <- WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
imgCaptionNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" ([Inline] -> WS m (Doc Text)) -> [Inline] -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                 [Block] -> [Inline]
blocksToInlines [Block]
longcapt
      Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs [Doc Text
figure, Doc Text
caption]
    [Block]
_ -> -- fallback to rendering the figure as a Div
      WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
style (Block -> WS m (Doc Text)) -> Block -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body


-- | Convert a list of lists of blocks to ICML list items.
listItemsToICML :: PandocMonad m => WriterOptions -> Text -> Style -> Maybe ListAttributes -> [[Block]] -> WS m (Doc Text)
listItemsToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text
-> [Text]
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
_ Text
_ [Text]
_ Maybe ListAttributes
_ [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
listItemsToICML WriterOptions
opts Text
listType [Text]
style Maybe ListAttributes
attribs ([Block]
first:[[Block]]
rest) = do
  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st{ listDepth = 1 + listDepth st}
  let stl :: [Text]
stl = Text
listTypeText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style
  let f :: StateT WriterState m (Doc Text)
f = WriterOptions
-> [Text]
-> Bool
-> Maybe ListAttributes
-> [Block]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> [Text]
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts [Text]
stl Bool
True Maybe ListAttributes
attribs [Block]
first
  let r :: [StateT WriterState m (Doc Text)]
r = ([Block] -> StateT WriterState m (Doc Text))
-> [[Block]] -> [StateT WriterState m (Doc Text)]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions
-> [Text]
-> Bool
-> Maybe ListAttributes
-> [Block]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> [Text]
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts [Text]
stl Bool
False Maybe ListAttributes
attribs) [[Block]]
rest
  [Doc Text]
docs <- [StateT WriterState m (Doc Text)]
-> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT WriterState m (Doc Text)]
 -> StateT WriterState m [Doc Text])
-> [StateT WriterState m (Doc Text)]
-> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ StateT WriterState m (Doc Text)
fStateT WriterState m (Doc Text)
-> [StateT WriterState m (Doc Text)]
-> [StateT WriterState m (Doc Text)]
forall a. a -> [a] -> [a]
:[StateT WriterState m (Doc Text)]
r
  WriterState
s    <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  let maxD :: Int
maxD = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (WriterState -> Int
maxListDepth WriterState
s) (WriterState -> Int
listDepth WriterState
s)
  WriterState -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
s{ listDepth = 1, maxListDepth = maxD }
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs [Doc Text]
docs

-- | Convert a list of blocks to ICML list items.
listItemToICML :: PandocMonad m => WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS m (Doc Text)
listItemToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> [Text]
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts [Text]
style Bool
isFirst Maybe ListAttributes
attribs [Block]
item =
  let makeNumbStart :: Maybe (a, ListNumberStyle, c) -> [Text]
makeNumbStart (Just (a
beginsWith, ListNumberStyle
numbStl, c
_)) =
        let doN :: ListNumberStyle -> [Text]
doN ListNumberStyle
DefaultStyle = []
            doN ListNumberStyle
LowerRoman   = [Text
lowerRomanName]
            doN ListNumberStyle
UpperRoman   = [Text
upperRomanName]
            doN ListNumberStyle
LowerAlpha   = [Text
lowerAlphaName]
            doN ListNumberStyle
UpperAlpha   = [Text
upperAlphaName]
            doN ListNumberStyle
_            = []
            bw :: [Text]
bw =
              [Text
beginsWithName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
beginsWith | a
beginsWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1]
        in  ListNumberStyle -> [Text]
doN ListNumberStyle
numbStl [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
bw
      makeNumbStart Maybe (a, ListNumberStyle, c)
Nothing = []
      stl :: [Text]
stl = if Bool
isFirst
               then Text
firstListItemNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style
               else [Text]
style
      stl' :: [Text]
stl' = Maybe ListAttributes -> [Text]
forall {a} {c}.
(Ord a, Num a, Show a) =>
Maybe (a, ListNumberStyle, c) -> [Text]
makeNumbStart Maybe ListAttributes
attribs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
stl
  in  if [Block] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
item Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
         then do
           let insertTab :: Block -> WS m (Doc Text)
insertTab (Para [Inline]
lst) = WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
subListParNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) (Block -> WS m (Doc Text)) -> Block -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
"\t"Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
lst
               insertTab Block
block      = WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
style Block
block
           Doc Text
f <- WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts [Text]
stl' (Block -> WS m (Doc Text)) -> Block -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
forall a. HasCallStack => [a] -> a
head [Block]
item
           [Doc Text]
r <- (Block -> WS m (Doc Text))
-> [Block] -> 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 -> WS m (Doc Text)
forall {m :: * -> *}. PandocMonad m => Block -> WS m (Doc Text)
insertTab ([Block] -> StateT WriterState m [Doc Text])
-> [Block] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
forall a. HasCallStack => [a] -> [a]
tail [Block]
item
           Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs (Doc Text
f Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
r)
         else WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts [Text]
stl' [Block]
item

definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text)
definitionListItemToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> ([Inline], [[Block]]) -> WS m (Doc Text)
definitionListItemToICML WriterOptions
opts [Text]
style ([Inline]
term,[[Block]]
defs) = do
  Doc Text
term' <- WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
defListTermNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
"" [Inline]
term
  [Doc Text]
defs' <- ([Block] -> WS m (Doc Text))
-> [[Block]] -> 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 (WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts (Text
defListDefNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style)) [[Block]]
defs
  Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs (Doc Text
term' Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
defs')


-- | Convert a list of inline elements to ICML.
inlinesToICML :: PandocMonad m => WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts [Text]
style Text
ident [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Inline -> StateT WriterState m (Doc Text))
-> [Inline] -> 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 (WriterOptions
-> [Text] -> Text -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
opts [Text]
style Text
ident) (WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts [Inline]
lst)

-- | Convert an inline element to ICML.
inlineToICML :: PandocMonad m => WriterOptions -> Style -> Text -> Inline -> WS m (Doc Text)
inlineToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
_    [Text]
style Text
ident (Str Text
str) = [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToICML WriterOptions
opts [Text]
style Text
ident (Emph [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
emphNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Underline [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
underlineNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Strong [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
strongNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Strikeout [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
strikeoutNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Superscript [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
superscriptNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Subscript [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
subscriptNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (SmallCaps [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
smallCapsNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts [Text]
style Text
ident (Quoted QuoteType
SingleQuote [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts [Text]
style Text
ident ([Inline] -> WS m (Doc Text)) -> [Inline] -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
"‘"] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"’"]
inlineToICML WriterOptions
opts [Text]
style Text
ident (Quoted QuoteType
DoubleQuote [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts [Text]
style Text
ident ([Inline] -> WS m (Doc Text)) -> [Inline] -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
"“"] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
lst [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"”"]
inlineToICML WriterOptions
opts [Text]
style Text
ident (Cite [Citation]
_ [Inline]
lst) = WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
citeNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
_    [Text]
style Text
ident (Code Attr
_ Text
str) = [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle (Text
codeNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToICML WriterOptions
_    [Text]
style Text
ident Inline
Space = [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident Doc Text
forall a. Doc a
space
inlineToICML WriterOptions
opts [Text]
style Text
ident Inline
SoftBreak =
  case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
       WrapOption
WrapAuto     -> [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident Doc Text
forall a. Doc a
space
       WrapOption
WrapNone     -> [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident Doc Text
forall a. Doc a
space
       WrapOption
WrapPreserve -> [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident Doc Text
forall a. Doc a
cr
inlineToICML WriterOptions
_ [Text]
style Text
ident Inline
LineBreak = [Text] -> Text -> Doc Text -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
lineSeparator
inlineToICML WriterOptions
opts [Text]
style Text
ident (Math MathType
mt Text
str) =
  m [Inline] -> StateT WriterState m [Inline]
forall (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
mt Text
str) StateT WriterState m [Inline]
-> ([Inline] -> WS m (Doc Text)) -> WS m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> WS m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (StateT WriterState m [Doc Text] -> WS m (Doc Text))
-> ([Inline] -> StateT WriterState m [Doc Text])
-> [Inline]
-> WS m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> WS m (Doc Text))
-> [Inline] -> 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 (WriterOptions -> [Text] -> Text -> Inline -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
opts [Text]
style Text
ident))
inlineToICML WriterOptions
_ [Text]
_ Text
_ il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"icml" = Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise          = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToICML WriterOptions
opts [Text]
style Text
ident (Link Attr
_ [Inline]
lst (Text
url, Text
title)) = do
  Doc Text
content <- WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
linkNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Text
ident [Inline]
lst
  (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a.
(WriterState -> (a, WriterState)) -> StateT WriterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text))
-> (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ \WriterState
st ->
            let link_id :: Int
link_id = if Hyperlink -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Hyperlink -> Bool) -> Hyperlink -> Bool
forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st
                            then Int
1::Int
                            else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Text) -> Int
forall a b. (a, b) -> a
fst (Hyperlink -> (Int, Text)
forall a. HasCallStack => [a] -> a
head (Hyperlink -> (Int, Text)) -> Hyperlink -> (Int, Text)
forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st)
                newst :: WriterState
newst = WriterState
st{ links = (link_id, url):links st }
                cont :: Doc Text
cont  = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"HyperlinkTextSource"
                         [(Text
"Self",Text
"htss-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Int -> Text
forall a. Show a => a -> Text
tshow Int
link_id), (Text
"Name",Text
title), (Text
"Hidden",Text
"false")] Doc Text
content
            in  (Doc Text
cont, WriterState
newst)
inlineToICML WriterOptions
opts [Text]
style Text
_ident (Image Attr
attr [Inline]
_ (Text, Text)
target) = WriterOptions -> [Text] -> Attr -> (Text, Text) -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Attr -> (Text, Text) -> WS m (Doc Text)
imageICML WriterOptions
opts [Text]
style Attr
attr (Text, Text)
target
inlineToICML WriterOptions
opts [Text]
style Text
_ (Note [Block]
lst) = WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
footnoteToICML WriterOptions
opts [Text]
style [Block]
lst
inlineToICML WriterOptions
opts [Text]
style Text
_ (Span (Text
ident, [Text]
_, [(Text, Text)]
kvs) [Inline]
lst) =
  let dynamicStyle :: [Text]
dynamicStyle = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs
  in  WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts ([Text]
dynamicStyle [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
style) Text
ident [Inline]
lst
-- ident will be the id of the span, that we need to use down in the hyperlink setter
--  if T.null ident
--     then
--     else do

-- | Convert a list of block elements to an ICML footnote.
footnoteToICML :: PandocMonad m => WriterOptions -> Style -> [Block] -> WS m (Doc Text)
footnoteToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Block] -> WS m (Doc Text)
footnoteToICML WriterOptions
opts [Text]
style [Block]
lst =
  let insertTab :: Block -> WS m (Doc Text)
insertTab (Para [Inline]
ls) = WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
footnoteNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) (Block -> WS m (Doc Text)) -> Block -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
"\t"Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ls
      insertTab Block
block     = WriterOptions -> [Text] -> Block -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
footnoteNameText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
style) Block
block
  in  do
    [Doc Text]
contents <- (Block -> WS m (Doc Text))
-> [Block] -> 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 -> WS m (Doc Text)
forall {m :: * -> *}. PandocMonad m => Block -> WS m (Doc Text)
insertTab [Block]
lst
    let number :: Doc Text
number = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ParagraphStyleRange" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
                   Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" Doc Text
"<?ACE 4?>"
    Doc Text -> WS m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> WS m (Doc Text)) -> Doc Text -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange"
      [(Text
"AppliedCharacterStyle",Text
"$ID/NormalCharacterStyle"), (Text
"Position",Text
"Superscript")]
      (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Footnote" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
number Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
intersperseBrs [Doc Text]
contents

-- | Auxiliary function to merge Space elements into the adjacent Strs.
mergeStrings :: WriterOptions -> [Inline] -> [Inline]
mergeStrings :: WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts = [Inline] -> [Inline]
mergeStrings' ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
spaceToStr
  where spaceToStr :: Inline -> Inline
spaceToStr Inline
Space = Text -> Inline
Str Text
" "
        spaceToStr Inline
SoftBreak = case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
                                    WrapOption
WrapPreserve  -> Text -> Inline
Str Text
"\n"
                                    WrapOption
_             -> Text -> Inline
Str Text
" "
        spaceToStr Inline
x = Inline
x

        mergeStrings' :: [Inline] -> [Inline]
mergeStrings' (Str Text
x : Str Text
y : [Inline]
zs) = [Inline] -> [Inline]
mergeStrings' (Text -> Inline
Str (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
zs)
        mergeStrings' (Inline
x : [Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
mergeStrings' [Inline]
xs
        mergeStrings' []       = []

-- | Intersperse line breaks
intersperseBrs :: [Doc Text] -> Doc Text
intersperseBrs :: [Doc Text] -> Doc Text
intersperseBrs = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Br" []) ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty)

-- | Wrap a list of inline elements in an ICML Paragraph Style
parStyle :: PandocMonad m => WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts [Text]
style Text
ident [Inline]
lst =
  let slipIn :: Text -> Text -> Text
slipIn Text
x Text
y = if Text -> Bool
Text.null Text
y
                      then Text
x
                      else Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" > " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
      stlStr :: Text
stlStr = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Text -> Text
slipIn Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
style
      stl :: Text
stl    = if Text -> Bool
Text.null Text
stlStr
                  then Text
""
                  else Text
"ParagraphStyle/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stlStr
      attrs :: (Text, Text)
attrs  = (Text
"AppliedParagraphStyle", Text
stl)
      attrs' :: [(Text, Text)]
attrs' =  if Text
firstListItemName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
style
                   then let ats :: [(Text, Text)]
ats = (Text, Text)
attrs (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text
"NumberingContinue", Text
"false")]
                            begins :: [Text]
begins = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Text.isPrefixOf Text
beginsWithName) [Text]
style
                        in  if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
begins
                               then [(Text, Text)]
ats
                               else let i :: Text
i = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripPrefix Text
beginsWithName
                                                         (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
begins
                                    in  (Text
"NumberingStartAt", Text
i) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
ats
                   else [(Text, Text)
attrs]
  in  do
      Doc Text
content <- WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts [] Text
ident [Inline]
lst
      let cont :: Doc Text
cont = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ParagraphStyleRange" [(Text, Text)]
attrs' Doc Text
content
      (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a.
(WriterState -> (a, WriterState)) -> StateT WriterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text))
-> (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> (Doc Text
cont, WriterState
st{ blockStyles = Set.insert stlStr $ blockStyles st })

-- | Create the destination name
makeDestName :: Text -> Text
makeDestName :: Text -> Text
makeDestName Text
name = Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
" " Text
"-" Text
name

-- | Create a HyperlinkTextDestination for a given identifier
makeLinkDest :: Text -> Doc Text -> Doc Text
makeLinkDest :: Text -> Doc Text -> Doc Text
makeLinkDest Text
ident Doc Text
cont = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [
    Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"HyperlinkTextDestination"
      [(Text
"Self", Text
"HyperlinkTextDestination/"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text -> Text
makeDestName Text
ident), (Text
"Name",Text
"Destination"), (Text
"DestinationUniqueKey",Text
"1")]
    , Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" (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
flush Doc Text
cont
  ]

-- | Create the markup for the content (incl. named destinations)
-- |  NOTE: since we have no easy way to get actual named dests, we just create them for any short content blocks
makeContent :: Text -> Doc Text -> Doc Text
makeContent :: Text -> Doc Text -> Doc Text
makeContent Text
ident Doc Text
cont
              | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
cont = Doc Text
forall a. Doc a
empty
              | Bool -> Bool
not (Text -> Bool
Text.null Text
ident) = Text -> Doc Text -> Doc Text
makeLinkDest Text
ident Doc Text
cont
              | Bool
otherwise = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" (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
flush Doc Text
cont

-- | Wrap a Doc in an ICML Character Style.
charStyle :: PandocMonad m => Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle :: forall (m :: * -> *).
PandocMonad m =>
[Text] -> Text -> Doc Text -> WS m (Doc Text)
charStyle [Text]
style Text
ident Doc Text
content =
  let (Text
stlStr, [(Text, Text)]
attrs) = [Text] -> (Text, [(Text, Text)])
styleToStrAttr [Text]
style
      doc :: Doc Text
doc = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [(Text, Text)]
attrs
              (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
makeContent Text
ident Doc Text
content
  in
      (WriterState -> (Doc Text, WriterState))
-> StateT WriterState m (Doc Text)
forall a.
(WriterState -> (a, WriterState)) -> StateT WriterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((WriterState -> (Doc Text, WriterState))
 -> StateT WriterState m (Doc Text))
-> (WriterState -> (Doc Text, WriterState))
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ \WriterState
st ->
    let styles :: WriterState
styles = if Text -> Bool
Text.null Text
stlStr
                    then WriterState
st
                    else WriterState
st{ inlineStyles = Set.insert stlStr $ inlineStyles st }
    in  (Doc Text
doc, WriterState
styles)

-- | Transform a Style to a tuple of String (eliminating duplicates and ordered) and corresponding attribute.
styleToStrAttr :: Style -> (Text, [(Text, Text)])
styleToStrAttr :: [Text] -> (Text, [(Text, Text)])
styleToStrAttr [Text]
style =
  let stlStr :: Text
stlStr = [Text] -> Text
Text.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
Set.toAscList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
style
      stl :: Text
stl    = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
style
                  then Text
"$ID/NormalCharacterStyle"
                  else Text
"CharacterStyle/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stlStr
      attrs :: [(Text, Text)]
attrs = [(Text
"AppliedCharacterStyle", Text
stl)]
  in  (Text
stlStr, [(Text, Text)]
attrs)

-- | Assemble an ICML Image.
imageICML :: PandocMonad m => WriterOptions -> Style -> Attr -> Target -> WS m (Doc Text)
imageICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Attr -> (Text, Text) -> WS m (Doc Text)
imageICML WriterOptions
opts [Text]
style Attr
attr (Text
src, Text
_) = do
  ImageSize
imgS <- StateT WriterState m ImageSize
-> (PandocError -> StateT WriterState m ImageSize)
-> StateT WriterState m ImageSize
forall a.
StateT WriterState m a
-> (PandocError -> StateT WriterState m a)
-> StateT WriterState m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
          (do (ByteString
img, Maybe Text
_) <- Text -> StateT WriterState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
              case WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
img of
                Right ImageSize
size -> ImageSize -> StateT WriterState m ImageSize
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize
size
                Left Text
msg   -> do
                  LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotDetermineImageSize Text
src Text
msg
                  ImageSize -> StateT WriterState m ImageSize
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize
forall a. Default a => a
def)
           (\PandocError
e -> do
               LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ PandocError -> Text
forall a. Show a => a -> Text
tshow PandocError
e
               ImageSize -> StateT WriterState m ImageSize
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize
forall a. Default a => a
def)
  let (Double
ow, Double
oh) = ImageSize -> (Double, Double)
sizeInPoints ImageSize
imgS
      (Double
imgWidth, Double
imgHeight) = WriterOptions -> Attr -> ImageSize -> (Double, Double)
desiredSizeInPoints WriterOptions
opts Attr
attr ImageSize
imgS
      hw :: Text
hw = Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
ow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      hh :: Text
hh = Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
oh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      scale :: Text
scale = Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
imgWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ow) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 0 0 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
imgHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
oh)
      src' :: Text
src' = if Text -> Bool
isURI Text
src then Text
src else Text
"file:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src
      (Text
stlStr, [(Text, Text)]
attrs) = [Text] -> (Text, [(Text, Text)])
styleToStrAttr [Text]
style
      props :: Doc Text
props  = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"PathGeometry" []
                 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"GeometryPathType" [(Text
"PathOpen",Text
"false")]
                 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"PathPointArray" []
                 (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 [
                     Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
"-"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   ]

      isdata :: Bool
isdata = Text
"data:" Text -> Text -> Bool
`Text.isPrefixOf` Text
src' Bool -> Bool -> Bool
&& Text
"base64," Text -> Text -> Bool
`Text.isInfixOf` Text
src'
      contents :: Doc Text
contents =
            if Bool
isdata
               then -- see #8398
                  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Contents" [] (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
"<![CDATA[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"%20" Text
""
                            (Int -> Text -> Text
Text.drop Int
1 ((Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') Text
src')) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]>")
               else Doc Text
forall a. Monoid a => a
mempty
      link :: Doc Text
link = if Bool
isdata
                then Doc Text
forall a. Monoid a => a
mempty
                else  Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Link" [(Text
"Self", Text
"ueb"),
                                             (Text
"LinkResourceURI", Text
src')]
      image :: Doc Text
image  = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Image"
                   [(Text
"Self",Text
"ue6"), (Text
"ItemTransform", Text
scaleText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                 (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 [
                     Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] (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 [
                         Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Profile" [(Text
"type",Text
"string")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"$ID/Embedded"
                       , Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"GraphicBounds" [(Text
"Left",Text
"0"), (Text
"Top",Text
"0")
                         , (Text
"Right",  Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
owDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ow Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
imgWidth)
                         , (Text
"Bottom", Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
ohDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
oh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
imgHeight)]
                       , Doc Text
contents
                       ]
                   , Doc Text
link
                   ]
      doc :: Doc Text
doc    = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [(Text, Text)]
attrs
                 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Rectangle" [(Text
"Self",Text
"uec"), (Text
"StrokeWeight", Text
"0"),
                     (Text
"ItemTransform", Text
scaleText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hwText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" -"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
hh)] (Doc Text
props Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
image)
  (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a.
(WriterState -> (a, WriterState)) -> StateT WriterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text))
-> (WriterState -> (Doc Text, WriterState)) -> WS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> (Doc Text
doc, WriterState
st{ inlineStyles = Set.insert stlStr $ inlineStyles st } )