{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE ViewPatterns               #-}
{- |
   Module      : Text.Pandoc.Writers.Powerpoint.Presentation
   Copyright   : Copyright (C) 2017-2020 Jesse Rosenthal
   License     : GNU GPL, version 2 or above

   Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
   Stability   : alpha
   Portability : portable

Definition of Presentation datatype, modeling a MS Powerpoint (pptx)
document, and functions for converting a Pandoc document to
Presentation.
-}

module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation
                                                   , Presentation(..)
                                                   , DocProps(..)
                                                   , Slide(..)
                                                   , Layout(..)
                                                   , SpeakerNotes(..)
                                                   , SlideId(..)
                                                   , Shape(..)
                                                   , Graphic(..)
                                                   , BulletType(..)
                                                   , Algnment(..)
                                                   , Paragraph(..)
                                                   , ParaElem(..)
                                                   , ParaProps(..)
                                                   , RunProps(..)
                                                   , TableProps(..)
                                                   , Strikethrough(..)
                                                   , Capitals(..)
                                                   , Pixels
                                                   , PicProps(..)
                                                   , URL
                                                   , TeXString(..)
                                                   , LinkTarget(..)
                                                   ) where

import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.List (intercalate)
import Data.List.NonEmpty (nonEmpty)
import Data.Default
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Slides (getSlideLevel)
import Text.Pandoc.Options
import Text.Pandoc.Logging
import Text.Pandoc.Walk
import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
import Text.Pandoc.Shared (tshow)
import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks
                                 , lookupMetaString, toTableOfContents
                                 , toLegacyTable)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (maybeToList, fromMaybe, listToMaybe, isNothing)
import Text.Pandoc.Highlighting
import qualified Data.Text as T
import Control.Applicative ((<|>))
import Skylighting
import Data.Bifunctor (bimap)
import Data.Char (isSpace)

data WriterEnv = WriterEnv { WriterEnv -> Meta
envMetadata :: Meta
                           , WriterEnv -> RunProps
envRunProps :: RunProps
                           , WriterEnv -> ParaProps
envParaProps :: ParaProps
                           , WriterEnv -> Int
envSlideLevel :: Int
                           , WriterEnv -> WriterOptions
envOpts :: WriterOptions
                           , WriterEnv -> Bool
envSlideHasHeader :: Bool
                           , WriterEnv -> Bool
envInList :: Bool
                           , WriterEnv -> Bool
envInNoteSlide :: Bool
                           , WriterEnv -> SlideId
envCurSlideId :: SlideId
                           , WriterEnv -> Bool
envInSpeakerNotes :: Bool
                           , WriterEnv -> Maybe InIncrementalDiv
envInIncrementalDiv :: Maybe InIncrementalDiv
                           , WriterEnv -> Bool
envInListInBlockQuote :: Bool
                           }
                 deriving (Int -> WriterEnv -> ShowS
[WriterEnv] -> ShowS
WriterEnv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriterEnv] -> ShowS
$cshowList :: [WriterEnv] -> ShowS
show :: WriterEnv -> String
$cshow :: WriterEnv -> String
showsPrec :: Int -> WriterEnv -> ShowS
$cshowsPrec :: Int -> WriterEnv -> ShowS
Show)

instance Default WriterEnv where
  def :: WriterEnv
def = WriterEnv { envMetadata :: Meta
envMetadata = forall a. Monoid a => a
mempty
                  , envRunProps :: RunProps
envRunProps = forall a. Default a => a
def
                  , envParaProps :: ParaProps
envParaProps = forall a. Default a => a
def
                  , envSlideLevel :: Int
envSlideLevel = Int
2
                  , envOpts :: WriterOptions
envOpts = forall a. Default a => a
def
                  , envSlideHasHeader :: Bool
envSlideHasHeader = Bool
False
                  , envInList :: Bool
envInList = Bool
False
                  , envInNoteSlide :: Bool
envInNoteSlide = Bool
False
                  , envCurSlideId :: SlideId
envCurSlideId = Text -> SlideId
SlideId Text
"Default"
                  , envInSpeakerNotes :: Bool
envInSpeakerNotes = Bool
False
                  , envInIncrementalDiv :: Maybe InIncrementalDiv
envInIncrementalDiv = forall a. Maybe a
Nothing
                  , envInListInBlockQuote :: Bool
envInListInBlockQuote = Bool
False
                  }


data WriterState = WriterState { WriterState -> Map Int [Block]
stNoteIds :: M.Map Int [Block]
                               -- associate anchors with slide id
                               , WriterState -> Map Text SlideId
stAnchorMap :: M.Map T.Text SlideId
                               , WriterState -> Set SlideId
stSlideIdSet :: S.Set SlideId
                               , WriterState -> [LogMessage]
stLog :: [LogMessage]
                               , WriterState -> SpeakerNotes
stSpeakerNotes :: SpeakerNotes
                               } deriving (Int -> WriterState -> ShowS
[WriterState] -> ShowS
WriterState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriterState] -> ShowS
$cshowList :: [WriterState] -> ShowS
show :: WriterState -> String
$cshow :: WriterState -> String
showsPrec :: Int -> WriterState -> ShowS
$cshowsPrec :: Int -> WriterState -> ShowS
Show, WriterState -> WriterState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriterState -> WriterState -> Bool
$c/= :: WriterState -> WriterState -> Bool
== :: WriterState -> WriterState -> Bool
$c== :: WriterState -> WriterState -> Bool
Eq)

instance Default WriterState where
  def :: WriterState
def = WriterState { stNoteIds :: Map Int [Block]
stNoteIds = forall a. Monoid a => a
mempty
                    , stAnchorMap :: Map Text SlideId
stAnchorMap = forall a. Monoid a => a
mempty
                    -- we reserve this s
                    , stSlideIdSet :: Set SlideId
stSlideIdSet = Set SlideId
reservedSlideIds
                    , stLog :: [LogMessage]
stLog = []
                    , stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = forall a. Monoid a => a
mempty
                    }

data InIncrementalDiv
  = InIncremental
  -- ^ The current content is contained within an "incremental" div.
  | InNonIncremental
  -- ^ The current content is contained within a "nonincremental" div.
  deriving (Int -> InIncrementalDiv -> ShowS
[InIncrementalDiv] -> ShowS
InIncrementalDiv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InIncrementalDiv] -> ShowS
$cshowList :: [InIncrementalDiv] -> ShowS
show :: InIncrementalDiv -> String
$cshow :: InIncrementalDiv -> String
showsPrec :: Int -> InIncrementalDiv -> ShowS
$cshowsPrec :: Int -> InIncrementalDiv -> ShowS
Show)

listShouldBeIncremental :: Pres Bool
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental = do
  Bool
incrementalOption <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Bool
writerIncremental forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterEnv -> WriterOptions
envOpts)
  Maybe InIncrementalDiv
inIncrementalDiv <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe InIncrementalDiv
envInIncrementalDiv
  Bool
inBlockQuote <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInListInBlockQuote
  let toBoolean :: InIncrementalDiv -> Bool
toBoolean = (\case InIncrementalDiv
InIncremental -> Bool
True
                         InIncrementalDiv
InNonIncremental -> Bool
False)
      maybeInvert :: Bool -> Bool
maybeInvert = if Bool
inBlockQuote then Bool -> Bool
not else forall a. a -> a
id
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool
maybeInvert (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
incrementalOption InIncrementalDiv -> Bool
toBoolean Maybe InIncrementalDiv
inIncrementalDiv))

metadataSlideId :: SlideId
metadataSlideId :: SlideId
metadataSlideId = Text -> SlideId
SlideId Text
"Metadata"

tocSlideId :: SlideId
tocSlideId :: SlideId
tocSlideId = Text -> SlideId
SlideId Text
"TOC"

endNotesSlideId :: SlideId
endNotesSlideId :: SlideId
endNotesSlideId = Text -> SlideId
SlideId Text
"EndNotes"

reservedSlideIds :: S.Set SlideId
reservedSlideIds :: Set SlideId
reservedSlideIds = forall a. Ord a => [a] -> Set a
S.fromList [ SlideId
metadataSlideId
                              , SlideId
tocSlideId
                              , SlideId
endNotesSlideId
                              ]

uniqueSlideId' :: Integer -> S.Set SlideId -> T.Text -> SlideId
uniqueSlideId' :: Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' Integer
n Set SlideId
idSet Text
s =
  let s' :: Text
s' = if Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0 then Text
s else Text
s forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Integer
n
  in if Text -> SlideId
SlideId Text
s' forall a. Ord a => a -> Set a -> Bool
`S.member` Set SlideId
idSet
     then Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' (Integer
nforall a. Num a => a -> a -> a
+Integer
1) Set SlideId
idSet Text
s
     else Text -> SlideId
SlideId Text
s'

uniqueSlideId :: S.Set SlideId -> T.Text -> SlideId
uniqueSlideId :: Set SlideId -> Text -> SlideId
uniqueSlideId = Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' Integer
0

runUniqueSlideId :: T.Text -> Pres SlideId
runUniqueSlideId :: Text -> Pres SlideId
runUniqueSlideId Text
s = do
  Set SlideId
idSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set SlideId
stSlideIdSet
  let sldId :: SlideId
sldId = Set SlideId -> Text -> SlideId
uniqueSlideId Set SlideId
idSet Text
s
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSlideIdSet :: Set SlideId
stSlideIdSet = forall a. Ord a => a -> Set a -> Set a
S.insert SlideId
sldId Set SlideId
idSet}
  forall (m :: * -> *) a. Monad m => a -> m a
return SlideId
sldId

addLogMessage :: LogMessage -> Pres ()
addLogMessage :: LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage LogMessage
msg = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stLog :: [LogMessage]
stLog = LogMessage
msg forall a. a -> [a] -> [a]
: WriterState -> [LogMessage]
stLog WriterState
st}

type Pres = ReaderT WriterEnv (State WriterState)

runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres :: forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
st Pres a
p = (a
pres, forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ WriterState -> [LogMessage]
stLog WriterState
finalSt)
  where (a
pres, WriterState
finalSt) = forall s a. State s a -> s -> (a, s)
runState (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Pres a
p WriterEnv
env) WriterState
st

-- GHC 7.8 will still complain about concat <$> mapM unless we specify
-- Functor. We can get rid of this when we stop supporting GHC 7.8.
concatMapM        :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs   =  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
xs)

type Pixels = Integer

data Presentation = Presentation DocProps [Slide]
  deriving (Int -> Presentation -> ShowS
[Presentation] -> ShowS
Presentation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Presentation] -> ShowS
$cshowList :: [Presentation] -> ShowS
show :: Presentation -> String
$cshow :: Presentation -> String
showsPrec :: Int -> Presentation -> ShowS
$cshowsPrec :: Int -> Presentation -> ShowS
Show)

data DocProps = DocProps { DocProps -> Maybe Text
dcTitle :: Maybe T.Text
                         , DocProps -> Maybe Text
dcSubject :: Maybe T.Text
                         , DocProps -> Maybe Text
dcCreator :: Maybe T.Text
                         , DocProps -> Maybe [Text]
dcKeywords :: Maybe [T.Text]
                         , DocProps -> Maybe Text
dcDescription :: Maybe T.Text
                         , DocProps -> Maybe Text
cpCategory :: Maybe T.Text
                         , DocProps -> Maybe Text
dcDate :: Maybe T.Text
                         , DocProps -> Maybe [(Text, Text)]
customProperties :: Maybe [(T.Text, T.Text)]
                         } deriving (Int -> DocProps -> ShowS
[DocProps] -> ShowS
DocProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocProps] -> ShowS
$cshowList :: [DocProps] -> ShowS
show :: DocProps -> String
$cshow :: DocProps -> String
showsPrec :: Int -> DocProps -> ShowS
$cshowsPrec :: Int -> DocProps -> ShowS
Show, DocProps -> DocProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocProps -> DocProps -> Bool
$c/= :: DocProps -> DocProps -> Bool
== :: DocProps -> DocProps -> Bool
$c== :: DocProps -> DocProps -> Bool
Eq)


data Slide = Slide { Slide -> SlideId
slideId :: SlideId
                   , Slide -> Layout
slideLayout :: Layout
                   , Slide -> SpeakerNotes
slideSpeakerNotes :: SpeakerNotes
                   , Slide -> Maybe String
slideBackgroundImage :: Maybe FilePath
                   } deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slide] -> ShowS
$cshowList :: [Slide] -> ShowS
show :: Slide -> String
$cshow :: Slide -> String
showsPrec :: Int -> Slide -> ShowS
$cshowsPrec :: Int -> Slide -> ShowS
Show, Slide -> Slide -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slide -> Slide -> Bool
$c/= :: Slide -> Slide -> Bool
== :: Slide -> Slide -> Bool
$c== :: Slide -> Slide -> Bool
Eq)

newtype SlideId = SlideId T.Text
  deriving (Int -> SlideId -> ShowS
[SlideId] -> ShowS
SlideId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlideId] -> ShowS
$cshowList :: [SlideId] -> ShowS
show :: SlideId -> String
$cshow :: SlideId -> String
showsPrec :: Int -> SlideId -> ShowS
$cshowsPrec :: Int -> SlideId -> ShowS
Show, SlideId -> SlideId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlideId -> SlideId -> Bool
$c/= :: SlideId -> SlideId -> Bool
== :: SlideId -> SlideId -> Bool
$c== :: SlideId -> SlideId -> Bool
Eq, Eq SlideId
SlideId -> SlideId -> Bool
SlideId -> SlideId -> Ordering
SlideId -> SlideId -> SlideId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SlideId -> SlideId -> SlideId
$cmin :: SlideId -> SlideId -> SlideId
max :: SlideId -> SlideId -> SlideId
$cmax :: SlideId -> SlideId -> SlideId
>= :: SlideId -> SlideId -> Bool
$c>= :: SlideId -> SlideId -> Bool
> :: SlideId -> SlideId -> Bool
$c> :: SlideId -> SlideId -> Bool
<= :: SlideId -> SlideId -> Bool
$c<= :: SlideId -> SlideId -> Bool
< :: SlideId -> SlideId -> Bool
$c< :: SlideId -> SlideId -> Bool
compare :: SlideId -> SlideId -> Ordering
$ccompare :: SlideId -> SlideId -> Ordering
Ord)

-- In theory you could have anything on a notes slide but it seems
-- designed mainly for one textbox, so we'll just put in the contents
-- of that textbox, to avoid other shapes that won't work as well.
newtype SpeakerNotes = SpeakerNotes {SpeakerNotes -> [Paragraph]
fromSpeakerNotes :: [Paragraph]}
  deriving (Int -> SpeakerNotes -> ShowS
[SpeakerNotes] -> ShowS
SpeakerNotes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpeakerNotes] -> ShowS
$cshowList :: [SpeakerNotes] -> ShowS
show :: SpeakerNotes -> String
$cshow :: SpeakerNotes -> String
showsPrec :: Int -> SpeakerNotes -> ShowS
$cshowsPrec :: Int -> SpeakerNotes -> ShowS
Show, SpeakerNotes -> SpeakerNotes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeakerNotes -> SpeakerNotes -> Bool
$c/= :: SpeakerNotes -> SpeakerNotes -> Bool
== :: SpeakerNotes -> SpeakerNotes -> Bool
$c== :: SpeakerNotes -> SpeakerNotes -> Bool
Eq, Semigroup SpeakerNotes
SpeakerNotes
[SpeakerNotes] -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SpeakerNotes] -> SpeakerNotes
$cmconcat :: [SpeakerNotes] -> SpeakerNotes
mappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$cmappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
mempty :: SpeakerNotes
$cmempty :: SpeakerNotes
Monoid, NonEmpty SpeakerNotes -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
$cstimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
sconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
$csconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$c<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
Semigroup)

data Layout = MetadataSlide [ParaElem] [ParaElem] [[ParaElem]] [ParaElem]
            --              title      subtitle   authors      date
            | TitleSlide [ParaElem]
            --           heading
            | ContentSlide [ParaElem] [Shape]
            --             heading    content
            | TwoColumnSlide [ParaElem] [Shape] [Shape]
            --               heading    left    right
            | ComparisonSlide [ParaElem] ([Shape], [Shape]) ([Shape], [Shape])
            --                heading  left@(text, content) right@(text, content)
            | ContentWithCaptionSlide [ParaElem] [Shape] [Shape]
            --                        heading     text    content
            | BlankSlide
            deriving (Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show, Layout -> Layout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq)

data Shape = Pic PicProps FilePath T.Text [ParaElem]
           --                      title  alt-text
           | GraphicFrame [Graphic] [ParaElem]
           | TextBox [Paragraph]
           | RawOOXMLShape T.Text
  deriving (Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show, Shape -> Shape -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq)

type TableCell = [Paragraph]

-- TODO: remove when better handling of new
-- tables is implemented
type SimpleCell = [Block]

data TableProps = TableProps { TableProps -> Bool
tblPrFirstRow :: Bool
                             , TableProps -> Bool
tblPrBandRow :: Bool
                             } deriving (Int -> TableProps -> ShowS
[TableProps] -> ShowS
TableProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableProps] -> ShowS
$cshowList :: [TableProps] -> ShowS
show :: TableProps -> String
$cshow :: TableProps -> String
showsPrec :: Int -> TableProps -> ShowS
$cshowsPrec :: Int -> TableProps -> ShowS
Show, TableProps -> TableProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableProps -> TableProps -> Bool
$c/= :: TableProps -> TableProps -> Bool
== :: TableProps -> TableProps -> Bool
$c== :: TableProps -> TableProps -> Bool
Eq)

data Graphic = Tbl TableProps [TableCell] [[TableCell]]
  deriving (Int -> Graphic -> ShowS
[Graphic] -> ShowS
Graphic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graphic] -> ShowS
$cshowList :: [Graphic] -> ShowS
show :: Graphic -> String
$cshow :: Graphic -> String
showsPrec :: Int -> Graphic -> ShowS
$cshowsPrec :: Int -> Graphic -> ShowS
Show, Graphic -> Graphic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graphic -> Graphic -> Bool
$c/= :: Graphic -> Graphic -> Bool
== :: Graphic -> Graphic -> Bool
$c== :: Graphic -> Graphic -> Bool
Eq)


data Paragraph = Paragraph { Paragraph -> ParaProps
paraProps :: ParaProps
                           , Paragraph -> [ParaElem]
paraElems :: [ParaElem]
                           } deriving (Int -> Paragraph -> ShowS
[Paragraph] -> ShowS
Paragraph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paragraph] -> ShowS
$cshowList :: [Paragraph] -> ShowS
show :: Paragraph -> String
$cshow :: Paragraph -> String
showsPrec :: Int -> Paragraph -> ShowS
$cshowsPrec :: Int -> Paragraph -> ShowS
Show, Paragraph -> Paragraph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paragraph -> Paragraph -> Bool
$c/= :: Paragraph -> Paragraph -> Bool
== :: Paragraph -> Paragraph -> Bool
$c== :: Paragraph -> Paragraph -> Bool
Eq)

data BulletType = Bullet
                | AutoNumbering ListAttributes
  deriving (Int -> BulletType -> ShowS
[BulletType] -> ShowS
BulletType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BulletType] -> ShowS
$cshowList :: [BulletType] -> ShowS
show :: BulletType -> String
$cshow :: BulletType -> String
showsPrec :: Int -> BulletType -> ShowS
$cshowsPrec :: Int -> BulletType -> ShowS
Show, BulletType -> BulletType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BulletType -> BulletType -> Bool
$c/= :: BulletType -> BulletType -> Bool
== :: BulletType -> BulletType -> Bool
$c== :: BulletType -> BulletType -> Bool
Eq)

data Algnment = AlgnLeft | AlgnRight | AlgnCenter
  deriving (Int -> Algnment -> ShowS
[Algnment] -> ShowS
Algnment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algnment] -> ShowS
$cshowList :: [Algnment] -> ShowS
show :: Algnment -> String
$cshow :: Algnment -> String
showsPrec :: Int -> Algnment -> ShowS
$cshowsPrec :: Int -> Algnment -> ShowS
Show, Algnment -> Algnment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algnment -> Algnment -> Bool
$c/= :: Algnment -> Algnment -> Bool
== :: Algnment -> Algnment -> Bool
$c== :: Algnment -> Algnment -> Bool
Eq)

data ParaProps = ParaProps { ParaProps -> Maybe Integer
pPropMarginLeft :: Maybe Pixels
                           , ParaProps -> Maybe Integer
pPropMarginRight :: Maybe Pixels
                           , ParaProps -> Int
pPropLevel :: Int
                           , ParaProps -> Maybe BulletType
pPropBullet :: Maybe BulletType
                           , ParaProps -> Maybe Algnment
pPropAlign :: Maybe Algnment
                           , ParaProps -> Maybe Integer
pPropSpaceBefore :: Maybe Pixels
                           , ParaProps -> Maybe Integer
pPropIndent :: Maybe Pixels
                           , ParaProps -> Bool
pPropIncremental :: Bool
                           } deriving (Int -> ParaProps -> ShowS
[ParaProps] -> ShowS
ParaProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParaProps] -> ShowS
$cshowList :: [ParaProps] -> ShowS
show :: ParaProps -> String
$cshow :: ParaProps -> String
showsPrec :: Int -> ParaProps -> ShowS
$cshowsPrec :: Int -> ParaProps -> ShowS
Show, ParaProps -> ParaProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaProps -> ParaProps -> Bool
$c/= :: ParaProps -> ParaProps -> Bool
== :: ParaProps -> ParaProps -> Bool
$c== :: ParaProps -> ParaProps -> Bool
Eq)

instance Default ParaProps where
  def :: ParaProps
def = ParaProps { pPropMarginLeft :: Maybe Integer
pPropMarginLeft = forall a. a -> Maybe a
Just Integer
0
                  , pPropMarginRight :: Maybe Integer
pPropMarginRight = forall a. a -> Maybe a
Just Integer
0
                  , pPropLevel :: Int
pPropLevel = Int
0
                  , pPropBullet :: Maybe BulletType
pPropBullet = forall a. Maybe a
Nothing
                  , pPropAlign :: Maybe Algnment
pPropAlign = forall a. Maybe a
Nothing
                  , pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = forall a. Maybe a
Nothing
                  , pPropIndent :: Maybe Integer
pPropIndent = forall a. a -> Maybe a
Just Integer
0
                  , pPropIncremental :: Bool
pPropIncremental = Bool
False
                  }

newtype TeXString = TeXString {TeXString -> Text
unTeXString :: T.Text}
  deriving (TeXString -> TeXString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeXString -> TeXString -> Bool
$c/= :: TeXString -> TeXString -> Bool
== :: TeXString -> TeXString -> Bool
$c== :: TeXString -> TeXString -> Bool
Eq, Int -> TeXString -> ShowS
[TeXString] -> ShowS
TeXString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeXString] -> ShowS
$cshowList :: [TeXString] -> ShowS
show :: TeXString -> String
$cshow :: TeXString -> String
showsPrec :: Int -> TeXString -> ShowS
$cshowsPrec :: Int -> TeXString -> ShowS
Show)

data ParaElem = Break
              | Run RunProps T.Text
              -- It would be more elegant to have native TeXMath
              -- Expressions here, but this allows us to use
              -- `convertmath` from T.P.Writers.Math. Will perhaps
              -- revisit in the future.
              | MathElem MathType TeXString
              | RawOOXMLParaElem T.Text
              deriving (Int -> ParaElem -> ShowS
[ParaElem] -> ShowS
ParaElem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParaElem] -> ShowS
$cshowList :: [ParaElem] -> ShowS
show :: ParaElem -> String
$cshow :: ParaElem -> String
showsPrec :: Int -> ParaElem -> ShowS
$cshowsPrec :: Int -> ParaElem -> ShowS
Show, ParaElem -> ParaElem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaElem -> ParaElem -> Bool
$c/= :: ParaElem -> ParaElem -> Bool
== :: ParaElem -> ParaElem -> Bool
$c== :: ParaElem -> ParaElem -> Bool
Eq)

data Strikethrough = NoStrike | SingleStrike | DoubleStrike
  deriving (Int -> Strikethrough -> ShowS
[Strikethrough] -> ShowS
Strikethrough -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strikethrough] -> ShowS
$cshowList :: [Strikethrough] -> ShowS
show :: Strikethrough -> String
$cshow :: Strikethrough -> String
showsPrec :: Int -> Strikethrough -> ShowS
$cshowsPrec :: Int -> Strikethrough -> ShowS
Show, Strikethrough -> Strikethrough -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strikethrough -> Strikethrough -> Bool
$c/= :: Strikethrough -> Strikethrough -> Bool
== :: Strikethrough -> Strikethrough -> Bool
$c== :: Strikethrough -> Strikethrough -> Bool
Eq)

data Capitals = NoCapitals | SmallCapitals | AllCapitals
  deriving (Int -> Capitals -> ShowS
[Capitals] -> ShowS
Capitals -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Capitals] -> ShowS
$cshowList :: [Capitals] -> ShowS
show :: Capitals -> String
$cshow :: Capitals -> String
showsPrec :: Int -> Capitals -> ShowS
$cshowsPrec :: Int -> Capitals -> ShowS
Show, Capitals -> Capitals -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capitals -> Capitals -> Bool
$c/= :: Capitals -> Capitals -> Bool
== :: Capitals -> Capitals -> Bool
$c== :: Capitals -> Capitals -> Bool
Eq)

type URL = T.Text

data LinkTarget = ExternalTarget (URL, T.Text)
                | InternalTarget SlideId
                deriving (Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show, LinkTarget -> LinkTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq)

data RunProps = RunProps { RunProps -> Bool
rPropBold :: Bool
                         , RunProps -> Bool
rPropItalics :: Bool
                         , RunProps -> Maybe Strikethrough
rStrikethrough :: Maybe Strikethrough
                         , RunProps -> Maybe Int
rBaseline :: Maybe Int
                         , RunProps -> Maybe Capitals
rCap :: Maybe Capitals
                         , RunProps -> Maybe LinkTarget
rLink :: Maybe LinkTarget
                         , RunProps -> Bool
rPropCode :: Bool
                         , RunProps -> Bool
rPropBlockQuote :: Bool
                         , RunProps -> Maybe Integer
rPropForceSize :: Maybe Pixels
                         , RunProps -> Maybe Color
rSolidFill :: Maybe Color
                         -- TODO: Make a full underline data type with
                         -- the different options.
                         , RunProps -> Bool
rPropUnderline :: Bool
                         } deriving (Int -> RunProps -> ShowS
[RunProps] -> ShowS
RunProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunProps] -> ShowS
$cshowList :: [RunProps] -> ShowS
show :: RunProps -> String
$cshow :: RunProps -> String
showsPrec :: Int -> RunProps -> ShowS
$cshowsPrec :: Int -> RunProps -> ShowS
Show, RunProps -> RunProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunProps -> RunProps -> Bool
$c/= :: RunProps -> RunProps -> Bool
== :: RunProps -> RunProps -> Bool
$c== :: RunProps -> RunProps -> Bool
Eq)

instance Default RunProps where
  def :: RunProps
def = RunProps { rPropBold :: Bool
rPropBold = Bool
False
                 , rPropItalics :: Bool
rPropItalics = Bool
False
                 , rStrikethrough :: Maybe Strikethrough
rStrikethrough = forall a. Maybe a
Nothing
                 , rBaseline :: Maybe Int
rBaseline = forall a. Maybe a
Nothing
                 , rCap :: Maybe Capitals
rCap = forall a. Maybe a
Nothing
                 , rLink :: Maybe LinkTarget
rLink = forall a. Maybe a
Nothing
                 , rPropCode :: Bool
rPropCode = Bool
False
                 , rPropBlockQuote :: Bool
rPropBlockQuote = Bool
False
                 , rPropForceSize :: Maybe Integer
rPropForceSize = forall a. Maybe a
Nothing
                 , rSolidFill :: Maybe Color
rSolidFill = forall a. Maybe a
Nothing
                 , rPropUnderline :: Bool
rPropUnderline = Bool
False
                 }

data PicProps = PicProps { PicProps -> Maybe LinkTarget
picPropLink :: Maybe LinkTarget
                         , PicProps -> Maybe Dimension
picWidth    :: Maybe Dimension
                         , PicProps -> Maybe Dimension
picHeight   :: Maybe Dimension
                         } deriving (Int -> PicProps -> ShowS
[PicProps] -> ShowS
PicProps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PicProps] -> ShowS
$cshowList :: [PicProps] -> ShowS
show :: PicProps -> String
$cshow :: PicProps -> String
showsPrec :: Int -> PicProps -> ShowS
$cshowsPrec :: Int -> PicProps -> ShowS
Show, PicProps -> PicProps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PicProps -> PicProps -> Bool
$c/= :: PicProps -> PicProps -> Bool
== :: PicProps -> PicProps -> Bool
$c== :: PicProps -> PicProps -> Bool
Eq)

instance Default PicProps where
  def :: PicProps
def = PicProps { picPropLink :: Maybe LinkTarget
picPropLink = forall a. Maybe a
Nothing
                 , picWidth :: Maybe Dimension
picWidth = forall a. Maybe a
Nothing
                 , picHeight :: Maybe Dimension
picHeight = forall a. Maybe a
Nothing
                 }

--------------------------------------------------

inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Inline -> Pres [ParaElem]
inlineToParElems

inlineToParElems :: Inline -> Pres [ParaElem]
inlineToParElems :: Inline -> Pres [ParaElem]
inlineToParElems (Str Text
s) = do
  RunProps
pr <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
  forall (m :: * -> *) a. Monad m => a -> m a
return [RunProps -> Text -> ParaElem
Run RunProps
pr Text
s]
inlineToParElems (Emph [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropItalics :: Bool
rPropItalics=Bool
True}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Underline [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropUnderline :: Bool
rPropUnderline=Bool
True}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strong [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropBold :: Bool
rPropBold=Bool
True}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strikeout [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rStrikethrough :: Maybe Strikethrough
rStrikethrough=forall a. a -> Maybe a
Just Strikethrough
SingleStrike}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Superscript [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=forall a. a -> Maybe a
Just Int
30000}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Subscript [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=forall a. a -> Maybe a
Just (-Int
25000)}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (SmallCaps [Inline]
ils) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rCap :: Maybe Capitals
rCap = forall a. a -> Maybe a
Just Capitals
SmallCapitals}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems Inline
Space = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
SoftBreak = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return [ParaElem
Break]
inlineToParElems (Link Attr
_ [Inline]
ils (Text
url, Text
title)) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rLink :: Maybe LinkTarget
rLink = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Text, Text) -> LinkTarget
ExternalTarget (Text
url, Text
title)}}) forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Code Attr
_ Text
str) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropCode :: Bool
rPropCode = Bool
True}}) forall a b. (a -> b) -> a -> b
$
  Inline -> Pres [ParaElem]
inlineToParElems forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
str
inlineToParElems (Math MathType
mathtype Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return [MathType -> TeXString -> ParaElem
MathElem MathType
mathtype (Text -> TeXString
TeXString Text
str)]
-- We ignore notes if we're in a speaker notes div. Otherwise this
-- would add an entry to the endnotes slide, which would put speaker
-- notes in the public presentation. In the future, we can entertain a
-- way of adding a speakernotes-specific note that would just add
-- paragraphs to the bottom of the notes page.
inlineToParElems (Note [Block]
blks) = do
  Bool
inSpNotes <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInSpeakerNotes
  if Bool
inSpNotes
    then forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
    Map Int [Block]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [Block]
stNoteIds
    let maxNoteId :: Int
maxNoteId = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map Int [Block]
notes
        curNoteId :: Int
curNoteId = Int
maxNoteId forall a. Num a => a -> a -> a
+ Int
1
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteIds :: Map Int [Block]
stNoteIds = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
curNoteId [Block]
blks Map Int [Block]
notes }
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
env){rLink :: Maybe LinkTarget
rLink = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SlideId -> LinkTarget
InternalTarget SlideId
endNotesSlideId}}) forall a b. (a -> b) -> a -> b
$
      Inline -> Pres [ParaElem]
inlineToParElems forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript [Text -> Inline
Str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow Int
curNoteId]
inlineToParElems (Span Attr
_ [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Quoted QuoteType
quoteType [Inline]
ils) =
  [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] forall a. [a] -> [a] -> [a]
++ [Inline]
ils forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
close]
  where (Text
open, Text
close) = case QuoteType
quoteType of
                          QuoteType
SingleQuote -> (Text
"\x2018", Text
"\x2019")
                          QuoteType
DoubleQuote -> (Text
"\x201C", Text
"\x201D")
inlineToParElems il :: Inline
il@(RawInline Format
fmt Text
s) =
  case Format
fmt of
    Format Text
"openxml" -> forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> ParaElem
RawOOXMLParaElem Text
s]
    Format
_                -> do LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
                           forall (m :: * -> *) a. Monad m => a -> m a
return []
inlineToParElems (Cite [Citation]
_ [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
-- Note: we shouldn't reach this, because images should be handled at
-- the shape level, but should that change in the future, we render
-- the alt text.
inlineToParElems (Image Attr
_ [Inline]
alt (Text, Text)
_) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
alt



isListType :: Block -> Bool
isListType :: Block -> Bool
isListType (OrderedList ListAttributes
_ [[Block]]
_) = Bool
True
isListType (BulletList [[Block]]
_) = Bool
True
isListType (DefinitionList [([Inline], [[Block]])]
_) = Bool
True
isListType Block
_ = Bool
False

registerAnchorId :: T.Text -> Pres ()
registerAnchorId :: Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
anchor = do
  Map Text SlideId
anchorMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
  SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
anchor) forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st {stAnchorMap :: Map Text SlideId
stAnchorMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor SlideId
sldId Map Text SlideId
anchorMap}

-- Currently hardcoded, until I figure out how to make it dynamic.
blockQuoteSize :: Pixels
blockQuoteSize :: Integer
blockQuoteSize = Integer
20

noteSize :: Pixels
noteSize :: Integer
noteSize = Integer
18

blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs (Plain [Inline]
ils) = Block -> Pres [Paragraph]
blockToParagraphs ([Inline] -> Block
Para [Inline]
ils)
blockToParagraphs (Para [Inline]
ils) = do
  [ParaElem]
parElems <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
blockToParagraphs (LineBlock [[Inline]]
ilsList) = do
  [ParaElem]
parElems <- [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
ilsList
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
-- TODO: work out the attributes
blockToParagraphs (CodeBlock Attr
attr Text
str) = do
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps :: ParaProps
envParaProps = forall a. Default a => a
def{ pPropMarginLeft :: Maybe Integer
pPropMarginLeft = forall a. Maybe a
Nothing
                                    , pPropBullet :: Maybe BulletType
pPropBullet = forall a. Maybe a
Nothing
                                    , pPropLevel :: Int
pPropLevel = ParaProps -> Int
pPropLevel ParaProps
pProps
                                    , pPropIndent :: Maybe Integer
pPropIndent = forall a. a -> Maybe a
Just Integer
0
                                    }
                , envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropCode :: Bool
rPropCode = Bool
True}}) forall a b. (a -> b) -> a -> b
$ do
    Maybe Style
mbSty <- WriterOptions -> Maybe Style
writerHighlightStyle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
    SyntaxMap
synMap <- WriterOptions -> SyntaxMap
writerSyntaxMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
    case Maybe Style
mbSty of
      Just Style
sty ->
        case forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
synMap (Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines Style
sty) Attr
attr Text
str of
          Right [ParaElem]
pElems -> do ParaProps
pPropsNew <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
                             forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pPropsNew [ParaElem]
pElems]
          Left Text
_ -> Block -> Pres [Paragraph]
blockToParagraphs forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Text -> Inline
Str Text
str]
      Maybe Style
Nothing -> Block -> Pres [Paragraph]
blockToParagraphs forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Text -> Inline
Str Text
str]
-- We can't yet do incremental lists, but we should render a
-- (BlockQuote List) as a list to maintain compatibility with other
-- formats.
blockToParagraphs (BlockQuote (Block
blk : [Block]
blks)) | Block -> Bool
isListType Block
blk = do
  [Paragraph]
ps  <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInListInBlockQuote :: Bool
envInListInBlockQuote = Bool
True })
           (Block -> Pres [Paragraph]
blockToParagraphs Block
blk)
  [Paragraph]
ps' <- Block -> Pres [Paragraph]
blockToParagraphs forall a b. (a -> b) -> a -> b
$ [Block] -> Block
BlockQuote [Block]
blks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Paragraph]
ps forall a. [a] -> [a] -> [a]
++ [Paragraph]
ps'
blockToParagraphs (BlockQuote [Block]
blks) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps :: ParaProps
envParaProps = (WriterEnv -> ParaProps
envParaProps WriterEnv
r){ pPropMarginLeft :: Maybe Integer
pPropMarginLeft = forall a. a -> Maybe a
Just Integer
100
                                                 , pPropIndent :: Maybe Integer
pPropIndent = forall a. a -> Maybe a
Just Integer
0
                                                 }
                , envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropForceSize :: Maybe Integer
rPropForceSize = forall a. a -> Maybe a
Just Integer
blockQuoteSize}})forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks
-- TODO: work out the format
blockToParagraphs blk :: Block
blk@(RawBlock Format
_ Text
_) = do LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
                                          forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToParagraphs (Header Int
_ (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
ils) = do
  -- Note that this function only deals with content blocks, so it
  -- will only touch headers that are above the current slide level --
  -- slides at or below the slidelevel will be taken care of by
  -- `blocksToSlide'`. We have the register anchors in both of them.
  Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
  -- we set the subeader to bold
  [ParaElem]
parElems <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
e->WriterEnv
e{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
e){rPropBold :: Bool
rPropBold=Bool
True}}) forall a b. (a -> b) -> a -> b
$
              [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
  -- and give it a bit of space before it.
  forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph forall a. Default a => a
def{pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = forall a. a -> Maybe a
Just Integer
30} [ParaElem]
parElems]
blockToParagraphs (BulletList [[Block]]
blksLst) = do
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  Bool
incremental <- Pres Bool
listShouldBeIncremental
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList :: Bool
envInList = Bool
True
                    , envParaProps :: ParaProps
envParaProps = ParaProps
pProps{ pPropBullet :: Maybe BulletType
pPropBullet = forall a. a -> Maybe a
Just BulletType
Bullet
                                           , pPropMarginLeft :: Maybe Integer
pPropMarginLeft = forall a. Maybe a
Nothing
                                           , pPropIndent :: Maybe Integer
pPropIndent = forall a. Maybe a
Nothing
                                           , pPropIncremental :: Bool
pPropIncremental = Bool
incremental
                                           }}) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM [Block] -> Pres [Paragraph]
multiParList [[Block]]
blksLst
blockToParagraphs (OrderedList ListAttributes
listAttr [[Block]]
blksLst) = do
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  Bool
incremental <- Pres Bool
listShouldBeIncremental
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList :: Bool
envInList = Bool
True
                    , envParaProps :: ParaProps
envParaProps = ParaProps
pProps{ pPropBullet :: Maybe BulletType
pPropBullet = forall a. a -> Maybe a
Just (ListAttributes -> BulletType
AutoNumbering ListAttributes
listAttr)
                                           , pPropMarginLeft :: Maybe Integer
pPropMarginLeft = forall a. Maybe a
Nothing
                                           , pPropIndent :: Maybe Integer
pPropIndent = forall a. Maybe a
Nothing
                                           , pPropIncremental :: Bool
pPropIncremental = Bool
incremental
                                           }}) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM [Block] -> Pres [Paragraph]
multiParList [[Block]]
blksLst
blockToParagraphs (DefinitionList [([Inline], [[Block]])]
entries) = do
  Bool
incremental <- Pres Bool
listShouldBeIncremental
  let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
      go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go ([Inline]
ils, [[Block]]
blksLst) = do
        [Paragraph]
term <-Block -> Pres [Paragraph]
blockToParagraphs forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [[Inline] -> Inline
Strong [Inline]
ils]
        -- For now, we'll treat each definition term as a
        -- blockquote. We can extend this further later.
        [Paragraph]
definition <- forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Block -> Pres [Paragraph]
blockToParagraphs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote) [[Block]]
blksLst
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Paragraph]
term forall a. [a] -> [a] -> [a]
++ [Paragraph]
definition
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envParaProps :: ParaProps
envParaProps =
                       (WriterEnv -> ParaProps
envParaProps WriterEnv
env) {pPropIncremental :: Bool
pPropIncremental = Bool
incremental}})
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ([Inline], [[Block]]) -> Pres [Paragraph]
go [([Inline], [[Block]])]
entries
blockToParagraphs (Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
blks) = let
  hasIncremental :: Bool
hasIncremental = Text
"incremental" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  hasNonIncremental :: Bool
hasNonIncremental = Text
"nonincremental" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  incremental :: Maybe InIncrementalDiv
incremental = if | Bool
hasIncremental -> forall a. a -> Maybe a
Just InIncrementalDiv
InIncremental
                   | Bool
hasNonIncremental -> forall a. a -> Maybe a
Just InIncrementalDiv
InNonIncremental
                   | Bool
otherwise -> forall a. Maybe a
Nothing
  addIncremental :: WriterEnv -> WriterEnv
addIncremental WriterEnv
env = WriterEnv
env { envInIncrementalDiv :: Maybe InIncrementalDiv
envInIncrementalDiv = Maybe InIncrementalDiv
incremental }
  in forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WriterEnv -> WriterEnv
addIncremental (forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks)
blockToParagraphs (Figure Attr
attr Caption
capt [Block]
blks) =
  Block -> Pres [Paragraph]
blockToParagraphs (Attr -> Caption -> [Block] -> Block
Shared.figureDiv Attr
attr Caption
capt [Block]
blks)
blockToParagraphs hr :: Block
hr@Block
HorizontalRule = Block -> Pres [Paragraph]
notRendered Block
hr
blockToParagraphs tbl :: Block
tbl@Table{} = Block -> Pres [Paragraph]
notRendered Block
tbl

-- | Report that a block cannot be rendered.
notRendered :: Block -> Pres [Paragraph]
notRendered :: Block -> Pres [Paragraph]
notRendered Block
blk = do
  LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
  forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Make sure the bullet env gets turned off after the first para.
multiParList :: [Block] -> Pres [Paragraph]
multiParList :: [Block] -> Pres [Paragraph]
multiParList [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
multiParList (Block
b:[Block]
bs) = do
  ParaProps
pProps <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  [Paragraph]
p <- Block -> Pres [Paragraph]
blockToParagraphs Block
b
  let level :: Int
level = ParaProps -> Int
pPropLevel ParaProps
pProps
  [Paragraph]
ps <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env
                { envParaProps :: ParaProps
envParaProps = ParaProps
pProps
                  { pPropBullet :: Maybe BulletType
pPropBullet = forall a. Maybe a
Nothing
                  , pPropLevel :: Int
pPropLevel = Int
level forall a. Num a => a -> a -> a
+ Int
1
                  }
                })
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Paragraph]
p forall a. [a] -> [a] -> [a]
++ [Paragraph]
ps

cellToParagraphs :: Alignment -> SimpleCell -> Pres [Paragraph]
cellToParagraphs :: Alignment -> [Block] -> Pres [Paragraph]
cellToParagraphs Alignment
algn [Block]
tblCell = do
  [[Paragraph]]
paras <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
tblCell
  let alignment :: Maybe Algnment
alignment = case Alignment
algn of
        Alignment
AlignLeft -> forall a. a -> Maybe a
Just Algnment
AlgnLeft
        Alignment
AlignRight -> forall a. a -> Maybe a
Just Algnment
AlgnRight
        Alignment
AlignCenter -> forall a. a -> Maybe a
Just Algnment
AlgnCenter
        Alignment
AlignDefault -> forall a. Maybe a
Nothing
      paras' :: [[Paragraph]]
paras' = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
p -> Paragraph
p{paraProps :: ParaProps
paraProps = (Paragraph -> ParaProps
paraProps Paragraph
p){pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
alignment}})) [[Paragraph]]
paras
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Paragraph]]
paras'

rowToParagraphs :: [Alignment] -> [SimpleCell] -> Pres [[Paragraph]]
rowToParagraphs :: [Alignment] -> [[Block]] -> Pres [[Paragraph]]
rowToParagraphs [Alignment]
algns [[Block]]
tblCells = do
  -- We have to make sure we have the right number of alignments
  let pairs :: [(Alignment, [Block])]
pairs = forall a b. [a] -> [b] -> [(a, b)]
zip ([Alignment]
algns forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Alignment
AlignDefault) [[Block]]
tblCells
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Alignment -> [Block] -> Pres [Paragraph]
cellToParagraphs) [(Alignment, [Block])]
pairs

withAttr :: Attr -> Shape -> Shape
withAttr :: Attr -> Shape -> Shape
withAttr Attr
attr (Pic PicProps
picPr String
url Text
title [ParaElem]
caption) =
  let picPr' :: PicProps
picPr' = PicProps
picPr { picWidth :: Maybe Dimension
picWidth = Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr
                     , picHeight :: Maybe Dimension
picHeight = Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr
                     }
  in
    PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
picPr' String
url Text
title [ParaElem]
caption
withAttr Attr
_ Shape
sp = Shape
sp

blockToShape :: Block -> Pres Shape
blockToShape :: Block -> Pres Shape
blockToShape (Plain [Inline]
ils) = Block -> Pres Shape
blockToShape ([Inline] -> Block
Para [Inline]
ils)
blockToShape (Para (Inline
il:[Inline]
_))  | Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il =
      Attr -> Shape -> Shape
withAttr Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PicProps -> String -> Text -> [ParaElem] -> Shape
Pic forall a. Default a => a
def (Text -> String
T.unpack Text
url) Text
title forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
blockToShape (Para (Inline
il:[Inline]
_))  | Link Attr
_ (Inline
il':[Inline]
_) (Text, Text)
target <- Inline
il
                            , Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il' =
      Attr -> Shape -> Shape
withAttr Attr
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      PicProps -> String -> Text -> [ParaElem] -> Shape
Pic forall a. Default a => a
def{picPropLink :: Maybe LinkTarget
picPropLink = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Text, Text) -> LinkTarget
ExternalTarget (Text, Text)
target} (Text -> String
T.unpack Text
url) Text
title
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
blockToShape (Figure Attr
_figattr Caption
_caption [Block
b]) = Block -> Pres Shape
blockToShape Block
b
blockToShape (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
algn, [Double]
_, [[Block]]
hdrCells, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  [ParaElem]
caption' <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
caption
  [[Paragraph]]
hdrCells' <- [Alignment] -> [[Block]] -> Pres [[Paragraph]]
rowToParagraphs [Alignment]
algn [[Block]]
hdrCells
  [[[Paragraph]]]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Alignment] -> [[Block]] -> Pres [[Paragraph]]
rowToParagraphs [Alignment]
algn) [[[Block]]]
rows
  let tblPr :: TableProps
tblPr = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
hdrCells
              then TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
False
                              , tblPrBandRow :: Bool
tblPrBandRow = Bool
True
                              }
              else TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
True
                              , tblPrBandRow :: Bool
tblPrBandRow = Bool
True
                              }

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Graphic] -> [ParaElem] -> Shape
GraphicFrame [TableProps -> [[Paragraph]] -> [[[Paragraph]]] -> Graphic
Tbl TableProps
tblPr [[Paragraph]]
hdrCells' [[[Paragraph]]]
rows'] [ParaElem]
caption'
-- If the format isn't openxml, we fall through to blockToPargraphs
blockToShape (RawBlock (Format Text
"openxml") Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Shape
RawOOXMLShape Text
str
blockToShape Block
blk = do [Paragraph]
paras <- Block -> Pres [Paragraph]
blockToParagraphs Block
blk
                      let paras' :: [Paragraph]
paras' = forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
par -> Paragraph
par{paraElems :: [ParaElem]
paraElems = [ParaElem] -> [ParaElem]
combineParaElems forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
par}) [Paragraph]
paras
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox [Paragraph]
paras'

combineShapes :: [Shape] -> [Shape]
combineShapes :: [Shape] -> [Shape]
combineShapes [] = []
combineShapes (pic :: Shape
pic@Pic{} : [Shape]
ss) = Shape
pic forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (Shape
s : TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes (Shape
s forall a. a -> [a] -> [a]
: [Shape]
ss)
combineShapes (TextBox (Paragraph
p:[Paragraph]
ps) : TextBox (Paragraph
p':[Paragraph]
ps') : [Shape]
ss) =
  [Shape] -> [Shape]
combineShapes forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox ((Paragraph
pforall a. a -> [a] -> [a]
:[Paragraph]
ps) forall a. [a] -> [a] -> [a]
++ (Paragraph
p'forall a. a -> [a] -> [a]
:[Paragraph]
ps')) forall a. a -> [a] -> [a]
: [Shape]
ss
combineShapes (Shape
s:[Shape]
ss) = Shape
s forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss

isNotesDiv :: Block -> Bool
isNotesDiv :: Block -> Bool
isNotesDiv (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
_) = Bool
True
isNotesDiv Block
_ = Bool
False

blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes [Block]
blks = [Shape] -> [Shape]
combineShapes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Pres Shape
blockToShape [Block]
blks

isImage :: Inline -> Bool
isImage :: Inline -> Bool
isImage Image{} = Bool
True
isImage (Link Attr
_ (Image{} : [Inline]
_) (Text, Text)
_) = Bool
True
isImage Inline
_ = Bool
False

plainOrPara :: Block -> Maybe [Inline]
plainOrPara :: Block -> Maybe [Inline]
plainOrPara (Plain [Inline]
ils) = forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara (Para [Inline]
ils) = forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara Block
_ = forall a. Maybe a
Nothing

notText :: Block -> Bool
notText :: Block -> Bool
notText Block
block | Block -> Bool
startsWithImage Block
block = Bool
True
notText Table{} = Bool
True
notText Block
_ = Bool
False

startsWithImage :: Block -> Bool
startsWithImage :: Block -> Bool
startsWithImage Block
block = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
  Inline
inline <- Block -> Maybe [Inline]
plainOrPara Block
block forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe a
listToMaybe
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> Bool
isImage Inline
inline)

-- | Group blocks into a number of "splits"
splitBlocks' ::
  -- | Blocks so far in the current split
  [Block] ->
  -- | Splits so far
  [[Block]] ->
  -- | All remaining blocks
  [Block] ->
  Pres [[Block]]
splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [Block]
cur [[Block]]
acc [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])
splitBlocks' [Block]
cur [[Block]]
acc (Block
HorizontalRule : [Block]
blks) =
  [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks
splitBlocks' [Block]
cur [[Block]]
acc (h :: Block
h@(Header Int
n Attr
_ [Inline]
_) : [Block]
blks) = do
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case forall a. Ord a => a -> a -> Ordering
compare Int
n Int
slideLevel of
    Ordering
LT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) forall a. [a] -> [a] -> [a]
++ [Block
h forall a. a -> [a] -> [a]
: [Block]
nts]) [Block]
blks'
    Ordering
EQ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' (Block
hforall a. a -> [a] -> [a]
:[Block]
nts) ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks'
    Ordering
GT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' ([Block]
cur forall a. [a] -> [a] -> [a]
++ (Block
hforall a. a -> [a] -> [a]
:[Block]
nts)) [[Block]]
acc [Block]
blks'
-- `blockToParagraphs` treats Plain and Para the same, so we can save
-- some code duplication by treating them the same here.
splitBlocks' [Block]
cur [[Block]]
acc (Plain [Inline]
ils : [Block]
blks) = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [Block]
cur [[Block]]
acc ([Inline] -> Block
Para [Inline]
ils forall a. a -> [a] -> [a]
: [Block]
blks)
splitBlocks' [Block]
cur [[Block]]
acc (Para (Inline
il:[Inline]
ils) : [Block]
blks) | Inline -> Bool
isImage Inline
il = do
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
                     then forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
                     else ([], [Block]
blks)
  case [Block]
cur of
    [Header Int
n Attr
_ [Inline]
_] | Int
n forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
                            ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ [[Block]
cur forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] forall a. [a] -> [a] -> [a]
++ [Block]
nts])
                            (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils forall a. a -> [a] -> [a]
: [Block]
blks')
    [Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
         (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
          then [[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il] forall a. a -> [a] -> [a]
: [Block]
nts]
          else [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [[Block]
cur forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] forall a. [a] -> [a] -> [a]
++ [Block]
nts])
         (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils forall a. a -> [a] -> [a]
: [Block]
blks')
splitBlocks' [Block]
cur [[Block]]
acc (tbl :: Block
tbl@Table{} : [Block]
blks) = do
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case [Block]
cur of
    [Header Int
n Attr
_ [Inline]
_] | Int
n forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ [[Block]
cur forall a. [a] -> [a] -> [a]
++ [Block
tbl] forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
    [Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
         (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
          then [[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) forall a. [a] -> [a] -> [a]
++ [Block
tbl forall a. a -> [a] -> [a]
: [Block]
nts]
          else [[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur forall a. [a] -> [a] -> [a]
++ [Block
tbl] forall a. [a] -> [a] -> [a]
++ [Block]
nts]))
         [Block]
blks'
splitBlocks' [Block]
cur [[Block]]
acc (d :: Block
d@(Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
_): [Block]
blks) | Text
"columns" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes =  do
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case [Block]
cur of
    [Header Int
n Attr
_ [Inline]
_] | Int
n forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ [[Block]
cur forall a. [a] -> [a] -> [a]
++ [Block
d] forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
    [Block]
_ ->  [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) forall a. [a] -> [a] -> [a]
++ [Block
d forall a. a -> [a] -> [a]
: [Block]
nts]) [Block]
blks'
splitBlocks' [Block]
cur [[Block]]
acc (Block
blk : [Block]
blks) = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' ([Block]
cur forall a. [a] -> [a] -> [a]
++ [Block
blk]) [[Block]]
acc [Block]
blks

splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] []

-- | Assuming the slide title is already handled, convert these blocks to the
-- body content for the slide.
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
_ (Block
blk : [Block]
blks) SpeakerNotes
spkNotes
  | Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
divBlks <- Block
blk
  , Text
"columns" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  , Div (Text
_, [Text]
clsL, [(Text, Text)]
_) [Block]
blksL : Div (Text
_, [Text]
clsR, [(Text, Text)]
_) [Block]
blksR : [Block]
remaining <- [Block]
divBlks
  , Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsL, Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsR = do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> LogMessage
BlockNotRendered) ([Block]
blks forall a. [a] -> [a] -> [a]
++ [Block]
remaining)
      let mkTwoColumn :: [Block] -> [Block] -> Pres Slide
mkTwoColumn [Block]
left [Block]
right = do
            [Block]
blksL' <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [[Block]]
splitBlocks [Block]
left
            [Block]
blksR' <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [[Block]]
splitBlocks [Block]
right
            [Shape]
shapesL <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL'
            [Shape]
shapesR <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR'
            SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
              SlideId
sldId
              ([ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [] [Shape]
shapesL [Shape]
shapesR)
              SpeakerNotes
spkNotes
              forall a. Maybe a
Nothing
      let mkComparison :: [Block] -> [Block] -> [Block] -> [Block] -> Pres Slide
mkComparison [Block]
blksL1  [Block]
blksL2 [Block]
blksR1 [Block]
blksR2 = do
            [Shape]
shapesL1 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL1
            [Shape]
shapesL2 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL2
            [Shape]
shapesR1 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR1
            [Shape]
shapesR2 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR2
            SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
              SlideId
sldId
              ([ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [] ([Shape]
shapesL1, [Shape]
shapesL2) ([Shape]
shapesR1, [Shape]
shapesR2))
              SpeakerNotes
spkNotes
              forall a. Maybe a
Nothing
      let ([Block]
blksL1, [Block]
blksL2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksL
          ([Block]
blksR1, [Block]
blksR2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksR
      if (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]
blksL1, [Block]
blksL2]) Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]
blksR1, [Block]
blksR2])
      then [Block] -> [Block] -> Pres Slide
mkTwoColumn [Block]
blksL [Block]
blksR
      else [Block] -> [Block] -> [Block] -> [Block] -> Pres Slide
mkComparison [Block]
blksL1 [Block]
blksL2 [Block]
blksR1 [Block]
blksR2
bodyBlocksToSlide Int
_ (Block
blk : [Block]
blks) SpeakerNotes
spkNotes = do
      SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
      Bool
inNoteSlide <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInNoteSlide
      let mkSlide :: Layout -> Slide
mkSlide Layout
s =
            SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
s SpeakerNotes
spkNotes forall a. Maybe a
Nothing
      if Bool
inNoteSlide
      then Layout -> Slide
mkSlide forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          forall a. Integer -> Pres a -> Pres a
forceFontSize Integer
noteSize ([Block] -> Pres [Shape]
blocksToShapes (Block
blk forall a. a -> [a] -> [a]
: [Block]
blks))
      else let
        contentOrBlankSlide :: Pres Slide
contentOrBlankSlide =
          if [Block] -> Bool
makesBlankSlide (Block
blk forall a. a -> [a] -> [a]
: [Block]
blks)
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Layout -> Slide
mkSlide Layout
BlankSlide)
          else Layout -> Slide
mkSlide forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [Shape]
blocksToShapes (Block
blk forall a. a -> [a] -> [a]
: [Block]
blks)
        in case forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText (Block
blk forall a. a -> [a] -> [a]
: [Block]
blks) of
          ([], [Block]
_) -> Pres Slide
contentOrBlankSlide
          ([Block]
_, []) -> Pres Slide
contentOrBlankSlide
          ([Block]
textBlocks, [Block]
contentBlocks) -> do
            [Shape]
textShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
textBlocks
            [Shape]
contentShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
contentBlocks
            forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> Slide
mkSlide ([ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [] [Shape]
textShapes [Shape]
contentShapes))
bodyBlocksToSlide Int
_ [] SpeakerNotes
spkNotes = do
  SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
    SlideId
sldId
    Layout
BlankSlide
    SpeakerNotes
spkNotes
    forall a. Maybe a
Nothing

blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' Int
lvl (Header Int
n (Text
ident, [Text]
_, [(Text, Text)]
attributes) [Inline]
ils : [Block]
blks) SpeakerNotes
spkNotes
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
lvl = do
      Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
      SlideId
sldId <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
      [ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId ([ParaElem] -> Layout
TitleSlide [ParaElem]
hdr) SpeakerNotes
spkNotes Maybe String
backgroundImage
  | Int
n forall a. Eq a => a -> a -> Bool
== Int
lvl Bool -> Bool -> Bool
|| Int
lvl forall a. Eq a => a -> a -> Bool
== Int
0 = do
      Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
      [ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
      -- Now get the slide without the header, and then add the header
      -- in.
      Slide
slide <- Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes
      let layout :: Layout
layout = case Slide -> Layout
slideLayout Slide
slide of
            ContentSlide [ParaElem]
_ [Shape]
cont          -> [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr [Shape]
cont
            TwoColumnSlide [ParaElem]
_ [Shape]
contL [Shape]
contR -> [ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [ParaElem]
hdr [Shape]
contL [Shape]
contR
            ComparisonSlide [ParaElem]
_ ([Shape], [Shape])
contL ([Shape], [Shape])
contR -> [ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [ParaElem]
hdr ([Shape], [Shape])
contL ([Shape], [Shape])
contR
            ContentWithCaptionSlide [ParaElem]
_ [Shape]
text [Shape]
content -> [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr [Shape]
text [Shape]
content
            Layout
BlankSlide -> if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ils then Layout
BlankSlide else [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr []
            Layout
layout'                     -> Layout
layout'
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Slide
slide{slideLayout :: Layout
slideLayout = Layout
layout, slideBackgroundImage :: Maybe String
slideBackgroundImage = Maybe String
backgroundImage}
  where
    backgroundImage :: Maybe String
backgroundImage = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"background-image" [(Text, Text)]
attributes
                                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-background-image" [(Text, Text)]
attributes)
blocksToSlide' Int
lvl [Block]
blks SpeakerNotes
spkNotes = Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes

blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
blks) =
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envInSpeakerNotes :: Bool
envInSpeakerNotes=Bool
True}) forall a b. (a -> b) -> a -> b
$
  [Paragraph] -> SpeakerNotes
SpeakerNotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks
blockToSpeakerNotes Block
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

handleSpeakerNotes :: Block -> Pres ()
handleSpeakerNotes :: Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes Block
blk = do
  SpeakerNotes
spNotes <- Block -> Pres SpeakerNotes
blockToSpeakerNotes Block
blk
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = WriterState -> SpeakerNotes
stSpeakerNotes WriterState
st forall a. Semigroup a => a -> a -> a
<> SpeakerNotes
spNotes}

handleAndFilterSpeakerNotes' :: [Block] -> Pres [Block]
handleAndFilterSpeakerNotes' :: [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes [Block]
blks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isNotesDiv) [Block]
blks

handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = forall a. Monoid a => a
mempty}
  [Block]
blks' <- forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks
  SpeakerNotes
spkNotes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> SpeakerNotes
stSpeakerNotes
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Block]
blks', SpeakerNotes
spkNotes)

blocksToSlide :: [Block] -> Pres Slide
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide [Block]
blks = do
  ([Block]
blks', SpeakerNotes
spkNotes) <- [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' Int
slideLevel [Block]
blks' SpeakerNotes
spkNotes

makeNoteEntry :: (Int, [Block]) -> [Block]
makeNoteEntry :: (Int, [Block]) -> [Block]
makeNoteEntry (Int
n, [Block]
blks) =
  let enum :: Inline
enum = Text -> Inline
Str (forall a. Show a => a -> Text
tshow Int
n forall a. Semigroup a => a -> a -> a
<> Text
".")
  in
    case [Block]
blks of
      (Para [Inline]
ils : [Block]
blks') -> [Inline] -> Block
Para (Inline
enum forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
ils) forall a. a -> [a] -> [a]
: [Block]
blks'
      [Block]
_ -> [Inline] -> Block
Para [Inline
enum] forall a. a -> [a] -> [a]
: [Block]
blks

forceFontSize :: Pixels -> Pres a -> Pres a
forceFontSize :: forall a. Integer -> Pres a -> Pres a
forceFontSize Integer
px Pres a
x = do
  RunProps
rpr <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
  forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r {envRunProps :: RunProps
envRunProps = RunProps
rpr{rPropForceSize :: Maybe Integer
rPropForceSize = forall a. a -> Maybe a
Just Integer
px}}) Pres a
x

-- We leave these as blocks because we will want to include them in
-- the TOC.
makeEndNotesSlideBlocks :: Pres [Block]
makeEndNotesSlideBlocks :: ReaderT WriterEnv (State WriterState) [Block]
makeEndNotesSlideBlocks = do
  Map Int [Block]
noteIds <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [Block]
stNoteIds
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  Extensions
exts <- WriterOptions -> Extensions
writerExtensions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
  Meta
meta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
  -- Get identifiers so we can give the notes section a unique ident.
  Set Text
anchorSet <- forall k a. Map k a -> Set k
M.keysSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
  if forall k a. Map k a -> Bool
M.null Map Int [Block]
noteIds
    then forall (m :: * -> *) a. Monad m => a -> m a
return []
    else let title :: [Inline]
title = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"notes-title" Meta
meta of
                       [] -> [Text -> Inline
Str Text
"Notes"]
                       [Inline]
ls -> [Inline]
ls
             ident :: Text
ident = Extensions -> [Inline] -> Set Text -> Text
Shared.uniqueIdent Extensions
exts [Inline]
title Set Text
anchorSet
             hdr :: Block
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel (Text
ident, [], []) [Inline]
title
             blks :: [Block]
blks = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [Block]) -> [Block]
makeNoteEntry forall a b. (a -> b) -> a -> b
$
                    forall k a. Map k a -> [(k, a)]
M.toList Map Int [Block]
noteIds
         in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Block
hdr forall a. a -> [a] -> [a]
: [Block]
blks

getMetaSlide :: Pres (Maybe Slide)
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide  = do
  Meta
meta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
  [ParaElem]
title <- [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  [ParaElem]
subtitle <- [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
  [[ParaElem]]
authors <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  [ParaElem]
date <- [Inline] -> Pres [ParaElem]
inlinesToParElems forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
title Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitle Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ParaElem]]
authors Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
date
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
         SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
         SlideId
metadataSlideId
         ([ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> Layout
MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date)
         forall a. Monoid a => a
mempty
         forall a. Maybe a
Nothing

addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide (Slide SlideId
sldId layout :: Layout
layout@MetadataSlide{} SpeakerNotes
spkNotes Maybe String
backgroundImage) [Block]
blks =
  do let ([Block]
ntsBlks, [Block]
blks') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
     SpeakerNotes
spkNotes' <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Pres SpeakerNotes
blockToSpeakerNotes [Block]
ntsBlks
     forall (m :: * -> *) a. Monad m => a -> m a
return (SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
layout (SpeakerNotes
spkNotes forall a. Semigroup a => a -> a -> a
<> SpeakerNotes
spkNotes') Maybe String
backgroundImage, [Block]
blks')
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks = forall (m :: * -> *) a. Monad m => a -> m a
return (Slide
sld, [Block]
blks)

makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide [Block]
blks = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId :: SlideId
envCurSlideId = SlideId
tocSlideId}) forall a b. (a -> b) -> a -> b
$ do
  WriterOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
  let contents :: Block
contents = WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
blks
  Meta
meta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
  Int
slideLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let tocTitle :: [Inline]
tocTitle = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"toc-title" Meta
meta of
                   [] -> [Text -> Inline
Str Text
"Table of Contents"]
                   [Inline]
ls -> [Inline]
ls
      hdr :: Block
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel Attr
nullAttr [Inline]
tocTitle
  [Block] -> Pres Slide
blocksToSlide [Block
hdr, Block
contents]

combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' Maybe ParaElem
mbPElem [] = forall a. Maybe a -> [a]
maybeToList Maybe ParaElem
mbPElem
combineParaElems' Maybe ParaElem
Nothing (ParaElem
pElem : [ParaElem]
pElems) =
  Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems
combineParaElems' (Just ParaElem
pElem') (ParaElem
pElem : [ParaElem]
pElems)
  | Run RunProps
rPr' Text
s' <- ParaElem
pElem'
  , Run RunProps
rPr Text
s <- ParaElem
pElem
  , RunProps
rPr forall a. Eq a => a -> a -> Bool
== RunProps
rPr' =
    Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rPr' forall a b. (a -> b) -> a -> b
$ Text
s' forall a. Semigroup a => a -> a -> a
<> Text
s) [ParaElem]
pElems
  | Bool
otherwise =
    ParaElem
pElem' forall a. a -> [a] -> [a]
: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems

combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems = Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' forall a. Maybe a
Nothing

applyToParagraph :: Monad m => (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f Paragraph
para = do
  [ParaElem]
paraElems' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Paragraph
para {paraElems :: [ParaElem]
paraElems = [ParaElem]
paraElems'}

applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f (Pic PicProps
pPr String
fp Text
title [ParaElem]
pes) = PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
pPr String
fp Text
title forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (GraphicFrame [Graphic]
gfx [ParaElem]
pes) = [Graphic] -> [ParaElem] -> Shape
GraphicFrame [Graphic]
gfx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (TextBox [Paragraph]
paras) = [Paragraph] -> Shape
TextBox forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
applyToShape ParaElem -> m ParaElem
_ (RawOOXMLShape Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Shape
RawOOXMLShape Text
str

applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f (MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date) = do
  [ParaElem]
title' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
title
  [ParaElem]
subtitle' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
subtitle
  [[ParaElem]]
authors' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f) [[ParaElem]]
authors
  [ParaElem]
date' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
date
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> Layout
MetadataSlide [ParaElem]
title' [ParaElem]
subtitle' [[ParaElem]]
authors' [ParaElem]
date'
applyToLayout ParaElem -> m ParaElem
f (TitleSlide [ParaElem]
title) = [ParaElem] -> Layout
TitleSlide forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
title
applyToLayout ParaElem -> m ParaElem
f (ContentSlide [ParaElem]
hdr [Shape]
content) = do
  [ParaElem]
hdr' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
content' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
content
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr' [Shape]
content'
applyToLayout ParaElem -> m ParaElem
f (TwoColumnSlide [ParaElem]
hdr [Shape]
contentL [Shape]
contentR) = do
  [ParaElem]
hdr' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
contentL' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL
  [Shape]
contentR' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [ParaElem]
hdr' [Shape]
contentL' [Shape]
contentR'
applyToLayout ParaElem -> m ParaElem
f (ComparisonSlide [ParaElem]
hdr ([Shape]
contentL1, [Shape]
contentL2) ([Shape]
contentR1, [Shape]
contentR2)) = do
  [ParaElem]
hdr' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
contentL1' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL1
  [Shape]
contentL2' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL2
  [Shape]
contentR1' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR1
  [Shape]
contentR2' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR2
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [ParaElem]
hdr' ([Shape]
contentL1', [Shape]
contentL2') ([Shape]
contentR1', [Shape]
contentR2')
applyToLayout ParaElem -> m ParaElem
f (ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes) = do
  [ParaElem]
hdr' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
textShapes' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
textShapes
  [Shape]
contentShapes' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentShapes
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr' [Shape]
textShapes' [Shape]
contentShapes'
applyToLayout ParaElem -> m ParaElem
_ Layout
BlankSlide = forall (f :: * -> *) a. Applicative f => a -> f a
pure Layout
BlankSlide

applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide ParaElem -> m ParaElem
f Slide
slide = do
  Layout
layout' <- forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f forall a b. (a -> b) -> a -> b
$ Slide -> Layout
slideLayout Slide
slide
  let paras :: [Paragraph]
paras = SpeakerNotes -> [Paragraph]
fromSpeakerNotes forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide
  SpeakerNotes
notes' <- [Paragraph] -> SpeakerNotes
SpeakerNotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
  forall (m :: * -> *) a. Monad m => a -> m a
return Slide
slide{slideLayout :: Layout
slideLayout = Layout
layout', slideSpeakerNotes :: SpeakerNotes
slideSpeakerNotes = SpeakerNotes
notes'}

replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor (Run RunProps
rProps Text
s)
  | Just (ExternalTarget (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
anchor), Text
_)) <- RunProps -> Maybe LinkTarget
rLink RunProps
rProps
  = do
      Map Text SlideId
anchorMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
      -- If the anchor is not in the anchormap, we just remove the
      -- link.
      let rProps' :: RunProps
rProps' = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
anchor Map Text SlideId
anchorMap of
                      Just SlideId
n  -> RunProps
rProps{rLink :: Maybe LinkTarget
rLink = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SlideId -> LinkTarget
InternalTarget SlideId
n}
                      Maybe SlideId
Nothing -> RunProps
rProps{rLink :: Maybe LinkTarget
rLink = forall a. Maybe a
Nothing}
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
s
replaceAnchor ParaElem
pe = forall (m :: * -> *) a. Monad m => a -> m a
return ParaElem
pe

emptyParaElem :: ParaElem -> Bool
emptyParaElem :: ParaElem -> Bool
emptyParaElem (Run RunProps
_ Text
s) =
  Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim Text
s
emptyParaElem (MathElem MathType
_ TeXString
ts) =
  Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim forall a b. (a -> b) -> a -> b
$ TeXString -> Text
unTeXString TeXString
ts
emptyParaElem ParaElem
_ = Bool
False

emptyParagraph :: Paragraph -> Bool
emptyParagraph :: Paragraph -> Bool
emptyParagraph Paragraph
para = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para


emptyShape :: Shape -> Bool
emptyShape :: Shape -> Bool
emptyShape (TextBox [Paragraph]
paras) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Paragraph -> Bool
emptyParagraph [Paragraph]
paras
emptyShape Shape
_ = Bool
False

emptyLayout :: Layout -> Bool
emptyLayout :: Layout -> Bool
emptyLayout Layout
layout = case Layout
layout of
  MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date ->
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
title Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
subtitle Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem) [[ParaElem]]
authors Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
date
  TitleSlide [ParaElem]
hdr -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr
  ContentSlide [ParaElem]
hdr [Shape]
shapes ->
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes
  TwoColumnSlide [ParaElem]
hdr [Shape]
shapes1 [Shape]
shapes2 ->
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes1 Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes2
  ComparisonSlide [ParaElem]
hdr ([Shape]
shapesL1, [Shape]
shapesL2) ([Shape]
shapesR1, [Shape]
shapesR2) ->
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL1 Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL2 Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR1 Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR2
  ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes ->
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
textShapes Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
contentShapes
  Layout
BlankSlide -> Bool
False


emptySlide :: Slide -> Bool
emptySlide :: Slide -> Bool
emptySlide (Slide SlideId
_ Layout
layout SpeakerNotes
notes Maybe String
backgroundImage)
  = (SpeakerNotes
notes forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty)
  Bool -> Bool -> Bool
&& Layout -> Bool
emptyLayout Layout
layout
  Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe String
backgroundImage

makesBlankSlide :: [Block] -> Bool
makesBlankSlide :: [Block] -> Bool
makesBlankSlide = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank

blockIsBlank :: Block -> Bool
blockIsBlank :: Block -> Bool
blockIsBlank
  = \case
      Plain [Inline]
ins -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      Para [Inline]
ins -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      LineBlock [[Inline]]
inss -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank) [[Inline]]
inss
      CodeBlock Attr
_ Text
txt -> Text -> Bool
textIsBlank Text
txt
      RawBlock Format
_ Text
txt -> Text -> Bool
textIsBlank Text
txt
      BlockQuote [Block]
bls -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      OrderedList ListAttributes
_ [[Block]]
blss -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
      BulletList [[Block]]
blss -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
      DefinitionList [([Inline], [[Block]])]
ds -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank) (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank))) [([Inline], [[Block]])]
ds
      Header Int
_ Attr
_ [Inline]
ils -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ils
      Block
HorizontalRule -> Bool
True
      Figure Attr
_ Caption
_ [Block]
bls -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      Table{} -> Bool
False
      Div Attr
_ [Block]
bls -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls

textIsBlank :: T.Text -> Bool
textIsBlank :: Text -> Bool
textIsBlank = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace

inlineIsBlank :: Inline -> Bool
inlineIsBlank :: Inline -> Bool
inlineIsBlank
  = \case
      (Str Text
txt) -> Text -> Bool
textIsBlank Text
txt
      (Emph [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Underline [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Strong [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Strikeout [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Superscript [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Subscript [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (SmallCaps [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Quoted QuoteType
_ [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Cite [Citation]
_ [Inline]
_) -> Bool
False
      (Code Attr
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
      Inline
Space -> Bool
True
      Inline
SoftBreak -> Bool
True
      Inline
LineBreak -> Bool
True
      (Math MathType
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
      (RawInline Format
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
      (Link Attr
_ [Inline]
ins (Text
t1, Text
t2)) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t1 Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t2
      (Image Attr
_ [Inline]
ins (Text
t1, Text
t2)) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t1 Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t2
      (Note [Block]
bls) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      (Span Attr
_ [Inline]
ins) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins

blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides [Block]
blks = do
  WriterOptions
opts <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
  Maybe Slide
mbMetadataSlide <- Pres (Maybe Slide)
getMetaSlide
  -- if the metadata slide exists, we try to add any speakerNotes
  -- which immediately follow it. We also convert from maybe to a
  -- list, so that it will be able to add together more easily with
  -- the other lists of slides.
  ([Slide]
metadataslides, [Block]
blks') <- case Maybe Slide
mbMetadataSlide of
                                 Just Slide
sld ->
                                   do (Slide
s, [Block]
bs) <- Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks
                                      forall (m :: * -> *) a. Monad m => a -> m a
return ([Slide
s], [Block]
bs)
                                 Maybe Slide
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Block]
blks)
  -- As far as I can tell, if we want to have a variable-length toc in
  -- the future, we'll have to make it twice. Once to get the length,
  -- and a second time to include the notes slide. We can't make the
  -- notes slide before the body slides because we need to know if
  -- there are notes, and we can't make either before the toc slide,
  -- because we need to know its length to get slide numbers right.
  --
  -- For now, though, since the TOC slide is only length 1, if it
  -- exists, we'll just get the length, and then come back to make the
  -- slide later
  [[Block]]
blksLst <- [Block] -> Pres [[Block]]
splitBlocks [Block]
blks'
  [SlideId]
bodySlideIds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                  (\Integer
n -> Text -> Pres SlideId
runUniqueSlideId forall a b. (a -> b) -> a -> b
$ Text
"BodySlide" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Integer
n)
                  (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
blksLst) [Integer
1..] :: [Integer])
  [Slide]
bodyslides <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                (\([Block]
bs, SlideId
ident) ->
                    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
st -> WriterEnv
st{envCurSlideId :: SlideId
envCurSlideId = SlideId
ident}) ([Block] -> Pres Slide
blocksToSlide [Block]
bs))
                (forall a b. [a] -> [b] -> [(a, b)]
zip [[Block]]
blksLst [SlideId]
bodySlideIds)
  [Block]
endNotesSlideBlocks <- ReaderT WriterEnv (State WriterState) [Block]
makeEndNotesSlideBlocks
  -- now we come back and make the real toc...
  [Slide]
tocSlides <- if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts
               then do Slide
toc <- [Block] -> Pres Slide
makeTOCSlide forall a b. (a -> b) -> a -> b
$ [Block]
blks' forall a. [a] -> [a] -> [a]
++ [Block]
endNotesSlideBlocks
                       forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
toc]
               else forall (m :: * -> *) a. Monad m => a -> m a
return []
  -- ... and the notes slide. We test to see if the blocks are empty,
  -- because we don't want to make an empty slide.
  [Slide]
endNotesSlides <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
endNotesSlideBlocks
                    then forall (m :: * -> *) a. Monad m => a -> m a
return []
                    else do Slide
endNotesSlide <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                              (\WriterEnv
env -> WriterEnv
env { envCurSlideId :: SlideId
envCurSlideId = SlideId
endNotesSlideId
                                           , envInNoteSlide :: Bool
envInNoteSlide = Bool
True
                                           })
                              ([Block] -> Pres Slide
blocksToSlide [Block]
endNotesSlideBlocks)
                            forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
endNotesSlide]

  let slides :: [Slide]
slides = [Slide]
metadataslides forall a. [a] -> [a] -> [a]
++ [Slide]
tocSlides forall a. [a] -> [a] -> [a]
++ [Slide]
bodyslides forall a. [a] -> [a] -> [a]
++ [Slide]
endNotesSlides
      slides' :: [Slide]
slides' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slide -> Bool
emptySlide) [Slide]
slides
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide ParaElem -> Pres ParaElem
replaceAnchor) [Slide]
slides'

metaToDocProps :: Meta -> DocProps
metaToDocProps :: Meta -> DocProps
metaToDocProps Meta
meta =
  let keywords :: Maybe [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"keywords" Meta
meta of
                   Just (MetaList [MetaValue]
xs) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
Shared.stringify [MetaValue]
xs
                   Maybe MetaValue
_                  -> forall a. Maybe a
Nothing

      authors :: Maybe Text
authors = case forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
Shared.stringify forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta of
                  [] -> forall a. Maybe a
Nothing
                  [Text]
ss -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
ss

      description :: Maybe Text
description = case forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
Shared.stringify forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta of
                  [] -> forall a. Maybe a
Nothing
                  [Text]
ss -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"_x000d_\n" [Text]
ss

      customProperties' :: Maybe [(Text, Text)]
customProperties' = case [(Text
k, Text -> Meta -> Text
lookupMetaString Text
k Meta
meta) | Text
k <- forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
                               , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"title", Text
"author", Text
"keywords", Text
"description"
                                             , Text
"subject",Text
"lang",Text
"category"]] of
                  [] -> forall a. Maybe a
Nothing
                  [(Text, Text)]
ss -> forall a. a -> Maybe a
Just [(Text, Text)]
ss
  in
    DocProps{ dcTitle :: Maybe Text
dcTitle = forall a. Walkable Inline a => a -> Text
Shared.stringify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta
            , dcSubject :: Maybe Text
dcSubject = forall a. Walkable Inline a => a -> Text
Shared.stringify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"subject" Meta
meta
            , dcCreator :: Maybe Text
dcCreator = Maybe Text
authors
            , dcKeywords :: Maybe [Text]
dcKeywords = Maybe [Text]
keywords
            , dcDescription :: Maybe Text
dcDescription = Maybe Text
description
            , cpCategory :: Maybe Text
cpCategory = forall a. Walkable Inline a => a -> Text
Shared.stringify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"category" Meta
meta
            , dcDate :: Maybe Text
dcDate =
              let t :: Text
t = forall a. Walkable Inline a => a -> Text
Shared.stringify (Meta -> [Inline]
docDate Meta
meta)
              in if Text -> Bool
T.null Text
t
                 then forall a. Maybe a
Nothing
                 else forall a. a -> Maybe a
Just Text
t
            , customProperties :: Maybe [(Text, Text)]
customProperties = Maybe [(Text, Text)]
customProperties'
            }

documentToPresentation :: WriterOptions
                       -> Pandoc
                       -> (Presentation, [LogMessage])
documentToPresentation :: WriterOptions -> Pandoc -> (Presentation, [LogMessage])
documentToPresentation WriterOptions
opts (Pandoc Meta
meta [Block]
blks) =
  let env :: WriterEnv
env = forall a. Default a => a
def { envOpts :: WriterOptions
envOpts = WriterOptions
opts
                , envMetadata :: Meta
envMetadata = Meta
meta
                , envSlideLevel :: Int
envSlideLevel = forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
blks) (WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts)
                }
      ([Slide]
presSlides, [LogMessage]
msgs) = forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ [Block] -> Pres [Slide]
blocksToPresentationSlides [Block]
blks
      docProps :: DocProps
docProps = Meta -> DocProps
metaToDocProps Meta
meta
  in
    (DocProps -> [Slide] -> Presentation
Presentation DocProps
docProps [Slide]
presSlides, [LogMessage]
msgs)

-- --------------------------------------------------------------

applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps =
  RunProps
rProps{ rSolidFill :: Maybe Color
rSolidFill     = TokenStyle -> Maybe Color
tokenColor TokenStyle
tokSty forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunProps -> Maybe Color
rSolidFill RunProps
rProps
        , rPropBold :: Bool
rPropBold      = TokenStyle -> Bool
tokenBold TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropBold RunProps
rProps
        , rPropItalics :: Bool
rPropItalics   = TokenStyle -> Bool
tokenItalic TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropItalics RunProps
rProps
        , rPropUnderline :: Bool
rPropUnderline = TokenStyle -> Bool
tokenUnderline TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropUnderline RunProps
rProps
        }

formatToken :: Style -> Token -> ParaElem
formatToken :: Style -> Token -> ParaElem
formatToken Style
sty (TokenType
tokType, Text
txt) =
  let rProps :: RunProps
rProps = forall a. Default a => a
def{rPropCode :: Bool
rPropCode = Bool
True, rSolidFill :: Maybe Color
rSolidFill = Style -> Maybe Color
defaultColor Style
sty}
      rProps' :: RunProps
rProps' = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
tokType (Style -> Map TokenType TokenStyle
tokenStyles Style
sty) of
        Just TokenStyle
tokSty -> TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps
        Maybe TokenStyle
Nothing     -> RunProps
rProps
  in
    RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
txt

formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
_ SourceLine
srcLn = forall a b. (a -> b) -> [a] -> [b]
map (Style -> Token -> ParaElem
formatToken Style
sty) SourceLine
srcLn

formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines Style
sty FormatOptions
opts [SourceLine]
srcLns = forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break] forall a b. (a -> b) -> a -> b
$
                                    forall a b. (a -> b) -> [a] -> [b]
map (Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
opts) [SourceLine]
srcLns