{-# 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  = forall a. Set a
Set.empty
  , inlineStyles :: Set Text
inlineStyles = 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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
      renderBlockMeta :: (WriterOptions -> [a] -> t -> StateT WriterState f b) -> t -> f b
renderBlockMeta WriterOptions -> [a] -> t -> StateT WriterState f b
f t
s = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
             (forall {f :: * -> *} {a} {t} {b}.
Functor f =>
(WriterOptions -> [a] -> t -> StateT WriterState f b) -> t -> f b
renderBlockMeta forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML)
             (forall {f :: * -> *} {t} {a} {t} {b}.
(Functor f, IsString t) =>
(WriterOptions -> [a] -> t -> t -> StateT WriterState f b)
-> t -> f b
renderInlineMeta forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML)
             Meta
meta
  (Doc Text
main, WriterState
st) <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts [] [Block]
blocks) WriterState
defaultWriterState
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"charStyles" (WriterState -> Doc Text
charStylesToDoc WriterState
st)
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"parStyles"  (WriterState -> Doc Text
parStylesToDoc WriterState
st)
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"hyperlinks" (Hyperlink -> Doc Text
hyperlinksToDoc forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st) Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Auxiliary functions for parStylesToDoc and charStylesToDoc.
contains :: Text -> (Text, (Text, Text)) -> [(Text, Text)]
contains :: Text -> (Text, (Text, Text)) -> [(Text, Text)]
contains Text
s (Text, (Text, Text))
rule =
  [forall a b. (a, b) -> b
snd (Text, (Text, Text))
rule | forall a b. (a, b) -> a
fst (Text, (Text, Text))
rule Text -> Text -> Bool
`Text.isInfixOf` Text
s]

-- | The monospaced font to use as default.
monospacedFont :: Doc Text
monospacedFont :: Doc Text
monospacedFont = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"AppliedFont" [(Text
"type", Text
"string")] forall a b. (a -> b) -> a -> b
$ 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 = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
makeStyle forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toAscList 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Text -> Text -> [(Text, Text)]
Text.breakOnAll Text
sub Text
str
          attrs :: [(Text, Text)]
attrs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (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
headerNameforall a. Semigroup a => a -> a -> a
<>Text
"1", (Text
"PointSize", Text
"36"))
                             , (Text
headerNameforall a. Semigroup a => a -> a -> a
<>Text
"2", (Text
"PointSize", Text
"30"))
                             , (Text
headerNameforall a. Semigroup a => a -> a -> a
<>Text
"3", (Text
"PointSize", Text
"24"))
                             , (Text
headerNameforall a. Semigroup a => a -> a -> a
<>Text
"4", (Text
"PointSize", Text
"18"))
                             , (Text
headerNameforall 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) = Style -> (Bool, Bool)
findList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Style
splitTextBy (forall a. Eq a => a -> a -> Bool
==Char
' ') Text
s
            where
              findList :: Style -> (Bool, Bool)
findList [] = (Bool
False, Bool
False)
              findList (Text
x:Style
xs) | Text
x forall a. Eq a => a -> a -> Bool
== Text
bulletListName  = (Bool
True, Bool
False)
                              | Text
x forall a. Eq a => a -> a -> Bool
== Text
orderedListName = (Bool
False, Bool
True)
                              | Bool
otherwise = Style -> (Bool, Bool)
findList Style
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 forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
listType forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
indent forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
attrs
            where
              numbering :: [(Text, Text)]
numbering | Bool
isOrderedList = [(Text
"NumberingExpression", Text
"^#.^t"), (Text
"NumberingLevel", 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", 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 = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
defaultListIndentforall a. Num a => a -> a -> a
*(Int
nBuls forall a. Num a => a -> a -> a
+ Int
nOrds forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
defaultIndentforall a. Num a => a -> a -> a
*(Int
nBlockQuotes forall a. Num a => a -> a -> a
+ Int
nDefLists)
          props :: Doc Text
props = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] (Doc Text
basedOn forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tabList 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 forall a. Doc a
empty
              basedOn :: Doc Text
basedOn = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BasedOn" [(Text
"type", Text
"object")] (forall a. HasChars a => String -> Doc a
text String
"$ID/NormalParagraphStyle") forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
font
              tabList :: Doc Text
tabList = if Bool
isBulletList
                           then forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"TabList" [(Text
"type",Text
"list")] forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ListItem" [(Text
"type",Text
"record")]
                                forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [
                                    forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"Alignment" [(Text
"type",Text
"enumeration")] forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"LeftAlign"
                                  , forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"AlignmentCharacter" [(Text
"type",Text
"string")] forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"."
                                  , forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Leader" [(Text
"type",Text
"string")]
                                  , forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"Position" [(Text
"type",Text
"unit")] forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text
                                      forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
defaultListIndent forall a. Num a => a -> a -> a
* (Int
nBuls forall a. Num a => a -> a -> a
+ Int
nOrds)
                                  ]
                           else forall a. Doc a
empty
              makeNumb :: String -> Doc a
makeNumb String
name = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"NumberingFormat" [(Text
"type", Text
"string")] (forall a. HasChars a => String -> Doc a
text String
name)
              numbForm :: Doc Text
numbForm | Text -> Text -> Bool
Text.isInfixOf Text
lowerRomanName Text
s = forall a. HasChars a => String -> Doc a
makeNumb String
"i, ii, iii, iv..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
upperRomanName Text
s = forall a. HasChars a => String -> Doc a
makeNumb String
"I, II, III, IV..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
lowerAlphaName Text
s = forall a. HasChars a => String -> Doc a
makeNumb String
"a, b, c, d..."
                       | Text -> Text -> Bool
Text.isInfixOf Text
upperAlphaName Text
s = forall a. HasChars a => String -> Doc a
makeNumb String
"A, B, C, D..."
                       | Bool
otherwise = forall a. Doc a
empty
      in  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ParagraphStyle" ([(Text
"Self", Text
"ParagraphStyle/"forall a. Semigroup a => a -> a -> a
<>Text
s), (Text
"Name", Text
s)] 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 = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
makeStyle forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toAscList 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (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") forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Text -> Text -> Bool
Text.isInfixOf Text
strongName Text
s = (Text
"FontStyle", Text
"Bold") forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Text -> Text -> Bool
Text.isInfixOf Text
emphName Text
s   = (Text
"FontStyle", Text
"Italic") forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
                 | Bool
otherwise                   = [(Text, Text)]
attrs
          props :: Doc Text
props = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] forall a b. (a -> b) -> a -> b
$
                    forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BasedOn" [(Text
"type", Text
"object")] (forall a. HasChars a => String -> Doc a
text String
"$ID/NormalCharacterStyle") 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 forall a. Doc a
empty
      in  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyle" ([(Text
"Self", Text
"CharacterStyle/"forall a. Semigroup a => a -> a -> a
<>Text
s), (Text
"Name", Text
s)] 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 = 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 = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$
  if Text
"#" Text -> Text -> Bool
`Text.isPrefixOf` Text
txt
  then Text
"HyperlinkTextDestination/" forall a. Semigroup a => a -> a -> a
<> Text
escTxt
  else Text
"HyperlinkURLDestination/" forall a. Semigroup a => a -> a -> a
<> Text
escTxt
  where
    escTxt :: Text
escTxt = Text -> Text
escapeColons 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 []     = forall a. Doc a
empty
hyperlinksToDoc ((Int, Text)
x:Hyperlink
xs) = forall {a}. Show a => (a, Text) -> Doc Text
hyp (Int, Text)
x 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 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 forall a. Doc a
empty
                else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"HyperlinkURLDestination"
                  [(Text
"Self", Text
"HyperlinkURLDestination/"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 = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Hyperlink" [(Text
"Self",Text
"uf-"forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> Text
tshow a
ident),  (Text
"Name",Text
url),
                    (Text
"Source",Text
"htss-"forall a. Semigroup a => a -> a -> a
<>forall a. Show a => a -> Text
tshow a
ident), (Text
"Visible",Text
"false"), (Text
"DestinationUniqueKey",Text
"1")]
                  forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" []
                  forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"BorderColor" [(Text
"type",Text
"enumeration")] (forall a. HasChars a => String -> Doc a
text String
"Black")
                 forall a. Doc a -> Doc a -> Doc a
$$ 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 -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts Style
style [Block]
lst = do
  [Doc Text]
docs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
style) [Block]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
style (Plain [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts Style
style Text
"" [Inline]
lst
blockToICML WriterOptions
opts Style
style (Para [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
paragraphNameforall a. a -> [a] -> [a]
:Style
style) Text
"" [Inline]
lst
blockToICML WriterOptions
opts Style
style (LineBlock [[Inline]]
lns) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
style forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToICML WriterOptions
opts Style
style (CodeBlock Attr
_ Text
str) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
codeBlockNameforall a. a -> [a] -> [a]
:Style
style) Text
"" [Text -> Inline
Str Text
str]
blockToICML WriterOptions
_ Style
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"icml" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise          = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToICML WriterOptions
opts Style
style (BlockQuote [Block]
blocks) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts (Text
blockQuoteNameforall a. a -> [a] -> [a]
:Style
style) [Block]
blocks
blockToICML WriterOptions
opts Style
style (OrderedList ListAttributes
attribs [[Block]]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text
-> Style
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
opts Text
orderedListName Style
style (forall a. a -> Maybe a
Just ListAttributes
attribs) [[Block]]
lst
blockToICML WriterOptions
opts Style
style (BulletList [[Block]]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Text
-> Style
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
opts Text
bulletListName Style
style forall a. Maybe a
Nothing [[Block]]
lst
blockToICML WriterOptions
opts Style
style (DefinitionList [([Inline], [[Block]])]
lst) = [Doc Text] -> Doc Text
intersperseBrs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> ([Inline], [[Block]]) -> WS m (Doc Text)
definitionListItemToICML WriterOptions
opts Style
style) [([Inline], [[Block]])]
lst
blockToICML WriterOptions
opts Style
style (Header Int
lvl (Text
ident, Style
cls, [(Text, Text)]
_) [Inline]
lst) =
  let stl :: Style
stl = (Text
headerName forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
lvl forall a. Semigroup a => a -> a -> a
<> Text
unnumbered)forall a. a -> [a] -> [a]
:Style
style
      unnumbered :: Text
unnumbered = if Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Style
cls
                   then Text
" (unnumbered)"
                   else Text
""
  in forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts Style
stl Text
ident [Inline]
lst
blockToICML WriterOptions
_ Style
_ Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty -- we could insert a page break instead
blockToICML WriterOptions
opts Style
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' :: Style
style' = Text
tableName forall a. a -> [a] -> [a]
: Style
style
      noHeader :: Bool
noHeader  = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Block]]]
rows
      nrCols :: Int
nrCols = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[Block]]]
rows
                  then Int
0
                  else forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [[[Block]]]
rows
      rowsToICML :: [[[Block]]] -> t -> StateT WriterState m (Doc Text)
rowsToICML [] t
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
      rowsToICML ([[Block]]
col:[[[Block]]]
rest) t
rowNr =
        forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Doc a -> Doc a -> Doc a
($$) (forall {m :: * -> *} {t} {t}.
(PandocMonad m, Num t, Eq 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)) forall a b. (a -> b) -> a -> b
$ [[[Block]]] -> t -> StateT WriterState m (Doc Text)
rowsToICML [[[Block]]]
rest (t
rowNrforall a. Num a => a -> a -> a
+t
1)
      colsToICML :: [[Block]]
-> [Alignment] -> t -> t -> StateT WriterState m (Doc Text)
colsToICML [] [Alignment]
_ t
_ t
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
      colsToICML [[Block]]
_ [] t
_ t
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
      colsToICML ([Block]
cell:[[Block]]
rest) (Alignment
alig:[Alignment]
restAligns) t
rowNr t
colNr = do
        let stl :: Style
stl  = if t
rowNr forall a. Eq a => a -> a -> Bool
== t
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
noHeader
                      then Text
tableHeaderNameforall a. a -> [a] -> [a]
:Style
style'
                      else Style
style'
            stl' :: Style
stl' | Alignment
alig forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft = Text
alignLeftName forall a. a -> [a] -> [a]
: Style
stl
                 | Alignment
alig forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight = Text
alignRightName forall a. a -> [a] -> [a]
: Style
stl
                 | Alignment
alig forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter = Text
alignCenterName forall a. a -> [a] -> [a]
: Style
stl
                 | Bool
otherwise = Style
stl
        Doc Text
c <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts Style
stl' [Block]
cell
        let cl :: StateT WriterState m (Doc Text)
cl = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Cell"
                   [(Text
"Name", forall a. Show a => a -> Text
tshow t
colNr forall a. Semigroup a => a -> a -> a
<>Text
":"forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow t
rowNr), (Text
"AppliedCellStyle",Text
"CellStyle/Cell")] Doc Text
c
        forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Doc a -> Doc a -> Doc a
($$) StateT WriterState m (Doc Text)
cl forall a b. (a -> b) -> a -> b
$ [[Block]]
-> [Alignment] -> t -> t -> StateT WriterState m (Doc Text)
colsToICML [[Block]]
rest [Alignment]
restAligns t
rowNr (t
colNrforall a. Num a => a -> a -> a
+t
1)
  in  do
      let tabl :: [[[Block]]]
tabl = if Bool
noHeader
                    then [[[Block]]]
rows
                    else [[Block]]
headersforall a. a -> [a] -> [a]
:[[[Block]]]
rows
      Doc Text
cells <- 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",forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ a
500 forall a. Num a => a -> a -> a
* a
w) | a
w forall a. Ord a => a -> a -> Bool
> a
0]
      let tupToDoc :: (a, a) -> Doc a
tupToDoc (a, a)
tup = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Column" forall a b. (a -> b) -> a -> b
$ (Text
"Name",forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (a, a)
tup) forall a. a -> [a] -> [a]
: forall {a} {a}.
(Ord a, Num a, IsString a, Show a) =>
a -> [(a, Text)]
colWidths (forall a b. (a, b) -> b
snd (a, a)
tup)
      let colDescs :: Doc Text
colDescs = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall {a} {a} {a}.
(HasChars a, Ord a, Num a, Show a, Show a) =>
(a, a) -> Doc a
tupToDoc) [Int
0..Int
nrColsforall a. Num a => a -> a -> a
-Int
1] [Double]
widths
      let (Text
_,Style
_,[(Text, Text)]
kvs) = Attr
attr
      let dynamicStyle :: Text
dynamicStyle = forall a. a -> Maybe a -> a
fromMaybe Text
"Table" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs)
      let tableDoc :: WS m (Doc Text)
tableDoc = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Table" [
                         (Text
"AppliedTableStyle",Text
"TableStyle/" forall a. Semigroup a => a -> a -> a
<> Text
dynamicStyle)
                       , (Text
"HeaderRowCount", Text
nrHeaders)
                       , (Text
"BodyRowCount", forall a. Show a => a -> Text
tshow Int
nrRows)
                       , (Text
"ColumnCount", forall a. Show a => a -> Text
tshow Int
nrCols)
                       ] (Doc Text
colDescs forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
cells)
      forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Doc a -> Doc a -> Doc a
($$) WS m (Doc Text)
tableDoc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
tableCaptionNameforall a. a -> [a] -> [a]
:Style
style) Text
"" [Inline]
caption
blockToICML WriterOptions
opts Style
style (Div (Text
_ident, Style
_, [(Text, Text)]
kvs) [Block]
lst) =
  let dynamicStyle :: Style
dynamicStyle = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs
  in  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts (Style
dynamicStyle forall a. Semigroup a => a -> a -> a
<> Style
style) [Block]
lst
blockToICML WriterOptions
opts Style
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  <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
figureNameforall a. a -> [a] -> [a]
:Style
style) Text
"" [Inline
img]
      Doc Text
caption <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
imgCaptionNameforall a. a -> [a] -> [a]
:Style
style) Text
"" forall a b. (a -> b) -> a -> b
$
                 [Block] -> [Inline]
blocksToInlines [Block]
longcapt
      forall (m :: * -> *) a. Monad m => a -> m a
return 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
      forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
style 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
-> Style
-> Maybe ListAttributes
-> [[Block]]
-> WS m (Doc Text)
listItemsToICML WriterOptions
_ Text
_ Style
_ Maybe ListAttributes
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
listItemsToICML WriterOptions
opts Text
listType Style
style Maybe ListAttributes
attribs ([Block]
first:[[Block]]
rest) = do
  WriterState
st <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
st{ listDepth :: Int
listDepth = Int
1 forall a. Num a => a -> a -> a
+ WriterState -> Int
listDepth WriterState
st}
  let stl :: Style
stl = Text
listTypeforall a. a -> [a] -> [a]
:Style
style
  let f :: WS m (Doc Text)
f = forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Style
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts Style
stl Bool
True Maybe ListAttributes
attribs [Block]
first
  let r :: [WS m (Doc Text)]
r = forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> Style
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts Style
stl Bool
False Maybe ListAttributes
attribs) [[Block]]
rest
  [Doc Text]
docs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ WS m (Doc Text)
fforall a. a -> [a] -> [a]
:[WS m (Doc Text)]
r
  WriterState
s    <- forall s (m :: * -> *). MonadState s m => m s
get
  let maxD :: Int
maxD = forall a. Ord a => a -> a -> a
max (WriterState -> Int
maxListDepth WriterState
s) (WriterState -> Int
listDepth WriterState
s)
  forall s (m :: * -> *). MonadState s m => s -> m ()
put WriterState
s{ listDepth :: Int
listDepth = Int
1, maxListDepth :: Int
maxListDepth = Int
maxD }
  forall (m :: * -> *) a. Monad m => a -> m a
return 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
-> Style
-> Bool
-> Maybe ListAttributes
-> [Block]
-> WS m (Doc Text)
listItemToICML WriterOptions
opts Style
style Bool
isFirst Maybe ListAttributes
attribs [Block]
item =
  let makeNumbStart :: Maybe (a, ListNumberStyle, c) -> Style
makeNumbStart (Just (a
beginsWith, ListNumberStyle
numbStl, c
_)) =
        let doN :: ListNumberStyle -> Style
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 :: Style
bw =
              [Text
beginsWithName forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
beginsWith | a
beginsWith forall a. Ord a => a -> a -> Bool
> a
1]
        in  ListNumberStyle -> Style
doN ListNumberStyle
numbStl forall a. [a] -> [a] -> [a]
++ Style
bw
      makeNumbStart Maybe (a, ListNumberStyle, c)
Nothing = []
      stl :: Style
stl = if Bool
isFirst
               then Text
firstListItemNameforall a. a -> [a] -> [a]
:Style
style
               else Style
style
      stl' :: Style
stl' = forall {a} {c}.
(Ord a, Num a, Show a) =>
Maybe (a, ListNumberStyle, c) -> Style
makeNumbStart Maybe ListAttributes
attribs forall a. [a] -> [a] -> [a]
++ Style
stl
  in  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
item forall a. Ord a => a -> a -> Bool
> Int
1
         then do
           let insertTab :: Block -> WS m (Doc Text)
insertTab (Para [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
subListParNameforall a. a -> [a] -> [a]
:Style
style) forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
"\t"forall a. a -> [a] -> [a]
:[Inline]
lst
               insertTab Block
block      = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
style Block
block
           Doc Text
f <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts Style
stl' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Block]
item
           [Doc Text]
r <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}. PandocMonad m => Block -> WS m (Doc Text)
insertTab forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Block]
item
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs (Doc Text
f forall a. a -> [a] -> [a]
: [Doc Text]
r)
         else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts Style
stl' [Block]
item

definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text)
definitionListItemToICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> ([Inline], [[Block]]) -> WS m (Doc Text)
definitionListItemToICML WriterOptions
opts Style
style ([Inline]
term,[[Block]]
defs) = do
  Doc Text
term' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts (Text
defListTermNameforall a. a -> [a] -> [a]
:Style
style) Text
"" [Inline]
term
  [Doc Text]
defs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
blocksToICML WriterOptions
opts (Text
defListDefNameforall a. a -> [a] -> [a]
:Style
style)) [[Block]]
defs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
intersperseBrs (Doc Text
term' 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 -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts Style
style Text
ident [Inline]
lst = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
opts Style
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 -> Style -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
_    Style
style Text
ident (Str Text
str) = forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToICML WriterOptions
opts Style
style Text
ident (Emph [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
emphNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Underline [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
underlineNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Strong [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
strongNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Strikeout [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
strikeoutNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Superscript [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
superscriptNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Subscript [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
subscriptNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (SmallCaps [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
smallCapsNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
opts Style
style Text
ident (Quoted QuoteType
SingleQuote [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts Style
style Text
ident forall a b. (a -> b) -> a -> b
$
  WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
"‘"] forall a. [a] -> [a] -> [a]
++ [Inline]
lst forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"’"]
inlineToICML WriterOptions
opts Style
style Text
ident (Quoted QuoteType
DoubleQuote [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts Style
style Text
ident forall a b. (a -> b) -> a -> b
$
  WriterOptions -> [Inline] -> [Inline]
mergeStrings WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
"“"] forall a. [a] -> [a] -> [a]
++ [Inline]
lst forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"”"]
inlineToICML WriterOptions
opts Style
style Text
ident (Cite [Citation]
_ [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
citeNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
inlineToICML WriterOptions
_    Style
style Text
ident (Code Attr
_ Text
str) = forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle (Text
codeNameforall a. a -> [a] -> [a]
:Style
style) Text
ident forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToICML WriterOptions
_    Style
style Text
ident Inline
Space = forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a. Doc a
space
inlineToICML WriterOptions
opts Style
style Text
ident Inline
SoftBreak =
  case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
       WrapOption
WrapAuto     -> forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a. Doc a
space
       WrapOption
WrapNone     -> forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a. Doc a
space
       WrapOption
WrapPreserve -> forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a. Doc a
cr
inlineToICML WriterOptions
_ Style
style Text
ident Inline
LineBreak = forall (m :: * -> *).
PandocMonad m =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
lineSeparator
inlineToICML WriterOptions
opts Style
style Text
ident (Math MathType
mt Text
str) =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
mt Text
str) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> Inline -> WS m (Doc Text)
inlineToICML WriterOptions
opts Style
style Text
ident))
inlineToICML WriterOptions
_ Style
_ Text
_ il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"icml" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise          = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToICML WriterOptions
opts Style
style Text
ident (Link Attr
_ [Inline]
lst (Text
url, Text
title)) = do
  Doc Text
content <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Text
linkNameforall a. a -> [a] -> [a]
:Style
style) Text
ident [Inline]
lst
  forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \WriterState
st ->
            let link_id :: Int
link_id = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st
                            then Int
1::Int
                            else Int
1 forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
fst (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ WriterState -> Hyperlink
links WriterState
st)
                newst :: WriterState
newst = WriterState
st{ links :: Hyperlink
links = (Int
link_id, Text
url)forall a. a -> [a] -> [a]
:WriterState -> Hyperlink
links WriterState
st }
                cont :: Doc Text
cont  = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"HyperlinkTextSource"
                         [(Text
"Self",Text
"htss-"forall a. Semigroup a => a -> a -> a
<>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 Style
style Text
_ident (Image Attr
attr [Inline]
_ (Text, Text)
target) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Attr -> (Text, Text) -> WS m (Doc Text)
imageICML WriterOptions
opts Style
style Attr
attr (Text, Text)
target
inlineToICML WriterOptions
opts Style
style Text
_ (Note [Block]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> [Block] -> WS m (Doc Text)
footnoteToICML WriterOptions
opts Style
style [Block]
lst
inlineToICML WriterOptions
opts Style
style Text
_ (Span (Text
ident, Style
_, [(Text, Text)]
kvs) [Inline]
lst) =
  let dynamicStyle :: Style
dynamicStyle = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
dynamicStyleKey [(Text, Text)]
kvs
  in  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts (Style
dynamicStyle forall a. Semigroup a => a -> a -> a
<> Style
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 -> Style -> [Block] -> WS m (Doc Text)
footnoteToICML WriterOptions
opts Style
style [Block]
lst =
  let insertTab :: Block -> WS m (Doc Text)
insertTab (Para [Inline]
ls) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
footnoteNameforall a. a -> [a] -> [a]
:Style
style) forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
"\t"forall a. a -> [a] -> [a]
:[Inline]
ls
      insertTab Block
block     = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Block -> WS m (Doc Text)
blockToICML WriterOptions
opts (Text
footnoteNameforall a. a -> [a] -> [a]
:Style
style) Block
block
  in  do
    [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}. PandocMonad m => Block -> WS m (Doc Text)
insertTab [Block]
lst
    let number :: Doc Text
number = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ParagraphStyleRange" [] forall a b. (a -> b) -> a -> b
$
                   forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [] forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" Doc Text
"<?ACE 4?>"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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")]
      forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Footnote" [] forall a b. (a -> b) -> a -> b
$ Doc Text
number 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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Semigroup a => a -> a -> a
<> Text
y) forall a. a -> [a] -> [a]
: [Inline]
zs)
        mergeStrings' (Inline
x : [Inline]
xs) = Inline
x 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 = forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"Br" []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Style -> Text -> [Inline] -> WS m (Doc Text)
parStyle WriterOptions
opts Style
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 forall a. Semigroup a => a -> a -> a
<> Text
" > " forall a. Semigroup a => a -> a -> a
<> Text
y
      stlStr :: Text
stlStr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Text -> Text
slipIn Text
"" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse Style
style
      stl :: Text
stl    = if Text -> Bool
Text.null Text
stlStr
                  then Text
""
                  else Text
"ParagraphStyle/" forall a. Semigroup a => a -> a -> a
<> Text
stlStr
      attrs :: (Text, Text)
attrs  = (Text
"AppliedParagraphStyle", Text
stl)
      attrs' :: [(Text, Text)]
attrs' =  if Text
firstListItemName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Style
style
                   then let ats :: [(Text, Text)]
ats = (Text, Text)
attrs forall a. a -> [a] -> [a]
: [(Text
"NumberingContinue", Text
"false")]
                            begins :: Style
begins = forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Text.isPrefixOf Text
beginsWithName) Style
style
                        in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Style
begins
                               then [(Text, Text)]
ats
                               else let i :: Text
i = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripPrefix Text
beginsWithName
                                                         forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head Style
begins
                                    in  (Text
"NumberingStartAt", Text
i) forall a. a -> [a] -> [a]
: [(Text, Text)]
ats
                   else [(Text, Text)
attrs]
  in  do
      Doc Text
content <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Style -> Text -> [Inline] -> WS m (Doc Text)
inlinesToICML WriterOptions
opts [] Text
ident [Inline]
lst
      let cont :: Doc Text
cont = 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
      forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \WriterState
st -> (Doc Text
cont, WriterState
st{ blockStyles :: Set Text
blockStyles = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
stlStr forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
blockStyles WriterState
st })

-- | Create the destination name
makeDestName :: Text -> Text
makeDestName :: Text -> Text
makeDestName Text
name = Text
"#" forall a. Semigroup a => a -> a -> a
<> 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 = forall a. [Doc a] -> Doc a
vcat [
    forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"HyperlinkTextDestination"
      [(Text
"Self", Text
"HyperlinkTextDestination/"forall a. Semigroup a => a -> a -> a
<>Text -> Text
makeDestName Text
ident), (Text
"Name",Text
"Destination"), (Text
"DestinationUniqueKey",Text
"1")]
    , forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" forall a b. (a -> b) -> a -> b
$ 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
              | forall a. Doc a -> Bool
isEmpty Doc Text
cont = 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 = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"Content" forall a b. (a -> b) -> a -> b
$ 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 =>
Style -> Text -> Doc Text -> WS m (Doc Text)
charStyle Style
style Text
ident Doc Text
content =
  let (Text
stlStr, [(Text, Text)]
attrs) = Style -> (Text, [(Text, Text)])
styleToStrAttr Style
style
      doc :: Doc Text
doc = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [(Text, Text)]
attrs
              forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
makeContent Text
ident Doc Text
content
  in
      forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state 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 Text
inlineStyles = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
stlStr forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
inlineStyles WriterState
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 :: Style -> (Text, [(Text, Text)])
styleToStrAttr Style
style =
  let stlStr :: Text
stlStr = Style -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList Style
style
      stl :: Text
stl    = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Style
style
                  then Text
"$ID/NormalCharacterStyle"
                  else Text
"CharacterStyle/" 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 -> Style -> Attr -> (Text, Text) -> WS m (Doc Text)
imageICML WriterOptions
opts Style
style Attr
attr (Text
src, Text
_) = do
  ImageSize
imgS <- forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
          (do (ByteString
img, 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ImageSize
size
                Left Text
msg   -> do
                  forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotDetermineImageSize Text
src Text
msg
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def)
           (\PandocError
e -> do
               forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow PandocError
e
               forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. RealFloat a => a -> Text
showFl forall a b. (a -> b) -> a -> b
$ Double
ow forall a. Fractional a => a -> a -> a
/ Double
2
      hh :: Text
hh = forall a. RealFloat a => a -> Text
showFl forall a b. (a -> b) -> a -> b
$ Double
oh forall a. Fractional a => a -> a -> a
/ Double
2
      scale :: Text
scale = forall a. RealFloat a => a -> Text
showFl (Double
imgWidth forall a. Fractional a => a -> a -> a
/ Double
ow) forall a. Semigroup a => a -> a -> a
<> Text
" 0 0 " forall a. Semigroup a => a -> a -> a
<> forall a. RealFloat a => a -> Text
showFl (Double
imgHeight forall a. Fractional a => a -> a -> a
/ Double
oh)
      src' :: Text
src' = if Text -> Bool
isURI Text
src then Text
src else Text
"file:" forall a. Semigroup a => a -> a -> a
<> Text
src
      (Text
stlStr, [(Text, Text)]
attrs) = Style -> (Text, [(Text, Text)])
styleToStrAttr Style
style
      props :: Doc Text
props  = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"PathGeometry" []
                 forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"GeometryPathType" [(Text
"PathOpen",Text
"false")]
                 forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"PathPointArray" []
                 forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [
                     forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
"-"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                   , forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"PathPointType" [(Text
"Anchor", Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh),
                       (Text
"LeftDirection", Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh), (Text
"RightDirection", Text
hwforall a. Semigroup a => a -> a -> a
<>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
                  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Contents" [] forall a b. (a -> b) -> a -> b
$
                    forall a. HasChars a => a -> Doc a
literal (Text
"<![CDATA[" forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
Text.replace Text
"%20" Text
""
                            (Int -> Text -> Text
Text.drop Int
1 ((Char -> Bool) -> Text -> Text
Text.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
',') Text
src')) forall a. Semigroup a => a -> a -> a
<> Text
"]]>")
               else forall a. Monoid a => a
mempty
      link :: Doc Text
link = if Bool
isdata
                then forall a. Monoid a => a
mempty
                else  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  = 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
scaleforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh)]
                 forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [
                     forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Properties" [] forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [
                         forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"Profile" [(Text
"type",Text
"string")] forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text String
"$ID/Embedded"
                       , forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"GraphicBounds" [(Text
"Left",Text
"0"), (Text
"Top",Text
"0")
                         , (Text
"Right",  forall a. RealFloat a => a -> Text
showFl forall a b. (a -> b) -> a -> b
$ Double
owforall a. Num a => a -> a -> a
*Double
ow forall a. Fractional a => a -> a -> a
/ Double
imgWidth)
                         , (Text
"Bottom", forall a. RealFloat a => a -> Text
showFl forall a b. (a -> b) -> a -> b
$ Double
ohforall a. Num a => a -> a -> a
*Double
oh forall a. Fractional a => a -> a -> a
/ Double
imgHeight)]
                       , Doc Text
contents
                       ]
                   , Doc Text
link
                   ]
      doc :: Doc Text
doc    = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"CharacterStyleRange" [(Text, Text)]
attrs
                 forall a b. (a -> b) -> a -> b
$ 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
scaleforall a. Semigroup a => a -> a -> a
<>Text
" "forall a. Semigroup a => a -> a -> a
<>Text
hwforall a. Semigroup a => a -> a -> a
<>Text
" -"forall a. Semigroup a => a -> a -> a
<>Text
hh)] (Doc Text
props forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
image)
  forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \WriterState
st -> (Doc Text
doc, WriterState
st{ inlineStyles :: Set Text
inlineStyles = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
stlStr forall a b. (a -> b) -> a -> b
$ WriterState -> Set Text
inlineStyles WriterState
st } )