{-# 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
(Int -> WriterEnv -> ShowS)
-> (WriterEnv -> String)
-> ([WriterEnv] -> ShowS)
-> Show WriterEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriterEnv -> ShowS
showsPrec :: Int -> WriterEnv -> ShowS
$cshow :: WriterEnv -> String
show :: WriterEnv -> String
$cshowList :: [WriterEnv] -> ShowS
showList :: [WriterEnv] -> ShowS
Show)

instance Default WriterEnv where
  def :: WriterEnv
def = WriterEnv { envMetadata :: Meta
envMetadata = Meta
forall a. Monoid a => a
mempty
                  , envRunProps :: RunProps
envRunProps = RunProps
forall a. Default a => a
def
                  , envParaProps :: ParaProps
envParaProps = ParaProps
forall a. Default a => a
def
                  , envSlideLevel :: Int
envSlideLevel = Int
2
                  , envOpts :: WriterOptions
envOpts = WriterOptions
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 = Maybe InIncrementalDiv
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
(Int -> WriterState -> ShowS)
-> (WriterState -> String)
-> ([WriterState] -> ShowS)
-> Show WriterState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriterState -> ShowS
showsPrec :: Int -> WriterState -> ShowS
$cshow :: WriterState -> String
show :: WriterState -> String
$cshowList :: [WriterState] -> ShowS
showList :: [WriterState] -> ShowS
Show, WriterState -> WriterState -> Bool
(WriterState -> WriterState -> Bool)
-> (WriterState -> WriterState -> Bool) -> Eq WriterState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriterState -> WriterState -> Bool
== :: WriterState -> WriterState -> Bool
$c/= :: WriterState -> WriterState -> Bool
/= :: WriterState -> WriterState -> Bool
Eq)

instance Default WriterState where
  def :: WriterState
def = WriterState { stNoteIds :: Map Int [Block]
stNoteIds = Map Int [Block]
forall a. Monoid a => a
mempty
                    , stAnchorMap :: Map Text SlideId
stAnchorMap = Map Text SlideId
forall a. Monoid a => a
mempty
                    -- we reserve this s
                    , stSlideIdSet :: Set SlideId
stSlideIdSet = Set SlideId
reservedSlideIds
                    , stLog :: [LogMessage]
stLog = []
                    , stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = SpeakerNotes
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
(Int -> InIncrementalDiv -> ShowS)
-> (InIncrementalDiv -> String)
-> ([InIncrementalDiv] -> ShowS)
-> Show InIncrementalDiv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InIncrementalDiv -> ShowS
showsPrec :: Int -> InIncrementalDiv -> ShowS
$cshow :: InIncrementalDiv -> String
show :: InIncrementalDiv -> String
$cshowList :: [InIncrementalDiv] -> ShowS
showList :: [InIncrementalDiv] -> ShowS
Show)

listShouldBeIncremental :: Pres Bool
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental = do
  Bool
incrementalOption <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Bool
writerIncremental (WriterOptions -> Bool)
-> (WriterEnv -> WriterOptions) -> WriterEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterEnv -> WriterOptions
envOpts)
  Maybe InIncrementalDiv
inIncrementalDiv <- (WriterEnv -> Maybe InIncrementalDiv)
-> ReaderT WriterEnv (State WriterState) (Maybe InIncrementalDiv)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe InIncrementalDiv
envInIncrementalDiv
  Bool
inBlockQuote <- (WriterEnv -> Bool) -> Pres Bool
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 Bool -> Bool
forall a. a -> a
id
  Bool -> Pres Bool
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool
maybeInvert (Bool
-> (InIncrementalDiv -> Bool) -> Maybe InIncrementalDiv -> Bool
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 = [SlideId] -> Set SlideId
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Text
s else Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
n
  in if Text -> SlideId
SlideId Text
s' SlideId -> Set SlideId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set SlideId
idSet
     then Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' (Integer
nInteger -> Integer -> Integer
forall 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 <- (WriterState -> Set SlideId)
-> ReaderT WriterEnv (State WriterState) (Set SlideId)
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
  (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSlideIdSet = S.insert sldId idSet}
  SlideId -> Pres SlideId
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return SlideId
sldId

addLogMessage :: LogMessage -> Pres ()
addLogMessage :: LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage LogMessage
msg = (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stLog = msg : stLog 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, [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ WriterState -> [LogMessage]
stLog WriterState
finalSt)
  where (a
pres, WriterState
finalSt) = State WriterState a -> WriterState -> (a, WriterState)
forall s a. State s a -> s -> (a, s)
runState (Pres a -> WriterEnv -> State WriterState a
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   =  ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m [b]
f [a]
xs)

type Pixels = Integer

data Presentation = Presentation DocProps [Slide]
  deriving (Int -> Presentation -> ShowS
[Presentation] -> ShowS
Presentation -> String
(Int -> Presentation -> ShowS)
-> (Presentation -> String)
-> ([Presentation] -> ShowS)
-> Show Presentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presentation -> ShowS
showsPrec :: Int -> Presentation -> ShowS
$cshow :: Presentation -> String
show :: Presentation -> String
$cshowList :: [Presentation] -> ShowS
showList :: [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
(Int -> DocProps -> ShowS)
-> (DocProps -> String) -> ([DocProps] -> ShowS) -> Show DocProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocProps -> ShowS
showsPrec :: Int -> DocProps -> ShowS
$cshow :: DocProps -> String
show :: DocProps -> String
$cshowList :: [DocProps] -> ShowS
showList :: [DocProps] -> ShowS
Show, DocProps -> DocProps -> Bool
(DocProps -> DocProps -> Bool)
-> (DocProps -> DocProps -> Bool) -> Eq DocProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocProps -> DocProps -> Bool
== :: DocProps -> DocProps -> Bool
$c/= :: DocProps -> DocProps -> Bool
/= :: 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
(Int -> Slide -> ShowS)
-> (Slide -> String) -> ([Slide] -> ShowS) -> Show Slide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slide -> ShowS
showsPrec :: Int -> Slide -> ShowS
$cshow :: Slide -> String
show :: Slide -> String
$cshowList :: [Slide] -> ShowS
showList :: [Slide] -> ShowS
Show, Slide -> Slide -> Bool
(Slide -> Slide -> Bool) -> (Slide -> Slide -> Bool) -> Eq Slide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slide -> Slide -> Bool
== :: Slide -> Slide -> Bool
$c/= :: Slide -> Slide -> Bool
/= :: Slide -> Slide -> Bool
Eq)

newtype SlideId = SlideId T.Text
  deriving (Int -> SlideId -> ShowS
[SlideId] -> ShowS
SlideId -> String
(Int -> SlideId -> ShowS)
-> (SlideId -> String) -> ([SlideId] -> ShowS) -> Show SlideId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlideId -> ShowS
showsPrec :: Int -> SlideId -> ShowS
$cshow :: SlideId -> String
show :: SlideId -> String
$cshowList :: [SlideId] -> ShowS
showList :: [SlideId] -> ShowS
Show, SlideId -> SlideId -> Bool
(SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool) -> Eq SlideId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlideId -> SlideId -> Bool
== :: SlideId -> SlideId -> Bool
$c/= :: SlideId -> SlideId -> Bool
/= :: SlideId -> SlideId -> Bool
Eq, Eq SlideId
Eq SlideId =>
(SlideId -> SlideId -> Ordering)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> SlideId)
-> (SlideId -> SlideId -> SlideId)
-> Ord 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
$ccompare :: SlideId -> SlideId -> Ordering
compare :: SlideId -> SlideId -> Ordering
$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
>= :: SlideId -> SlideId -> Bool
$cmax :: SlideId -> SlideId -> SlideId
max :: SlideId -> SlideId -> SlideId
$cmin :: SlideId -> SlideId -> SlideId
min :: SlideId -> SlideId -> SlideId
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
(Int -> SpeakerNotes -> ShowS)
-> (SpeakerNotes -> String)
-> ([SpeakerNotes] -> ShowS)
-> Show SpeakerNotes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpeakerNotes -> ShowS
showsPrec :: Int -> SpeakerNotes -> ShowS
$cshow :: SpeakerNotes -> String
show :: SpeakerNotes -> String
$cshowList :: [SpeakerNotes] -> ShowS
showList :: [SpeakerNotes] -> ShowS
Show, SpeakerNotes -> SpeakerNotes -> Bool
(SpeakerNotes -> SpeakerNotes -> Bool)
-> (SpeakerNotes -> SpeakerNotes -> Bool) -> Eq SpeakerNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpeakerNotes -> SpeakerNotes -> Bool
== :: SpeakerNotes -> SpeakerNotes -> Bool
$c/= :: SpeakerNotes -> SpeakerNotes -> Bool
/= :: SpeakerNotes -> SpeakerNotes -> Bool
Eq, Semigroup SpeakerNotes
SpeakerNotes
Semigroup SpeakerNotes =>
SpeakerNotes
-> (SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> ([SpeakerNotes] -> SpeakerNotes)
-> Monoid SpeakerNotes
[SpeakerNotes] -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SpeakerNotes
mempty :: SpeakerNotes
$cmappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
mappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$cmconcat :: [SpeakerNotes] -> SpeakerNotes
mconcat :: [SpeakerNotes] -> SpeakerNotes
Monoid, NonEmpty SpeakerNotes -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
(SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> (NonEmpty SpeakerNotes -> SpeakerNotes)
-> (forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes)
-> Semigroup 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
$c<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$csconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
sconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
$cstimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
stimes :: forall b. Integral b => b -> 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
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Layout -> ShowS
showsPrec :: Int -> Layout -> ShowS
$cshow :: Layout -> String
show :: Layout -> String
$cshowList :: [Layout] -> ShowS
showList :: [Layout] -> ShowS
Show, Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
/= :: 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
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Shape -> ShowS
showsPrec :: Int -> Shape -> ShowS
$cshow :: Shape -> String
show :: Shape -> String
$cshowList :: [Shape] -> ShowS
showList :: [Shape] -> ShowS
Show, Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
/= :: 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
(Int -> TableProps -> ShowS)
-> (TableProps -> String)
-> ([TableProps] -> ShowS)
-> Show TableProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableProps -> ShowS
showsPrec :: Int -> TableProps -> ShowS
$cshow :: TableProps -> String
show :: TableProps -> String
$cshowList :: [TableProps] -> ShowS
showList :: [TableProps] -> ShowS
Show, TableProps -> TableProps -> Bool
(TableProps -> TableProps -> Bool)
-> (TableProps -> TableProps -> Bool) -> Eq TableProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableProps -> TableProps -> Bool
== :: TableProps -> TableProps -> Bool
$c/= :: TableProps -> TableProps -> Bool
/= :: TableProps -> TableProps -> Bool
Eq)

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


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

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

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

instance Default ParaProps where
  def :: ParaProps
def = ParaProps { pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
                  , pPropMarginRight :: Maybe Integer
pPropMarginRight = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
                  , pPropLevel :: Int
pPropLevel = Int
0
                  , pPropBullet :: Maybe BulletType
pPropBullet = Maybe BulletType
forall a. Maybe a
Nothing
                  , pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
forall a. Maybe a
Nothing
                  , pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = Maybe Integer
forall a. Maybe a
Nothing
                  , pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
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
(TeXString -> TeXString -> Bool)
-> (TeXString -> TeXString -> Bool) -> Eq TeXString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeXString -> TeXString -> Bool
== :: TeXString -> TeXString -> Bool
$c/= :: TeXString -> TeXString -> Bool
/= :: TeXString -> TeXString -> Bool
Eq, Int -> TeXString -> ShowS
[TeXString] -> ShowS
TeXString -> String
(Int -> TeXString -> ShowS)
-> (TeXString -> String)
-> ([TeXString] -> ShowS)
-> Show TeXString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeXString -> ShowS
showsPrec :: Int -> TeXString -> ShowS
$cshow :: TeXString -> String
show :: TeXString -> String
$cshowList :: [TeXString] -> ShowS
showList :: [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
(Int -> ParaElem -> ShowS)
-> (ParaElem -> String) -> ([ParaElem] -> ShowS) -> Show ParaElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParaElem -> ShowS
showsPrec :: Int -> ParaElem -> ShowS
$cshow :: ParaElem -> String
show :: ParaElem -> String
$cshowList :: [ParaElem] -> ShowS
showList :: [ParaElem] -> ShowS
Show, ParaElem -> ParaElem -> Bool
(ParaElem -> ParaElem -> Bool)
-> (ParaElem -> ParaElem -> Bool) -> Eq ParaElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParaElem -> ParaElem -> Bool
== :: ParaElem -> ParaElem -> Bool
$c/= :: ParaElem -> ParaElem -> Bool
/= :: ParaElem -> ParaElem -> Bool
Eq)

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

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

type URL = T.Text

data LinkTarget = ExternalTarget (URL, T.Text)
                | InternalTarget SlideId
                deriving (Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkTarget -> ShowS
showsPrec :: Int -> LinkTarget -> ShowS
$cshow :: LinkTarget -> String
show :: LinkTarget -> String
$cshowList :: [LinkTarget] -> ShowS
showList :: [LinkTarget] -> ShowS
Show, LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
/= :: 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
(Int -> RunProps -> ShowS)
-> (RunProps -> String) -> ([RunProps] -> ShowS) -> Show RunProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunProps -> ShowS
showsPrec :: Int -> RunProps -> ShowS
$cshow :: RunProps -> String
show :: RunProps -> String
$cshowList :: [RunProps] -> ShowS
showList :: [RunProps] -> ShowS
Show, RunProps -> RunProps -> Bool
(RunProps -> RunProps -> Bool)
-> (RunProps -> RunProps -> Bool) -> Eq RunProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunProps -> RunProps -> Bool
== :: RunProps -> RunProps -> Bool
$c/= :: RunProps -> RunProps -> Bool
/= :: 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 = Maybe Strikethrough
forall a. Maybe a
Nothing
                 , rBaseline :: Maybe Int
rBaseline = Maybe Int
forall a. Maybe a
Nothing
                 , rCap :: Maybe Capitals
rCap = Maybe Capitals
forall a. Maybe a
Nothing
                 , rLink :: Maybe LinkTarget
rLink = Maybe LinkTarget
forall a. Maybe a
Nothing
                 , rPropCode :: Bool
rPropCode = Bool
False
                 , rPropBlockQuote :: Bool
rPropBlockQuote = Bool
False
                 , rPropForceSize :: Maybe Integer
rPropForceSize = Maybe Integer
forall a. Maybe a
Nothing
                 , rSolidFill :: Maybe Color
rSolidFill = Maybe Color
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
(Int -> PicProps -> ShowS)
-> (PicProps -> String) -> ([PicProps] -> ShowS) -> Show PicProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PicProps -> ShowS
showsPrec :: Int -> PicProps -> ShowS
$cshow :: PicProps -> String
show :: PicProps -> String
$cshowList :: [PicProps] -> ShowS
showList :: [PicProps] -> ShowS
Show, PicProps -> PicProps -> Bool
(PicProps -> PicProps -> Bool)
-> (PicProps -> PicProps -> Bool) -> Eq PicProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PicProps -> PicProps -> Bool
== :: PicProps -> PicProps -> Bool
$c/= :: PicProps -> PicProps -> Bool
/= :: PicProps -> PicProps -> Bool
Eq)

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

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

inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems = (Inline -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
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 <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
  [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [RunProps -> Text -> ParaElem
Run RunProps
pr Text
s]
inlineToParElems (Emph [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropItalics=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Underline [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropUnderline=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strong [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropBold=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strikeout [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rStrikethrough=Just SingleStrike}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Superscript [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rBaseline=Just 30000}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Subscript [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rBaseline=Just (-25000)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (SmallCaps [Inline]
ils) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rCap = Just SmallCapitals}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
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 = [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaElem
Break]
inlineToParElems (Link Attr
_ [Inline]
ils (Text
url, Text
title)) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Code Attr
_ Text
str) =
  (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps = (envRunProps r){rPropCode = True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
  Inline -> Pres [ParaElem]
inlineToParElems (Inline -> Pres [ParaElem]) -> Inline -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
str
inlineToParElems (Math MathType
mathtype Text
str) =
  [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInSpeakerNotes
  if Bool
inSpNotes
    then [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
    Map Int [Block]
notes <- (WriterState -> Map Int [Block])
-> ReaderT WriterEnv (State WriterState) (Map Int [Block])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [Block]
stNoteIds
    let maxNoteId :: Int
maxNoteId = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ Map Int [Block] -> [Int]
forall k a. Map k a -> [k]
M.keys Map Int [Block]
notes
        curNoteId :: Int
curNoteId = Int
maxNoteId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteIds = M.insert curNoteId blks notes }
    (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
      Inline -> Pres [ParaElem]
inlineToParElems (Inline -> Pres [ParaElem]) -> Inline -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Int -> Text
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 ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ils [Inline] -> [Inline] -> [Inline]
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" -> [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> ParaElem
RawOOXMLParaElem Text
s]
    Format
_                -> do LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
                           [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterState -> Map Text SlideId)
-> ReaderT WriterEnv (State WriterState) (Map Text SlideId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
  SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
  Bool
-> ReaderT WriterEnv (State WriterState) ()
-> ReaderT WriterEnv (State WriterState) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
anchor) (ReaderT WriterEnv (State WriterState) ()
 -> ReaderT WriterEnv (State WriterState) ())
-> ReaderT WriterEnv (State WriterState) ()
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$
    (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st {stAnchorMap = M.insert anchor sldId 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 <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
ilsList
  ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps = def{ pPropMarginLeft = Nothing
                                    , pPropBullet = Nothing
                                    , pPropLevel = pPropLevel pProps
                                    , pPropIndent = Just 0
                                    }
                , envRunProps = (envRunProps r){rPropCode = True}}) (Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ do
    Maybe Style
mbSty <- WriterOptions -> Maybe Style
writerHighlightStyle (WriterOptions -> Maybe Style)
-> ReaderT WriterEnv (State WriterState) WriterOptions
-> ReaderT WriterEnv (State WriterState) (Maybe Style)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
    SyntaxMap
synMap <- WriterOptions -> SyntaxMap
writerSyntaxMap (WriterOptions -> SyntaxMap)
-> ReaderT WriterEnv (State WriterState) WriterOptions
-> ReaderT WriterEnv (State WriterState) SyntaxMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
    case Maybe Style
mbSty of
      Just Style
sty ->
        case SyntaxMap
-> (FormatOptions -> [SourceLine] -> [ParaElem])
-> Attr
-> Text
-> Either Text [ParaElem]
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 <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
                             [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pPropsNew [ParaElem]
pElems]
          Left Text
_ -> Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Text -> Inline
Str Text
str]
      Maybe Style
Nothing -> Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
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  <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInListInBlockQuote = True })
           (Block -> Pres [Paragraph]
blockToParagraphs Block
blk)
  [Paragraph]
ps' <- Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
BlockQuote [Block]
blks
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
ps [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ [Paragraph]
ps'
blockToParagraphs (BlockQuote [Block]
blks) =
  (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps = (envParaProps r){ pPropMarginLeft = Just 100
                                                 , pPropIndent = Just 0
                                                 }
                , envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})(Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$
  (Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
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 (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
                                          [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
e->WriterEnv
e{envRunProps = (envRunProps e){rPropBold=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
              [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
  -- and give it a bit of space before it.
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def{pPropSpaceBefore = Just 30} [ParaElem]
parElems]
blockToParagraphs (BulletList [[Block]]
blksLst) = do
  ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  Bool
incremental <- Pres Bool
listShouldBeIncremental
  (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList = True
                    , envParaProps = pProps{ pPropBullet = Just Bullet
                                           , pPropMarginLeft = Nothing
                                           , pPropIndent = Nothing
                                           , pPropIncremental = incremental
                                           }}) (Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$
    ([Block] -> Pres [Paragraph]) -> [[Block]] -> Pres [Paragraph]
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 <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
  Bool
incremental <- Pres Bool
listShouldBeIncremental
  (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList = True
                    , envParaProps = pProps{ pPropBullet = Just (AutoNumbering listAttr)
                                           , pPropMarginLeft = Nothing
                                           , pPropIndent = Nothing
                                           , pPropIncremental = incremental
                                           }}) (Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$
    ([Block] -> Pres [Paragraph]) -> [[Block]] -> Pres [Paragraph]
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 (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
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 <- ([Block] -> Pres [Paragraph]) -> [[Block]] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph])
-> ([Block] -> Block) -> [Block] -> Pres [Paragraph]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote) [[Block]]
blksLst
        [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
term [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ [Paragraph]
definition
  (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envParaProps =
                       (envParaProps env) {pPropIncremental = incremental}})
    (Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> Pres [Paragraph])
-> [([Inline], [[Block]])] -> Pres [Paragraph]
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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  hasNonIncremental :: Bool
hasNonIncremental = Text
"nonincremental" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
  incremental :: Maybe InIncrementalDiv
incremental = if | Bool
hasIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InIncremental
                   | Bool
hasNonIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InNonIncremental
                   | Bool
otherwise -> Maybe InIncrementalDiv
forall a. Maybe a
Nothing
  addIncremental :: WriterEnv -> WriterEnv
addIncremental WriterEnv
env = WriterEnv
env { envInIncrementalDiv = incremental }
  in (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WriterEnv -> WriterEnv
addIncremental ((Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
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) = -- This never seems to be used:
  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 (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 [] = [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
multiParList (Block
b:[Block]
bs) = do
  ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
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 <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env
                { envParaProps = pProps
                  { pPropBullet = Nothing
                  , pPropLevel = level + 1
                  }
                })
        (Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ (Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
bs
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
p [Paragraph] -> [Paragraph] -> [Paragraph]
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 <- (Block -> Pres [Paragraph])
-> [Block] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
tblCell
  let alignment :: Maybe Algnment
alignment = case Alignment
algn of
        Alignment
AlignLeft -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnLeft
        Alignment
AlignRight -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnRight
        Alignment
AlignCenter -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnCenter
        Alignment
AlignDefault -> Maybe Algnment
forall a. Maybe a
Nothing
      paras' :: [[Paragraph]]
paras' = ([Paragraph] -> [Paragraph]) -> [[Paragraph]] -> [[Paragraph]]
forall a b. (a -> b) -> [a] -> [b]
map ((Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
p -> Paragraph
p{paraProps = (paraProps p){pPropAlign = alignment}})) [[Paragraph]]
paras
  [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [[Paragraph]] -> [Paragraph]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Paragraph]]
paras'

rowToParagraphs :: [Alignment] -> [SimpleCell] -> Pres [[Paragraph]]
rowToParagraphs :: [Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algns [[Block]]
tblCells = do
  -- We have to make sure we have the right number of alignments
  let pairs :: [(Alignment, [Block])]
pairs = [Alignment] -> [[Block]] -> [(Alignment, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Alignment]
algns [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [[Block]]
tblCells
  ((Alignment, [Block]) -> Pres [Paragraph])
-> [(Alignment, [Block])]
-> ReaderT WriterEnv (State WriterState) [[Paragraph]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Alignment -> [Block] -> Pres [Paragraph])
-> (Alignment, [Block]) -> Pres [Paragraph]
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 = dimension Width attr
                     , picHeight = dimension Height 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 (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def (Text -> String
T.unpack Text
url) Text
title ([ParaElem] -> Shape) -> Pres [ParaElem] -> Pres Shape
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 (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def{picPropLink = Just $ ExternalTarget target} (Text -> String
T.unpack Text
url) Text
title
      ([ParaElem] -> Shape) -> Pres [ParaElem] -> Pres Shape
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]
widths, [[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]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algn [[Block]]
hdrCells
  [[[Paragraph]]]
rows' <- ([[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]])
-> [[[Block]]]
-> ReaderT WriterEnv (State WriterState) [[[Paragraph]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algn) [[[Block]]]
rows
  let tblPr :: TableProps
tblPr = if [[Block]] -> Bool
forall a. [a] -> Bool
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
                              }

  Shape -> Pres Shape
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
forall a b. (a -> b) -> a -> b
$ [Graphic] -> [ParaElem] -> Shape
GraphicFrame [[Double]
-> TableProps -> [[Paragraph]] -> [[[Paragraph]]] -> Graphic
Tbl [Double]
widths 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) = Shape -> Pres Shape
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
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' = (Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
par -> Paragraph
par{paraElems = combineParaElems $ paraElems par}) [Paragraph]
paras
                      Shape -> Pres Shape
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
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 Shape -> [Shape] -> [Shape]
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 Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss)
combineShapes (TextBox (Paragraph
p:[Paragraph]
ps) : TextBox (Paragraph
p':[Paragraph]
ps') : [Shape]
ss) =
  [Shape] -> [Shape]
combineShapes ([Shape] -> [Shape]) -> [Shape] -> [Shape]
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox ((Paragraph
pParagraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps) [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ (Paragraph
p'Paragraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps')) Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss
combineShapes (Shape
s:[Shape]
ss) = Shape
s Shape -> [Shape] -> [Shape]
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 ([Shape] -> [Shape]) -> Pres [Shape] -> Pres [Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres Shape) -> [Block] -> Pres [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> 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) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara (Para [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara Block
_ = Maybe [Inline]
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 Figure{} = Bool
True
notText Block
_ = Bool
False

startsWithImage :: Block -> Bool
startsWithImage :: Block -> Bool
startsWithImage Block
block = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  Inline
inline <- Block -> Maybe [Inline]
plainOrPara Block
block Maybe [Inline] -> ([Inline] -> Maybe Inline) -> Maybe Inline
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
listToMaybe
  Bool -> Maybe Bool
forall a. a -> Maybe a
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 [] = [[Block]] -> Pres [[Block]]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Block]] -> Pres [[Block]]) -> [[Block]] -> Pres [[Block]]
forall a b. (a -> b) -> a -> b
$ [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
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 [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
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 <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
slideLevel of
    Ordering
LT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
h Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]) [Block]
blks'
    Ordering
EQ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
nts) ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks'
    Ordering
GT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' ([Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ (Block
hBlock -> [Block] -> [Block]
forall 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 Block -> [Block] -> [Block]
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 <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
                     then (Block -> Bool) -> [Block] -> ([Block], [Block])
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
                            ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts])
                            (if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks')
    [Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
         (if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
          then [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]
          else [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts])
         (if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks')
splitBlocks' [Block]
cur [[Block]]
acc (tbl :: Block
tbl@Table{} : [Block]
blks) = do
  Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case [Block]
cur of
    [Header Int
n Attr
_ [Inline]
_] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
tbl] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
    [Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
         (if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
          then [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
tbl Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]
          else [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
tbl] [Block] -> [Block] -> [Block]
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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes =  do
  Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
  case [Block]
cur of
    [Header Int
n Attr
_ [Inline]
_] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                            [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
d] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
    [Block]
_ ->  [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
d Block -> [Block] -> [Block]
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 [Block] -> [Block] -> [Block]
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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
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" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsL, Text
"column" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsR = do
      (Block -> ReaderT WriterEnv (State WriterState) ())
-> [Block] -> ReaderT WriterEnv (State WriterState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> (Block -> LogMessage)
-> Block
-> ReaderT WriterEnv (State WriterState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> LogMessage
BlockNotRendered) ([Block]
blks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
remaining)
      let mkTwoColumn :: [Block] -> [Block] -> Pres Slide
mkTwoColumn [Block]
left [Block]
right = do
            [Block]
blksL' <- [[Block]] -> [Block]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Block]] -> [Block])
-> ([[Block]] -> [[Block]]) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Block]] -> [Block])
-> Pres [[Block]] -> ReaderT WriterEnv (State WriterState) [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [[Block]]
splitBlocks [Block]
left
            [Block]
blksR' <- [[Block]] -> [Block]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Block]] -> [Block])
-> ([[Block]] -> [[Block]]) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Block]] -> [Block])
-> Pres [[Block]] -> ReaderT WriterEnv (State WriterState) [Block]
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 <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
            Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
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
              Maybe String
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 <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
            Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
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
              Maybe String
forall a. Maybe a
Nothing
      let ([Block]
blksL1, [Block]
blksL2) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksL
          ([Block]
blksR1, [Block]
blksR2) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksR
      if (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]
blksL1, [Block]
blksL2]) Bool -> Bool -> Bool
&& (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Block] -> Bool
forall a. [a] -> Bool
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 <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
      Bool
inNoteSlide <- (WriterEnv -> Bool) -> Pres Bool
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 Maybe String
forall a. Maybe a
Nothing
      if Bool
inNoteSlide
      then Layout -> Slide
mkSlide (Layout -> Slide) -> ([Shape] -> Layout) -> [Shape] -> Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] ([Shape] -> Slide) -> Pres [Shape] -> Pres Slide
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Integer -> Pres [Shape] -> Pres [Shape]
forall a. Integer -> Pres a -> Pres a
forceFontSize Integer
noteSize ([Block] -> Pres [Shape]
blocksToShapes (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks))
      else let
        contentOrBlankSlide :: Pres Slide
contentOrBlankSlide =
          if [Block] -> Bool
makesBlankSlide (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
          then Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Layout -> Slide
mkSlide Layout
BlankSlide)
          else Layout -> Slide
mkSlide (Layout -> Slide) -> ([Shape] -> Layout) -> [Shape] -> Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] ([Shape] -> Slide) -> Pres [Shape] -> Pres Slide
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [Shape]
blocksToShapes (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
        in case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText (Block
blk Block -> [Block] -> [Block]
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
            Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
  Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$
    SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
    SlideId
sldId
    Layout
BlankSlide
    SpeakerNotes
spkNotes
    Maybe String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lvl = do
      Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
      SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
      [ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
      Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lvl Bool -> Bool -> Bool
|| Int
lvl Int -> Int -> Bool
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 (Inline -> Bool) -> [Inline] -> Bool
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'
      Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ Slide
slide{slideLayout = layout, slideBackgroundImage = backgroundImage}
  where
    backgroundImage :: Maybe String
backgroundImage = Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"background-image" [(Text, Text)]
attributes
                                   Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [(Text, Text)] -> Maybe Text
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) =
  (WriterEnv -> WriterEnv) -> Pres SpeakerNotes -> Pres SpeakerNotes
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envInSpeakerNotes=True}) (Pres SpeakerNotes -> Pres SpeakerNotes)
-> Pres SpeakerNotes -> Pres SpeakerNotes
forall a b. (a -> b) -> a -> b
$
  [Paragraph] -> SpeakerNotes
SpeakerNotes ([Paragraph] -> SpeakerNotes)
-> Pres [Paragraph] -> Pres SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks
blockToSpeakerNotes Block
_ = SpeakerNotes -> Pres SpeakerNotes
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return SpeakerNotes
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
  (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes = stSpeakerNotes st <> spNotes}

handleAndFilterSpeakerNotes' :: [Block] -> Pres [Block]
handleAndFilterSpeakerNotes' :: [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks = do
  (Block -> ReaderT WriterEnv (State WriterState) ())
-> [Block] -> ReaderT WriterEnv (State WriterState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes [Block]
blks
  [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b. (a -> b) -> a -> b
$ (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
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
  (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
 -> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes = mempty}
  [Block]
blks' <- ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
([Block] -> m [Block]) -> [Block] -> m [Block]
walkM [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks
  SpeakerNotes
spkNotes <- (WriterState -> SpeakerNotes) -> Pres SpeakerNotes
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> SpeakerNotes
stSpeakerNotes
  ([Block], SpeakerNotes) -> Pres ([Block], SpeakerNotes)
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
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 (Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".")
  in
    case [Block]
blks of
      (Para [Inline]
ils : [Block]
blks') -> [Inline] -> Block
Para (Inline
enum Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks'
      [Block]
_ -> [Inline] -> Block
Para [Inline
enum] Block -> [Block] -> [Block]
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 <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
  (WriterEnv -> WriterEnv) -> Pres a -> Pres a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r {envRunProps = rpr{rPropForceSize = Just 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 <- (WriterState -> Map Int [Block])
-> ReaderT WriterEnv (State WriterState) (Map Int [Block])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [Block]
stNoteIds
  Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
  Extensions
exts <- WriterOptions -> Extensions
writerExtensions (WriterOptions -> Extensions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
-> ReaderT WriterEnv (State WriterState) Extensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
  Meta
meta <- (WriterEnv -> Meta) -> ReaderT WriterEnv (State WriterState) 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 <- Map Text SlideId -> Set Text
forall k a. Map k a -> Set k
M.keysSet (Map Text SlideId -> Set Text)
-> ReaderT WriterEnv (State WriterState) (Map Text SlideId)
-> ReaderT WriterEnv (State WriterState) (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Map Text SlideId)
-> ReaderT WriterEnv (State WriterState) (Map Text SlideId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
  if Map Int [Block] -> Bool
forall k a. Map k a -> Bool
M.null Map Int [Block]
noteIds
    then [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 = ((Int, [Block]) -> [Block]) -> [(Int, [Block])] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [Block]) -> [Block]
makeNoteEntry ([(Int, [Block])] -> [Block]) -> [(Int, [Block])] -> [Block]
forall a b. (a -> b) -> a -> b
$
                    Map Int [Block] -> [(Int, [Block])]
forall k a. Map k a -> [(k, a)]
M.toList Map Int [Block]
noteIds
         in [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b. (a -> b) -> a -> b
$ Block
hdr Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks

getMetaSlide :: Pres (Maybe Slide)
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide  = do
  Meta
meta <- (WriterEnv -> Meta) -> ReaderT WriterEnv (State WriterState) Meta
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
  [ParaElem]
title <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  [ParaElem]
subtitle <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
  [[ParaElem]]
authors <- ([Inline] -> Pres [ParaElem])
-> [[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> Pres [ParaElem]
inlinesToParElems ([[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]])
-> [[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  [ParaElem]
date <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
  if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
title Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitle Bool -> Bool -> Bool
&& [[ParaElem]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ParaElem]]
authors Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
date
    then Maybe Slide -> Pres (Maybe Slide)
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Slide
forall a. Maybe a
Nothing
    else Maybe Slide -> Pres (Maybe Slide)
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Slide -> Pres (Maybe Slide))
-> Maybe Slide -> Pres (Maybe Slide)
forall a b. (a -> b) -> a -> b
$
         Slide -> Maybe Slide
forall a. a -> Maybe a
Just (Slide -> Maybe Slide) -> Slide -> Maybe Slide
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)
         SpeakerNotes
forall a. Monoid a => a
mempty
         Maybe String
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') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
     SpeakerNotes
spkNotes' <- [SpeakerNotes] -> SpeakerNotes
forall a. Monoid a => [a] -> a
mconcat ([SpeakerNotes] -> SpeakerNotes)
-> ReaderT WriterEnv (State WriterState) [SpeakerNotes]
-> Pres SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres SpeakerNotes)
-> [Block] -> ReaderT WriterEnv (State WriterState) [SpeakerNotes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres SpeakerNotes
blockToSpeakerNotes [Block]
ntsBlks
     (Slide, [Block]) -> Pres (Slide, [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
layout (SpeakerNotes
spkNotes SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a. Semigroup a => a -> a -> a
<> SpeakerNotes
spkNotes') Maybe String
backgroundImage, [Block]
blks')
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks = (Slide, [Block]) -> Pres (Slide, [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide
sld, [Block]
blks)

makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide [Block]
blks = (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId = tocSlideId}) (Pres Slide -> Pres Slide) -> Pres Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ do
  WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
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 <- (WriterEnv -> Meta) -> ReaderT WriterEnv (State WriterState) Meta
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
  Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
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 [] = Maybe ParaElem -> [ParaElem]
forall a. Maybe a -> [a]
maybeToList Maybe ParaElem
mbPElem
combineParaElems' Maybe ParaElem
Nothing (ParaElem
pElem : [ParaElem]
pElems) =
  Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
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 RunProps -> RunProps -> Bool
forall a. Eq a => a -> a -> Bool
== RunProps
rPr' =
    Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just (ParaElem -> Maybe ParaElem) -> ParaElem -> Maybe ParaElem
forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rPr' (Text -> ParaElem) -> Text -> ParaElem
forall a b. (a -> b) -> a -> b
$ Text
s' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) [ParaElem]
pElems
  | Bool
otherwise =
    ParaElem
pElem' ParaElem -> [ParaElem] -> [ParaElem]
forall a. a -> [a] -> [a]
: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems

combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems = Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' Maybe ParaElem
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' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f ([ParaElem] -> m [ParaElem]) -> [ParaElem] -> m [ParaElem]
forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para
  Paragraph -> m Paragraph
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Paragraph -> m Paragraph) -> Paragraph -> m Paragraph
forall a b. (a -> b) -> a -> b
$ Paragraph
para {paraElems = 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 ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (GraphicFrame [Graphic]
gfx [ParaElem]
pes) = [Graphic] -> [ParaElem] -> Shape
GraphicFrame [Graphic]
gfx ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (TextBox [Paragraph]
paras) = [Paragraph] -> Shape
TextBox ([Paragraph] -> Shape) -> m [Paragraph] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Paragraph -> m Paragraph) -> [Paragraph] -> m [Paragraph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
applyToShape ParaElem -> m ParaElem
_ (RawOOXMLShape Text
str) = Shape -> m Shape
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> m Shape) -> Shape -> m Shape
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' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
title
  [ParaElem]
subtitle' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
subtitle
  [[ParaElem]]
authors' <- ([ParaElem] -> m [ParaElem]) -> [[ParaElem]] -> m [[ParaElem]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f) [[ParaElem]]
authors
  [ParaElem]
date' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
date
  Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
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 ([ParaElem] -> Layout) -> m [ParaElem] -> m Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
title
applyToLayout ParaElem -> m ParaElem
f (ContentSlide [ParaElem]
hdr [Shape]
content) = do
  [ParaElem]
hdr' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
content' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
content
  Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
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' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
contentL' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL
  [Shape]
contentR' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR
  Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
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' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
contentL1' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL1
  [Shape]
contentL2' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL2
  [Shape]
contentR1' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR1
  [Shape]
contentR2' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR2
  Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
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' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
  [Shape]
textShapes' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
textShapes
  [Shape]
contentShapes' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentShapes
  Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr' [Shape]
textShapes' [Shape]
contentShapes'
applyToLayout ParaElem -> m ParaElem
_ Layout
BlankSlide = Layout -> m Layout
forall a. a -> m a
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' <- (ParaElem -> m ParaElem) -> Layout -> m Layout
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ Slide -> Layout
slideLayout Slide
slide
  let paras :: [Paragraph]
paras = SpeakerNotes -> [Paragraph]
fromSpeakerNotes (SpeakerNotes -> [Paragraph]) -> SpeakerNotes -> [Paragraph]
forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide
  SpeakerNotes
notes' <- [Paragraph] -> SpeakerNotes
SpeakerNotes ([Paragraph] -> SpeakerNotes) -> m [Paragraph] -> m SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Paragraph -> m Paragraph) -> [Paragraph] -> m [Paragraph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
  Slide -> m Slide
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slide
slide{slideLayout = layout', slideSpeakerNotes = 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 <- (WriterState -> Map Text SlideId)
-> ReaderT WriterEnv (State WriterState) (Map Text SlideId)
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 Text -> Map Text SlideId -> Maybe SlideId
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 = Just $ InternalTarget n}
                      Maybe SlideId
Nothing -> RunProps
rProps{rLink = Nothing}
      ParaElem -> Pres ParaElem
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParaElem -> Pres ParaElem) -> ParaElem -> Pres ParaElem
forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
s
replaceAnchor ParaElem
pe = ParaElem -> Pres ParaElem
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim Text
s
emptyParaElem (MathElem MathType
_ TeXString
ts) =
  Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim (Text -> Text) -> Text -> Text
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 = (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem ([ParaElem] -> Bool) -> [ParaElem] -> Bool
forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para


emptyShape :: Shape -> Bool
emptyShape :: Shape -> Bool
emptyShape (TextBox [Paragraph]
paras) = (Paragraph -> Bool) -> [Paragraph] -> Bool
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 ->
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
title Bool -> Bool -> Bool
&&
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
subtitle Bool -> Bool -> Bool
&&
    ([ParaElem] -> Bool) -> [[ParaElem]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem) [[ParaElem]]
authors Bool -> Bool -> Bool
&&
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
date
  TitleSlide [ParaElem]
hdr -> (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr
  ContentSlide [ParaElem]
hdr [Shape]
shapes ->
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes
  TwoColumnSlide [ParaElem]
hdr [Shape]
shapes1 [Shape]
shapes2 ->
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes1 Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> 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) ->
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL1 Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL2 Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR1 Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR2
  ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes ->
    (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
textShapes Bool -> Bool -> Bool
&&
    (Shape -> Bool) -> [Shape] -> 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 SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
== SpeakerNotes
forall a. Monoid a => a
mempty)
  Bool -> Bool -> Bool
&& Layout -> Bool
emptyLayout Layout
layout
  Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
backgroundImage

makesBlankSlide :: [Block] -> Bool
makesBlankSlide :: [Block] -> Bool
makesBlankSlide = (Block -> Bool) -> [Block] -> Bool
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 -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      Para [Inline]
ins -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      LineBlock [[Inline]]
inss -> ([Inline] -> Bool) -> [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Inline -> Bool) -> [Inline] -> Bool
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 -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      OrderedList ListAttributes
_ [[Block]]
blss -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
      BulletList [[Block]]
blss -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
      DefinitionList [([Inline], [[Block]])]
ds -> (([Inline], [[Block]]) -> Bool) -> [([Inline], [[Block]])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (([Inline], [[Block]]) -> (Bool, Bool))
-> ([Inline], [[Block]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Bool)
-> ([[Block]] -> Bool) -> ([Inline], [[Block]]) -> (Bool, Bool)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank) (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank))) [([Inline], [[Block]])]
ds
      Header Int
_ Attr
_ [Inline]
ils -> (Inline -> Bool) -> [Inline] -> Bool
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 -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      Table{} -> Bool
False
      Div Attr
_ [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
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) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Underline [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Strong [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Strikeout [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Superscript [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Subscript [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (SmallCaps [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
      (Quoted QuoteType
_ [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
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)) -> (Inline -> Bool) -> [Inline] -> Bool
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)) -> (Inline -> Bool) -> [Inline] -> Bool
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) -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
      (Span Attr
_ [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
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 <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
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
                                      ([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Slide
s], [Block]
bs)
                                 Maybe Slide
Nothing -> ([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 <- (Integer -> Pres SlideId)
-> [Integer] -> ReaderT WriterEnv (State WriterState) [SlideId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                  (\Integer
n -> Text -> Pres SlideId
runUniqueSlideId (Text -> Pres SlideId) -> Text -> Pres SlideId
forall a b. (a -> b) -> a -> b
$ Text
"BodySlide" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
n)
                  (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
blksLst) [Integer
1..] :: [Integer])
  [Slide]
bodyslides <- (([Block], SlideId) -> Pres Slide)
-> [([Block], SlideId)] -> Pres [Slide]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                (\([Block]
bs, SlideId
ident) ->
                    (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
st -> WriterEnv
st{envCurSlideId = ident}) ([Block] -> Pres Slide
blocksToSlide [Block]
bs))
                ([[Block]] -> [SlideId] -> [([Block], SlideId)]
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 ([Block] -> Pres Slide) -> [Block] -> Pres Slide
forall a b. (a -> b) -> a -> b
$ [Block]
blks' [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
endNotesSlideBlocks
                       [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
toc]
               else [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
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 [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
endNotesSlideBlocks
                    then [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                    else do Slide
endNotesSlide <- (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                              (\WriterEnv
env -> WriterEnv
env { envCurSlideId = endNotesSlideId
                                           , envInNoteSlide = True
                                           })
                              ([Block] -> Pres Slide
blocksToSlide [Block]
endNotesSlideBlocks)
                            [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
endNotesSlide]

  let slides :: [Slide]
slides = [Slide]
metadataslides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
tocSlides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
bodyslides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
endNotesSlides
      slides' :: [Slide]
slides' = (Slide -> Bool) -> [Slide] -> [Slide]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Slide -> Bool) -> Slide -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slide -> Bool
emptySlide) [Slide]
slides
  (Slide -> Pres Slide) -> [Slide] -> Pres [Slide]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> Pres ParaElem) -> Slide -> Pres Slide
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) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify [MetaValue]
xs
                   Maybe MetaValue
_                  -> Maybe [Text]
forall a. Maybe a
Nothing

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

      description :: Maybe Text
description = case (Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta of
                  [] -> Maybe Text
forall a. Maybe a
Nothing
                  [Text]
ss -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
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 <- Map Text MetaValue -> [Text]
forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
                               , Text
k Text -> [Text] -> Bool
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
                  [] -> Maybe [(Text, Text)]
forall a. Maybe a
Nothing
                  [(Text, Text)]
ss -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text, Text)]
ss
  in
    DocProps{ dcTitle :: Maybe Text
dcTitle = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
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 = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (Meta -> [Inline]
docDate Meta
meta)
              in if Text -> Bool
T.null Text
t
                 then Maybe Text
forall a. Maybe a
Nothing
                 else Text -> Maybe Text
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 = WriterEnv
forall a. Default a => a
def { envOpts = opts
                , envMetadata = meta
                , envSlideLevel = fromMaybe (getSlideLevel blks) (writerSlideLevel opts)
                }
      ([Slide]
presSlides, [LogMessage]
msgs) = WriterEnv -> WriterState -> Pres [Slide] -> ([Slide], [LogMessage])
forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
forall a. Default a => a
def (Pres [Slide] -> ([Slide], [LogMessage]))
-> Pres [Slide] -> ([Slide], [LogMessage])
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     = tokenColor tokSty <|> rSolidFill rProps
        , rPropBold      = tokenBold tokSty || rPropBold rProps
        , rPropItalics   = tokenItalic tokSty || rPropItalics rProps
        , rPropUnderline = tokenUnderline tokSty || rPropUnderline rProps
        }

formatToken :: Style -> Token -> ParaElem
formatToken :: Style -> Token -> ParaElem
formatToken Style
sty (TokenType
tokType, Text
txt) =
  let rProps :: RunProps
rProps = RunProps
forall a. Default a => a
def{rPropCode = True, rSolidFill = defaultColor sty}
      rProps' :: RunProps
rProps' = case TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
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 = (Token -> ParaElem) -> SourceLine -> [ParaElem]
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 = [ParaElem] -> [[ParaElem]] -> [ParaElem]
forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break] ([[ParaElem]] -> [ParaElem]) -> [[ParaElem]] -> [ParaElem]
forall a b. (a -> b) -> a -> b
$
                                    (SourceLine -> [ParaElem]) -> [SourceLine] -> [[ParaElem]]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
opts) [SourceLine]
srcLns