{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
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.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
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
, :: 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
showList :: [WriterEnv] -> ShowS
$cshowList :: [WriterEnv] -> ShowS
show :: WriterEnv -> String
$cshow :: WriterEnv -> String
showsPrec :: Int -> WriterEnv -> ShowS
$cshowsPrec :: Int -> WriterEnv -> ShowS
Show)
instance Default WriterEnv where
def :: WriterEnv
def = WriterEnv :: Meta
-> RunProps
-> ParaProps
-> Int
-> WriterOptions
-> Bool
-> Bool
-> Bool
-> SlideId
-> Bool
-> Maybe InIncrementalDiv
-> Bool
-> WriterEnv
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 = 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 "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]
, 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
showList :: [WriterState] -> ShowS
$cshowList :: [WriterState] -> ShowS
show :: WriterState -> String
$cshow :: WriterState -> String
showsPrec :: Int -> WriterState -> ShowS
$cshowsPrec :: Int -> WriterState -> ShowS
Show, WriterState -> WriterState -> Bool
(WriterState -> WriterState -> Bool)
-> (WriterState -> WriterState -> Bool) -> Eq WriterState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriterState -> WriterState -> Bool
$c/= :: WriterState -> WriterState -> Bool
== :: WriterState -> WriterState -> Bool
$c== :: WriterState -> WriterState -> Bool
Eq)
instance Default WriterState where
def :: WriterState
def = WriterState :: Map Int [Block]
-> Map Text SlideId
-> Set SlideId
-> [LogMessage]
-> SpeakerNotes
-> WriterState
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
, stSlideIdSet :: Set SlideId
stSlideIdSet = Set SlideId
reservedSlideIds
, stLog :: [LogMessage]
stLog = []
, stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = SpeakerNotes
forall a. Monoid a => a
mempty
}
data InIncrementalDiv
= InIncremental
| InNonIncremental
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
showList :: [InIncrementalDiv] -> ShowS
$cshowList :: [InIncrementalDiv] -> ShowS
show :: InIncrementalDiv -> String
$cshow :: InIncrementalDiv -> String
showsPrec :: Int -> InIncrementalDiv -> ShowS
$cshowsPrec :: Int -> InIncrementalDiv -> ShowS
Show)
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental = do
Bool
incrementalOption <- (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 InIncremental -> Bool
True
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 (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 "Metadata"
tocSlideId :: SlideId
tocSlideId :: SlideId
tocSlideId = Text -> SlideId
SlideId "TOC"
endNotesSlideId :: SlideId
endNotesSlideId :: SlideId
endNotesSlideId = Text -> SlideId
SlideId "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' n :: Integer
n idSet :: Set SlideId
idSet s :: Text
s =
let s' :: Text
s' = if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Text
s else Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-" 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
+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' 0
runUniqueSlideId :: T.Text -> Pres SlideId
runUniqueSlideId :: Text -> Pres SlideId
runUniqueSlideId s :: 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
$ \st :: WriterState
st -> WriterState
st{stSlideIdSet :: Set SlideId
stSlideIdSet = SlideId -> Set SlideId -> Set SlideId
forall a. Ord a => a -> Set a -> Set a
S.insert SlideId
sldId Set SlideId
idSet}
SlideId -> Pres SlideId
forall (m :: * -> *) a. Monad m => a -> m a
return SlideId
sldId
addLogMessage :: LogMessage -> Pres ()
addLogMessage :: LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage msg :: 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
$ \st :: WriterState
st -> WriterState
st{stLog :: [LogMessage]
stLog = LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: WriterState -> [LogMessage]
stLog WriterState
st}
type Pres = ReaderT WriterEnv (State WriterState)
runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres env :: WriterEnv
env st :: WriterState
st p :: 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 (pres :: a
pres, finalSt :: 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
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM f :: a -> m [b]
f xs :: [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)
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
showList :: [Presentation] -> ShowS
$cshowList :: [Presentation] -> ShowS
show :: Presentation -> String
$cshow :: Presentation -> String
showsPrec :: Int -> Presentation -> ShowS
$cshowsPrec :: Int -> Presentation -> ShowS
Show)
data DocProps = DocProps { DocProps -> Maybe Text
dcTitle :: Maybe T.Text
, DocProps -> Maybe Text
dcSubject :: Maybe T.Text
, DocProps -> Maybe Text
dcCreator :: Maybe T.Text
, DocProps -> Maybe [Text]
dcKeywords :: Maybe [T.Text]
, DocProps -> Maybe Text
dcDescription :: Maybe T.Text
, DocProps -> Maybe Text
cpCategory :: Maybe T.Text
, DocProps -> Maybe Text
dcDate :: Maybe T.Text
, DocProps -> Maybe [(Text, Text)]
customProperties :: Maybe [(T.Text, T.Text)]
} deriving (Int -> DocProps -> ShowS
[DocProps] -> ShowS
DocProps -> String
(Int -> DocProps -> ShowS)
-> (DocProps -> String) -> ([DocProps] -> ShowS) -> Show DocProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocProps] -> ShowS
$cshowList :: [DocProps] -> ShowS
show :: DocProps -> String
$cshow :: DocProps -> String
showsPrec :: Int -> DocProps -> ShowS
$cshowsPrec :: Int -> DocProps -> ShowS
Show, DocProps -> DocProps -> Bool
(DocProps -> DocProps -> Bool)
-> (DocProps -> DocProps -> Bool) -> Eq DocProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocProps -> DocProps -> Bool
$c/= :: DocProps -> DocProps -> Bool
== :: DocProps -> DocProps -> Bool
$c== :: DocProps -> DocProps -> Bool
Eq)
data Slide = Slide { Slide -> SlideId
slideId :: SlideId
, Slide -> Layout
slideLayout :: Layout
, Slide -> SpeakerNotes
slideSpeakerNotes :: SpeakerNotes
, Slide -> Maybe String
slideBackgroundImage :: Maybe FilePath
} deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> String
(Int -> Slide -> ShowS)
-> (Slide -> String) -> ([Slide] -> ShowS) -> Show Slide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slide] -> ShowS
$cshowList :: [Slide] -> ShowS
show :: Slide -> String
$cshow :: Slide -> String
showsPrec :: Int -> Slide -> ShowS
$cshowsPrec :: Int -> Slide -> ShowS
Show, Slide -> Slide -> Bool
(Slide -> Slide -> Bool) -> (Slide -> Slide -> Bool) -> Eq Slide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slide -> Slide -> Bool
$c/= :: Slide -> Slide -> Bool
== :: Slide -> Slide -> Bool
$c== :: Slide -> Slide -> Bool
Eq)
newtype SlideId = SlideId T.Text
deriving (Int -> SlideId -> ShowS
[SlideId] -> ShowS
SlideId -> String
(Int -> SlideId -> ShowS)
-> (SlideId -> String) -> ([SlideId] -> ShowS) -> Show SlideId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlideId] -> ShowS
$cshowList :: [SlideId] -> ShowS
show :: SlideId -> String
$cshow :: SlideId -> String
showsPrec :: Int -> SlideId -> ShowS
$cshowsPrec :: Int -> SlideId -> ShowS
Show, SlideId -> SlideId -> Bool
(SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool) -> Eq SlideId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlideId -> SlideId -> Bool
$c/= :: SlideId -> SlideId -> Bool
== :: SlideId -> SlideId -> Bool
$c== :: SlideId -> SlideId -> Bool
Eq, Eq SlideId
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
min :: SlideId -> SlideId -> SlideId
$cmin :: SlideId -> SlideId -> SlideId
max :: SlideId -> SlideId -> SlideId
$cmax :: SlideId -> SlideId -> SlideId
>= :: SlideId -> SlideId -> Bool
$c>= :: SlideId -> SlideId -> Bool
> :: SlideId -> SlideId -> Bool
$c> :: SlideId -> SlideId -> Bool
<= :: SlideId -> SlideId -> Bool
$c<= :: SlideId -> SlideId -> Bool
< :: SlideId -> SlideId -> Bool
$c< :: SlideId -> SlideId -> Bool
compare :: SlideId -> SlideId -> Ordering
$ccompare :: SlideId -> SlideId -> Ordering
$cp1Ord :: Eq SlideId
Ord)
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
showList :: [SpeakerNotes] -> ShowS
$cshowList :: [SpeakerNotes] -> ShowS
show :: SpeakerNotes -> String
$cshow :: SpeakerNotes -> String
showsPrec :: Int -> SpeakerNotes -> ShowS
$cshowsPrec :: Int -> SpeakerNotes -> ShowS
Show, SpeakerNotes -> SpeakerNotes -> Bool
(SpeakerNotes -> SpeakerNotes -> Bool)
-> (SpeakerNotes -> SpeakerNotes -> Bool) -> Eq SpeakerNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeakerNotes -> SpeakerNotes -> Bool
$c/= :: SpeakerNotes -> SpeakerNotes -> Bool
== :: SpeakerNotes -> SpeakerNotes -> Bool
$c== :: SpeakerNotes -> SpeakerNotes -> Bool
Eq, Semigroup SpeakerNotes
SpeakerNotes
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
mconcat :: [SpeakerNotes] -> SpeakerNotes
$cmconcat :: [SpeakerNotes] -> SpeakerNotes
mappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$cmappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
mempty :: SpeakerNotes
$cmempty :: SpeakerNotes
$cp1Monoid :: Semigroup SpeakerNotes
Monoid, b -> SpeakerNotes -> SpeakerNotes
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
stimes :: b -> SpeakerNotes -> SpeakerNotes
$cstimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
sconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
$csconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$c<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
Semigroup)
data Layout = MetadataSlide [ParaElem] [ParaElem] [[ParaElem]] [ParaElem]
| TitleSlide [ParaElem]
| ContentSlide [ParaElem] [Shape]
| TwoColumnSlide [ParaElem] [Shape] [Shape]
| ComparisonSlide [ParaElem] ([Shape], [Shape]) ([Shape], [Shape])
| ContentWithCaptionSlide [ParaElem] [Shape] [Shape]
| 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
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show, Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq)
data Shape = Pic PicProps FilePath T.Text [ParaElem]
| 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
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> Shape -> ShowS
Show, Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: Shape -> Shape -> Bool
Eq)
type TableCell = [Paragraph]
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
showList :: [TableProps] -> ShowS
$cshowList :: [TableProps] -> ShowS
show :: TableProps -> String
$cshow :: TableProps -> String
showsPrec :: Int -> TableProps -> ShowS
$cshowsPrec :: Int -> TableProps -> ShowS
Show, TableProps -> TableProps -> Bool
(TableProps -> TableProps -> Bool)
-> (TableProps -> TableProps -> Bool) -> Eq TableProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableProps -> TableProps -> Bool
$c/= :: TableProps -> TableProps -> Bool
== :: TableProps -> TableProps -> Bool
$c== :: TableProps -> TableProps -> Bool
Eq)
data Graphic = Tbl TableProps [TableCell] [[TableCell]]
deriving (Int -> Graphic -> ShowS
[Graphic] -> ShowS
Graphic -> String
(Int -> Graphic -> ShowS)
-> (Graphic -> String) -> ([Graphic] -> ShowS) -> Show Graphic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graphic] -> ShowS
$cshowList :: [Graphic] -> ShowS
show :: Graphic -> String
$cshow :: Graphic -> String
showsPrec :: Int -> Graphic -> ShowS
$cshowsPrec :: Int -> Graphic -> ShowS
Show, Graphic -> Graphic -> Bool
(Graphic -> Graphic -> Bool)
-> (Graphic -> Graphic -> Bool) -> Eq Graphic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graphic -> Graphic -> Bool
$c/= :: Graphic -> Graphic -> Bool
== :: Graphic -> Graphic -> Bool
$c== :: Graphic -> Graphic -> Bool
Eq)
data Paragraph = Paragraph { Paragraph -> ParaProps
paraProps :: ParaProps
, Paragraph -> [ParaElem]
paraElems :: [ParaElem]
} deriving (Int -> Paragraph -> ShowS
[Paragraph] -> ShowS
Paragraph -> String
(Int -> Paragraph -> ShowS)
-> (Paragraph -> String)
-> ([Paragraph] -> ShowS)
-> Show Paragraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paragraph] -> ShowS
$cshowList :: [Paragraph] -> ShowS
show :: Paragraph -> String
$cshow :: Paragraph -> String
showsPrec :: Int -> Paragraph -> ShowS
$cshowsPrec :: Int -> Paragraph -> ShowS
Show, Paragraph -> Paragraph -> Bool
(Paragraph -> Paragraph -> Bool)
-> (Paragraph -> Paragraph -> Bool) -> Eq Paragraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paragraph -> Paragraph -> Bool
$c/= :: Paragraph -> Paragraph -> Bool
== :: Paragraph -> Paragraph -> Bool
$c== :: Paragraph -> Paragraph -> Bool
Eq)
data BulletType = Bullet
| AutoNumbering ListAttributes
deriving (Int -> BulletType -> ShowS
[BulletType] -> ShowS
BulletType -> String
(Int -> BulletType -> ShowS)
-> (BulletType -> String)
-> ([BulletType] -> ShowS)
-> Show BulletType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BulletType] -> ShowS
$cshowList :: [BulletType] -> ShowS
show :: BulletType -> String
$cshow :: BulletType -> String
showsPrec :: Int -> BulletType -> ShowS
$cshowsPrec :: Int -> BulletType -> ShowS
Show, BulletType -> BulletType -> Bool
(BulletType -> BulletType -> Bool)
-> (BulletType -> BulletType -> Bool) -> Eq BulletType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BulletType -> BulletType -> Bool
$c/= :: BulletType -> BulletType -> Bool
== :: BulletType -> BulletType -> Bool
$c== :: BulletType -> BulletType -> Bool
Eq)
data Algnment = AlgnLeft | AlgnRight | AlgnCenter
deriving (Int -> Algnment -> ShowS
[Algnment] -> ShowS
Algnment -> String
(Int -> Algnment -> ShowS)
-> (Algnment -> String) -> ([Algnment] -> ShowS) -> Show Algnment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algnment] -> ShowS
$cshowList :: [Algnment] -> ShowS
show :: Algnment -> String
$cshow :: Algnment -> String
showsPrec :: Int -> Algnment -> ShowS
$cshowsPrec :: Int -> Algnment -> ShowS
Show, Algnment -> Algnment -> Bool
(Algnment -> Algnment -> Bool)
-> (Algnment -> Algnment -> Bool) -> Eq Algnment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algnment -> Algnment -> Bool
$c/= :: Algnment -> Algnment -> Bool
== :: Algnment -> Algnment -> Bool
$c== :: Algnment -> Algnment -> Bool
Eq)
data ParaProps = ParaProps { ParaProps -> Maybe Integer
pPropMarginLeft :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropMarginRight :: Maybe Pixels
, ParaProps -> Int
pPropLevel :: Int
, ParaProps -> Maybe BulletType
pPropBullet :: Maybe BulletType
, ParaProps -> Maybe Algnment
pPropAlign :: Maybe Algnment
, ParaProps -> Maybe Integer
pPropSpaceBefore :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropIndent :: Maybe Pixels
, ParaProps -> Bool
pPropIncremental :: Bool
} deriving (Int -> ParaProps -> ShowS
[ParaProps] -> ShowS
ParaProps -> String
(Int -> ParaProps -> ShowS)
-> (ParaProps -> String)
-> ([ParaProps] -> ShowS)
-> Show ParaProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParaProps] -> ShowS
$cshowList :: [ParaProps] -> ShowS
show :: ParaProps -> String
$cshow :: ParaProps -> String
showsPrec :: Int -> ParaProps -> ShowS
$cshowsPrec :: Int -> ParaProps -> ShowS
Show, ParaProps -> ParaProps -> Bool
(ParaProps -> ParaProps -> Bool)
-> (ParaProps -> ParaProps -> Bool) -> Eq ParaProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaProps -> ParaProps -> Bool
$c/= :: ParaProps -> ParaProps -> Bool
== :: ParaProps -> ParaProps -> Bool
$c== :: ParaProps -> ParaProps -> Bool
Eq)
instance Default ParaProps where
def :: ParaProps
def = ParaProps :: Maybe Integer
-> Maybe Integer
-> Int
-> Maybe BulletType
-> Maybe Algnment
-> Maybe Integer
-> Maybe Integer
-> Bool
-> ParaProps
ParaProps { pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
, pPropMarginRight :: Maybe Integer
pPropMarginRight = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
, pPropLevel :: Int
pPropLevel = 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 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
/= :: TeXString -> TeXString -> Bool
$c/= :: TeXString -> TeXString -> Bool
== :: TeXString -> TeXString -> Bool
$c== :: 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
showList :: [TeXString] -> ShowS
$cshowList :: [TeXString] -> ShowS
show :: TeXString -> String
$cshow :: TeXString -> String
showsPrec :: Int -> TeXString -> ShowS
$cshowsPrec :: Int -> TeXString -> ShowS
Show)
data ParaElem = Break
| Run RunProps T.Text
| 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
showList :: [ParaElem] -> ShowS
$cshowList :: [ParaElem] -> ShowS
show :: ParaElem -> String
$cshow :: ParaElem -> String
showsPrec :: Int -> ParaElem -> ShowS
$cshowsPrec :: Int -> ParaElem -> ShowS
Show, ParaElem -> ParaElem -> Bool
(ParaElem -> ParaElem -> Bool)
-> (ParaElem -> ParaElem -> Bool) -> Eq ParaElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaElem -> ParaElem -> Bool
$c/= :: ParaElem -> ParaElem -> Bool
== :: ParaElem -> ParaElem -> Bool
$c== :: ParaElem -> ParaElem -> Bool
Eq)
data Strikethrough = NoStrike | SingleStrike | DoubleStrike
deriving (Int -> Strikethrough -> ShowS
[Strikethrough] -> ShowS
Strikethrough -> String
(Int -> Strikethrough -> ShowS)
-> (Strikethrough -> String)
-> ([Strikethrough] -> ShowS)
-> Show Strikethrough
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strikethrough] -> ShowS
$cshowList :: [Strikethrough] -> ShowS
show :: Strikethrough -> String
$cshow :: Strikethrough -> String
showsPrec :: Int -> Strikethrough -> ShowS
$cshowsPrec :: Int -> Strikethrough -> ShowS
Show, Strikethrough -> Strikethrough -> Bool
(Strikethrough -> Strikethrough -> Bool)
-> (Strikethrough -> Strikethrough -> Bool) -> Eq Strikethrough
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strikethrough -> Strikethrough -> Bool
$c/= :: Strikethrough -> Strikethrough -> Bool
== :: Strikethrough -> Strikethrough -> Bool
$c== :: Strikethrough -> Strikethrough -> Bool
Eq)
data Capitals = NoCapitals | SmallCapitals | AllCapitals
deriving (Int -> Capitals -> ShowS
[Capitals] -> ShowS
Capitals -> String
(Int -> Capitals -> ShowS)
-> (Capitals -> String) -> ([Capitals] -> ShowS) -> Show Capitals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Capitals] -> ShowS
$cshowList :: [Capitals] -> ShowS
show :: Capitals -> String
$cshow :: Capitals -> String
showsPrec :: Int -> Capitals -> ShowS
$cshowsPrec :: Int -> Capitals -> ShowS
Show, Capitals -> Capitals -> Bool
(Capitals -> Capitals -> Bool)
-> (Capitals -> Capitals -> Bool) -> Eq Capitals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capitals -> Capitals -> Bool
$c/= :: Capitals -> Capitals -> Bool
== :: Capitals -> Capitals -> Bool
$c== :: Capitals -> Capitals -> Bool
Eq)
type URL = T.Text
data LinkTarget = ExternalTarget (URL, T.Text)
| InternalTarget SlideId
deriving (Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show, LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq)
data RunProps = RunProps { RunProps -> Bool
rPropBold :: Bool
, RunProps -> Bool
rPropItalics :: Bool
, RunProps -> Maybe Strikethrough
rStrikethrough :: Maybe Strikethrough
, RunProps -> Maybe Int
rBaseline :: Maybe Int
, RunProps -> Maybe Capitals
rCap :: Maybe Capitals
, RunProps -> Maybe LinkTarget
rLink :: Maybe LinkTarget
, RunProps -> Bool
rPropCode :: Bool
, RunProps -> Bool
rPropBlockQuote :: Bool
, RunProps -> Maybe Integer
rPropForceSize :: Maybe Pixels
, RunProps -> Maybe Color
rSolidFill :: Maybe Color
, 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
showList :: [RunProps] -> ShowS
$cshowList :: [RunProps] -> ShowS
show :: RunProps -> String
$cshow :: RunProps -> String
showsPrec :: Int -> RunProps -> ShowS
$cshowsPrec :: Int -> RunProps -> ShowS
Show, RunProps -> RunProps -> Bool
(RunProps -> RunProps -> Bool)
-> (RunProps -> RunProps -> Bool) -> Eq RunProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunProps -> RunProps -> Bool
$c/= :: RunProps -> RunProps -> Bool
== :: RunProps -> RunProps -> Bool
$c== :: RunProps -> RunProps -> Bool
Eq)
instance Default RunProps where
def :: RunProps
def = RunProps :: Bool
-> Bool
-> Maybe Strikethrough
-> Maybe Int
-> Maybe Capitals
-> Maybe LinkTarget
-> Bool
-> Bool
-> Maybe Integer
-> Maybe Color
-> Bool
-> RunProps
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
showList :: [PicProps] -> ShowS
$cshowList :: [PicProps] -> ShowS
show :: PicProps -> String
$cshow :: PicProps -> String
showsPrec :: Int -> PicProps -> ShowS
$cshowsPrec :: Int -> PicProps -> ShowS
Show, PicProps -> PicProps -> Bool
(PicProps -> PicProps -> Bool)
-> (PicProps -> PicProps -> Bool) -> Eq PicProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PicProps -> PicProps -> Bool
$c/= :: PicProps -> PicProps -> Bool
== :: PicProps -> PicProps -> Bool
$c== :: PicProps -> PicProps -> Bool
Eq)
instance Default PicProps where
def :: PicProps
def = PicProps :: Maybe LinkTarget -> Maybe Dimension -> Maybe Dimension -> PicProps
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 s :: 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 (m :: * -> *) a. Monad m => a -> m a
return [RunProps -> Text -> ParaElem
Run RunProps
pr Text
s]
inlineToParElems (Emph ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropItalics :: Bool
rPropItalics=Bool
True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Underline ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropUnderline :: Bool
rPropUnderline=Bool
True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strong ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropBold :: Bool
rPropBold=Bool
True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strikeout ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rStrikethrough :: Maybe Strikethrough
rStrikethrough=Strikethrough -> Maybe Strikethrough
forall a. a -> Maybe a
Just Strikethrough
SingleStrike}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Superscript ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=Int -> Maybe Int
forall a. a -> Maybe a
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 ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=Int -> Maybe Int
forall a. a -> Maybe a
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 ils :: [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rCap :: Maybe Capitals
rCap = Capitals -> Maybe Capitals
forall a. a -> Maybe a
Just Capitals
SmallCapitals}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems Space = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str " ")
inlineToParElems SoftBreak = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str " ")
inlineToParElems LineBreak = [ParaElem] -> Pres [ParaElem]
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaElem
Break]
inlineToParElems (Link _ ils :: [Inline]
ils (url :: Text
url, title :: Text
title)) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r ->WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rLink :: Maybe LinkTarget
rLink = LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> LinkTarget
ExternalTarget (Text
url, Text
title)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Code _ str :: Text
str) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r ->WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropCode :: Bool
rPropCode = Bool
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
mathtype str :: Text
str) =
[ParaElem] -> Pres [ParaElem]
forall (m :: * -> *) a. Monad m => a -> m a
return [MathType -> TeXString -> ParaElem
MathElem MathType
mathtype (Text -> TeXString
TeXString Text
str)]
inlineToParElems (Note blks :: [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 (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 0 NonEmpty Int -> Int
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
+ 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
$ \st :: WriterState
st -> WriterState
st { stNoteIds :: Map Int [Block]
stNoteIds = Int -> [Block] -> Map Int [Block] -> Map Int [Block]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
curNoteId [Block]
blks Map Int [Block]
notes }
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
env){rLink :: Maybe LinkTarget
rLink = LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$ SlideId -> LinkTarget
InternalTarget SlideId
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 _ ils :: [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Quoted quoteType :: QuoteType
quoteType ils :: [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 (open :: Text
open, close :: Text
close) = case QuoteType
quoteType of
SingleQuote -> ("\x2018", "\x2019")
DoubleQuote -> ("\x201C", "\x201D")
inlineToParElems il :: Inline
il@(RawInline fmt :: Format
fmt s :: Text
s) =
case Format
fmt of
Format "openxml" -> [ParaElem] -> Pres [ParaElem]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> ParaElem
RawOOXMLParaElem Text
s]
_ -> 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 (m :: * -> *) a. Monad m => a -> m a
return []
inlineToParElems (Cite _ ils :: [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Image _ alt :: [Inline]
alt _) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
alt
isListType :: Block -> Bool
isListType :: Block -> Bool
isListType (OrderedList _ _) = Bool
True
isListType (BulletList _) = Bool
True
isListType (DefinitionList _) = Bool
True
isListType _ = Bool
False
registerAnchorId :: T.Text -> Pres ()
registerAnchorId :: Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId anchor :: 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
$ \st :: WriterState
st -> WriterState
st {stAnchorMap :: Map Text SlideId
stAnchorMap = Text -> SlideId -> Map Text SlideId -> Map Text SlideId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
anchor SlideId
sldId Map Text SlideId
anchorMap}
blockQuoteSize :: Pixels
blockQuoteSize :: Integer
blockQuoteSize = 20
noteSize :: Pixels
noteSize :: Integer
noteSize = 18
blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs (Plain ils :: [Inline]
ils) = Block -> Pres [Paragraph]
blockToParagraphs ([Inline] -> Block
Para [Inline]
ils)
blockToParagraphs (Para ils :: [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 (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
blockToParagraphs (LineBlock ilsList :: [[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 (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
blockToParagraphs (CodeBlock attr :: Attr
attr str :: 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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{ envParaProps :: ParaProps
envParaProps = ParaProps
forall a. Default a => a
def{ pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Maybe Integer
forall a. Maybe a
Nothing
, pPropBullet :: Maybe BulletType
pPropBullet = Maybe BulletType
forall a. Maybe a
Nothing
, pPropLevel :: Int
pPropLevel = ParaProps -> Int
pPropLevel ParaProps
pProps
, pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
}
, envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropCode :: Bool
rPropCode = Bool
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 sty :: 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 pElems :: [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 (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pPropsNew [ParaElem]
pElems]
Left _ -> 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]
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]
blockToParagraphs (BlockQuote (blk :: Block
blk : blks :: [Block]
blks)) | Block -> Bool
isListType Block
blk = do
[Paragraph]
ps <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env { envInListInBlockQuote :: Bool
envInListInBlockQuote = Bool
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 (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 blks :: [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r{ envParaProps :: ParaProps
envParaProps = (WriterEnv -> ParaProps
envParaProps WriterEnv
r){ pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 100
, pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
}
, envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rPropForceSize :: Maybe Integer
rPropForceSize = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
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
blockToParagraphs blk :: Block
blk@(RawBlock _ _) = 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 (m :: * -> *) a. Monad m => a -> m a
return []
blockToParagraphs (Header _ (ident :: Text
ident, _, _) ils :: [Inline]
ils) = do
Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
[ParaElem]
parElems <- (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\e :: WriterEnv
e->WriterEnv
e{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
e){rPropBold :: Bool
rPropBold=Bool
True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
[Paragraph] -> Pres [Paragraph]
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def{pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = Integer -> Maybe Integer
forall a. a -> Maybe a
Just 30} [ParaElem]
parElems]
blockToParagraphs (BulletList blksLst :: [[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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env{ envInList :: Bool
envInList = Bool
True
, envParaProps :: ParaProps
envParaProps = ParaProps
pProps{ pPropBullet :: Maybe BulletType
pPropBullet = BulletType -> Maybe BulletType
forall a. a -> Maybe a
Just BulletType
Bullet
, pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Maybe Integer
forall a. Maybe a
Nothing
, pPropIndent :: Maybe Integer
pPropIndent = Maybe Integer
forall a. Maybe a
Nothing
, pPropIncremental :: Bool
pPropIncremental = Bool
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 listAttr :: ListAttributes
listAttr blksLst :: [[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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env{ envInList :: Bool
envInList = Bool
True
, envParaProps :: ParaProps
envParaProps = ParaProps
pProps{ pPropBullet :: Maybe BulletType
pPropBullet = BulletType -> Maybe BulletType
forall a. a -> Maybe a
Just (ListAttributes -> BulletType
AutoNumbering ListAttributes
listAttr)
, pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Maybe Integer
forall a. Maybe a
Nothing
, pPropIndent :: Maybe Integer
pPropIndent = Maybe Integer
forall a. Maybe a
Nothing
, pPropIncremental :: Bool
pPropIncremental = Bool
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 entries :: [([Inline], [[Block]])]
entries) = do
Bool
incremental <- Pres Bool
listShouldBeIncremental
let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go (ils :: [Inline]
ils, blksLst :: [[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]
[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 (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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env {envParaProps :: ParaProps
envParaProps =
(WriterEnv -> ParaProps
envParaProps WriterEnv
env) {pPropIncremental :: Bool
pPropIncremental = Bool
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 (_, classes :: [Text]
classes, _) blks :: [Block]
blks) = let
hasIncremental :: Bool
hasIncremental = "incremental" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
hasNonIncremental :: Bool
hasNonIncremental = "nonincremental" Text -> [Text] -> 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 env :: WriterEnv
env = WriterEnv
env { envInIncrementalDiv :: Maybe InIncrementalDiv
envInIncrementalDiv = Maybe InIncrementalDiv
incremental }
in (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
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 blk :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
multiParList :: [Block] -> Pres [Paragraph]
multiParList :: [Block] -> Pres [Paragraph]
multiParList [] = [Paragraph] -> Pres [Paragraph]
forall (m :: * -> *) a. Monad m => a -> m a
return []
multiParList (b :: Block
b:bs :: [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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env
{ envParaProps :: ParaProps
envParaProps = ParaProps
pProps
{ pPropBullet :: Maybe BulletType
pPropBullet = Maybe BulletType
forall a. Maybe a
Nothing
, pPropLevel :: Int
pPropLevel = Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 (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 algn :: Alignment
algn tblCell :: [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)
mapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
tblCell
let alignment :: Maybe Algnment
alignment = case Alignment
algn of
AlignLeft -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnLeft
AlignRight -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnRight
AlignCenter -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnCenter
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 (\p :: Paragraph
p -> Paragraph
p{paraProps :: ParaProps
paraProps = (Paragraph -> ParaProps
paraProps Paragraph
p){pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
alignment}})) [[Paragraph]]
paras
[Paragraph] -> Pres [Paragraph]
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 algns :: [Alignment]
algns tblCells :: [[Block]]
tblCells = do
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)
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
attr (Pic picPr :: PicProps
picPr url :: String
url title :: Text
title caption :: [ParaElem]
caption) =
let picPr' :: PicProps
picPr' = PicProps
picPr { picWidth :: Maybe Dimension
picWidth = Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr
, picHeight :: Maybe Dimension
picHeight = Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr
}
in
PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
picPr' String
url Text
title [ParaElem]
caption
withAttr _ sp :: Shape
sp = Shape
sp
blockToShape :: Block -> Pres Shape
blockToShape :: Block -> Pres Shape
blockToShape (Plain ils :: [Inline]
ils) = Block -> Pres Shape
blockToShape ([Inline] -> Block
Para [Inline]
ils)
blockToShape (Para (il :: Inline
il:_)) | Image attr :: Attr
attr ils :: [Inline]
ils (url :: Text
url, title :: 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 (il :: Inline
il:_)) | Link _ (il' :: Inline
il':_) target :: (Text, Text)
target <- Inline
il
, Image attr :: Attr
attr ils :: [Inline]
ils (url :: Text
url, title :: 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 :: Maybe LinkTarget
picPropLink = LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> LinkTarget
ExternalTarget (Text, Text)
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 (Table _ blkCapt :: Caption
blkCapt specs :: [ColSpec]
specs thead :: TableHead
thead tbody :: [TableBody]
tbody tfoot :: TableFoot
tfoot) = do
let (caption :: [Inline]
caption, algn :: [Alignment]
algn, _, hdrCells :: [[Block]]
hdrCells, rows :: [[[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)
mapM ([Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algn) [[[Block]]]
rows
let tblPr :: TableProps
tblPr = if [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
hdrCells
then TableProps :: Bool -> Bool -> TableProps
TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
False
, tblPrBandRow :: Bool
tblPrBandRow = Bool
True
}
else TableProps :: Bool -> Bool -> TableProps
TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
True
, tblPrBandRow :: Bool
tblPrBandRow = Bool
True
}
Shape -> Pres Shape
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 [TableProps -> [[Paragraph]] -> [[[Paragraph]]] -> Graphic
Tbl TableProps
tblPr [[Paragraph]]
hdrCells' [[[Paragraph]]]
rows'] [ParaElem]
caption'
blockToShape (RawBlock (Format "openxml") str :: Text
str) = Shape -> Pres Shape
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 blk :: 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 (\par :: Paragraph
par -> Paragraph
par{paraElems :: [ParaElem]
paraElems = [ParaElem] -> [ParaElem]
combineParaElems ([ParaElem] -> [ParaElem]) -> [ParaElem] -> [ParaElem]
forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
par}) [Paragraph]
paras
Shape -> Pres Shape
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{} : ss :: [Shape]
ss) = Shape
pic Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (TextBox [] : ss :: [Shape]
ss) = [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (s :: Shape
s : TextBox [] : ss :: [Shape]
ss) = [Shape] -> [Shape]
combineShapes (Shape
s Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss)
combineShapes (TextBox (p :: Paragraph
p:ps :: [Paragraph]
ps) : TextBox (p' :: Paragraph
p':ps' :: [Paragraph]
ps') : ss :: [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 (s :: Shape
s:ss :: [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 (_, ["notes"], _) _) = Bool
True
isNotesDiv _ = Bool
False
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes blks :: [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)
mapM Block -> Pres Shape
blockToShape [Block]
blks
isImage :: Inline -> Bool
isImage :: Inline -> Bool
isImage Image{} = Bool
True
isImage (Link _ (Image{} : _) _) = Bool
True
isImage _ = Bool
False
plainOrPara :: Block -> Maybe [Inline]
plainOrPara :: Block -> Maybe [Inline]
plainOrPara (Plain ils :: [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara (Para ils :: [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara _ = Maybe [Inline]
forall a. Maybe a
Nothing
notText :: Block -> Bool
notText :: Block -> Bool
notText block :: Block
block | Block -> Bool
startsWithImage Block
block = Bool
True
notText Table{} = Bool
True
notText _ = Bool
False
startsWithImage :: Block -> Bool
startsWithImage :: Block -> Bool
startsWithImage block :: 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> Bool
isImage Inline
inline)
splitBlocks' ::
[Block] ->
[[Block]] ->
[Block] ->
Pres [[Block]]
splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' cur :: [Block]
cur acc :: [[Block]]
acc [] = [[Block]] -> Pres [[Block]]
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])
splitBlocks' cur :: [Block]
cur acc :: [[Block]]
acc (HorizontalRule : blks :: [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks
splitBlocks' cur :: [Block]
cur acc :: [[Block]]
acc (h :: Block
h@(Header n :: Int
n _ _) : blks :: [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 (nts :: [Block]
nts, blks' :: [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
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 (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'
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks'
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'
splitBlocks' cur :: [Block]
cur acc :: [[Block]]
acc (Plain ils :: [Inline]
ils : blks :: [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' cur :: [Block]
cur acc :: [[Block]]
acc (Para (il :: Inline
il:ils :: [Inline]
ils) : blks :: [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 (nts :: [Block]
nts, blks' :: [Block]
blks') = if [Inline] -> 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 n :: Int
n _ _] | 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
== 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 (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] -> 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 (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 (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' cur :: [Block]
cur acc :: [[Block]]
acc (tbl :: Block
tbl@Table{} : blks :: [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 (nts :: [Block]
nts, blks' :: [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 n :: Int
n _ _] | 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
== 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] -> 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 (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' cur :: [Block]
cur acc :: [[Block]]
acc (d :: Block
d@(Div (_, classes :: [Text]
classes, _) _): blks :: [Block]
blks) | "columns" Text -> [Text] -> 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 (nts :: [Block]
nts, blks' :: [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 n :: Int
n _ _] | 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
== 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] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> 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' cur :: [Block]
cur acc :: [[Block]]
acc (blk :: Block
blk : blks :: [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' [] []
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide _ (blk :: Block
blk : blks :: [Block]
blks) spkNotes :: SpeakerNotes
spkNotes
| Div (_, classes :: [Text]
classes, _) divBlks :: [Block]
divBlks <- Block
blk
, "columns" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, Div (_, clsL :: [Text]
clsL, _) blksL :: [Block]
blksL : Div (_, clsR :: [Text]
clsR, _) blksR :: [Block]
blksR : remaining :: [Block]
remaining <- [Block]
divBlks
, "column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsL, "column" Text -> [Text] -> 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 left :: [Block]
left right :: [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 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 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 (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 blksL1 :: [Block]
blksL1 blksL2 :: [Block]
blksL2 blksR1 :: [Block]
blksR1 blksR2 :: [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 (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 (blksL1 :: [Block]
blksL1, blksL2 :: [Block]
blksL2) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksL
(blksR1 :: [Block]
blksR1, blksR2 :: [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 (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 (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 _ (blk :: Block
blk : blks :: [Block]
blks) spkNotes :: 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 s :: 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 (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
([], _) -> Pres Slide
contentOrBlankSlide
(_, []) -> Pres Slide
contentOrBlankSlide
(textBlocks :: [Block]
textBlocks, contentBlocks :: [Block]
contentBlocks) -> do
[Shape]
textShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
textBlocks
[Shape]
contentShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
contentBlocks
Slide -> Pres Slide
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> Slide
mkSlide ([ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [] [Shape]
textShapes [Shape]
contentShapes))
bodyBlocksToSlide _ [] spkNotes :: 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 (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' lvl :: Int
lvl (Header n :: Int
n (ident :: Text
ident, _, attributes :: [(Text, Text)]
attributes) ils :: [Inline]
ils : blks :: [Block]
blks) spkNotes :: 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 (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
== 0 = do
Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
[ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
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 _ cont :: [Shape]
cont -> [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr [Shape]
cont
TwoColumnSlide _ contL :: [Shape]
contL contR :: [Shape]
contR -> [ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [ParaElem]
hdr [Shape]
contL [Shape]
contR
ComparisonSlide _ contL :: ([Shape], [Shape])
contL contR :: ([Shape], [Shape])
contR -> [ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [ParaElem]
hdr ([Shape], [Shape])
contL ([Shape], [Shape])
contR
ContentWithCaptionSlide _ text :: [Shape]
text content :: [Shape]
content -> [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr [Shape]
text [Shape]
content
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
layout'
Slide -> Pres Slide
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
slideLayout = Layout
layout, slideBackgroundImage :: Maybe String
slideBackgroundImage = Maybe String
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 "background-image" [(Text, Text)]
attributes
Maybe Text -> Maybe Text -> Maybe Text
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 "data-background-image" [(Text, Text)]
attributes)
blocksToSlide' lvl :: Int
lvl blks :: [Block]
blks spkNotes :: SpeakerNotes
spkNotes = Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes (Div (_, ["notes"], _) blks :: [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres SpeakerNotes -> Pres SpeakerNotes
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env{envInSpeakerNotes :: Bool
envInSpeakerNotes=Bool
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 _ = SpeakerNotes -> Pres SpeakerNotes
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 blk :: 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
$ \st :: WriterState
st -> WriterState
st{stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = WriterState -> SpeakerNotes
stSpeakerNotes WriterState
st SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a. Semigroup a => a -> a -> a
<> SpeakerNotes
spNotes}
handleAndFilterSpeakerNotes' :: [Block] -> Pres [Block]
handleAndFilterSpeakerNotes' :: [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' blks :: [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 (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 blks :: [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
$ \st :: WriterState
st -> WriterState
st{stSpeakerNotes :: SpeakerNotes
stSpeakerNotes = SpeakerNotes
forall a. Monoid a => a
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
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 (m :: * -> *) a. Monad m => a -> m a
return ([Block]
blks', SpeakerNotes
spkNotes)
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide blks :: [Block]
blks = do
(blks' :: [Block]
blks', spkNotes :: 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 (n :: Int
n, blks :: [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
<> ".")
in
case [Block]
blks of
(Para ils :: [Inline]
ils : blks' :: [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'
_ -> [Inline] -> Block
Para [Inline
enum] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks
forceFontSize :: Pixels -> Pres a -> Pres a
forceFontSize :: Integer -> Pres a -> Pres a
forceFontSize px :: Integer
px x :: 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 r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: WriterEnv
r -> WriterEnv
r {envRunProps :: RunProps
envRunProps = RunProps
rpr{rPropForceSize :: Maybe Integer
rPropForceSize = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
px}}) Pres a
x
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
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 (m :: * -> *) a. Monad m => a -> m a
return []
else let title :: [Inline]
title = case Text -> Meta -> [Inline]
lookupMetaInlines "notes-title" Meta
meta of
[] -> [Text -> Inline
Str "Notes"]
ls :: [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 (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 "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)
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
title Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitle Bool -> Bool -> Bool
&& [[ParaElem]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ParaElem]]
authors Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
date
then Maybe Slide -> Pres (Maybe Slide)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Slide
forall a. Maybe a
Nothing
else Maybe Slide -> Pres (Maybe Slide)
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 sldId :: SlideId
sldId layout :: Layout
layout@MetadataSlide{} spkNotes :: SpeakerNotes
spkNotes backgroundImage :: Maybe String
backgroundImage) blks :: [Block]
blks =
do let (ntsBlks :: [Block]
ntsBlks, blks' :: [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)
mapM Block -> Pres SpeakerNotes
blockToSpeakerNotes [Block]
ntsBlks
(Slide, [Block]) -> Pres (Slide, [Block])
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 sld :: Slide
sld blks :: [Block]
blks = (Slide, [Block]) -> Pres (Slide, [Block])
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide
sld, [Block]
blks)
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide blks :: [Block]
blks = (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: WriterEnv
env -> WriterEnv
env{envCurSlideId :: SlideId
envCurSlideId = SlideId
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 "toc-title" Meta
meta of
[] -> [Text -> Inline
Str "Table of Contents"]
ls :: [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' mbPElem :: Maybe ParaElem
mbPElem [] = Maybe ParaElem -> [ParaElem]
forall a. Maybe a -> [a]
maybeToList Maybe ParaElem
mbPElem
combineParaElems' Nothing (pElem :: ParaElem
pElem : pElems :: [ParaElem]
pElems) =
Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems
combineParaElems' (Just pElem' :: ParaElem
pElem') (pElem :: ParaElem
pElem : pElems :: [ParaElem]
pElems)
| Run rPr' :: RunProps
rPr' s' :: Text
s' <- ParaElem
pElem'
, Run rPr :: RunProps
rPr s :: 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 :: (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph f :: ParaElem -> m ParaElem
f para :: 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)
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 (m :: * -> *) a. Monad m => a -> m a
return (Paragraph -> m Paragraph) -> Paragraph -> m Paragraph
forall a b. (a -> b) -> a -> b
$ Paragraph
para {paraElems :: [ParaElem]
paraElems = [ParaElem]
paraElems'}
applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape :: (ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape f :: ParaElem -> m ParaElem
f (Pic pPr :: PicProps
pPr fp :: String
fp title :: Text
title pes :: [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)
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape f :: ParaElem -> m ParaElem
f (GraphicFrame gfx :: [Graphic]
gfx pes :: [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)
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape f :: ParaElem -> m ParaElem
f (TextBox paras :: [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)
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 _ (RawOOXMLShape str :: Text
str) = Shape -> m Shape
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 :: (ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout f :: ParaElem -> m ParaElem
f (MetadataSlide title :: [ParaElem]
title subtitle :: [ParaElem]
subtitle authors :: [[ParaElem]]
authors date :: [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)
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)
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)
mapM ((ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f) [[ParaElem]]
authors
[ParaElem]
date' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ParaElem -> m ParaElem
f [ParaElem]
date
Layout -> m Layout
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 f :: ParaElem -> m ParaElem
f (TitleSlide title :: [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)
mapM ParaElem -> m ParaElem
f [ParaElem]
title
applyToLayout f :: ParaElem -> m ParaElem
f (ContentSlide hdr :: [ParaElem]
hdr content :: [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)
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)
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 (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 f :: ParaElem -> m ParaElem
f (TwoColumnSlide hdr :: [ParaElem]
hdr contentL :: [Shape]
contentL contentR :: [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)
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)
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)
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 (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 f :: ParaElem -> m ParaElem
f (ComparisonSlide hdr :: [ParaElem]
hdr (contentL1 :: [Shape]
contentL1, contentL2 :: [Shape]
contentL2) (contentR1 :: [Shape]
contentR1, contentR2 :: [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)
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)
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)
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)
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)
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 (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 f :: ParaElem -> m ParaElem
f (ContentWithCaptionSlide hdr :: [ParaElem]
hdr textShapes :: [Shape]
textShapes contentShapes :: [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)
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)
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)
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 (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 _ BlankSlide = Layout -> m Layout
forall (f :: * -> *) a. Applicative f => a -> f a
pure Layout
BlankSlide
applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide :: (ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide f :: ParaElem -> m ParaElem
f slide :: 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)
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 (m :: * -> *) a. Monad m => a -> m a
return Slide
slide{slideLayout :: Layout
slideLayout = Layout
layout', slideSpeakerNotes :: SpeakerNotes
slideSpeakerNotes = SpeakerNotes
notes'}
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor (Run rProps :: RunProps
rProps s :: Text
s)
| Just (ExternalTarget (Text -> Maybe (Char, Text)
T.uncons -> Just ('#', anchor :: Text
anchor), _)) <- 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
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 n :: SlideId
n -> RunProps
rProps{rLink :: Maybe LinkTarget
rLink = LinkTarget -> Maybe LinkTarget
forall a. a -> Maybe a
Just (LinkTarget -> Maybe LinkTarget) -> LinkTarget -> Maybe LinkTarget
forall a b. (a -> b) -> a -> b
$ SlideId -> LinkTarget
InternalTarget SlideId
n}
Nothing -> RunProps
rProps{rLink :: Maybe LinkTarget
rLink = Maybe LinkTarget
forall a. Maybe a
Nothing}
ParaElem -> Pres ParaElem
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 pe :: ParaElem
pe = ParaElem -> Pres ParaElem
forall (m :: * -> *) a. Monad m => a -> m a
return ParaElem
pe
emptyParaElem :: ParaElem -> Bool
emptyParaElem :: ParaElem -> Bool
emptyParaElem (Run _ s :: 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 _ ts :: 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 _ = Bool
False
emptyParagraph :: Paragraph -> Bool
emptyParagraph :: Paragraph -> Bool
emptyParagraph para :: 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 paras :: [Paragraph]
paras) = (Paragraph -> Bool) -> [Paragraph] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Paragraph -> Bool
emptyParagraph [Paragraph]
paras
emptyShape _ = Bool
False
emptyLayout :: Layout -> Bool
emptyLayout :: Layout -> Bool
emptyLayout layout :: Layout
layout = case Layout
layout of
MetadataSlide title :: [ParaElem]
title subtitle :: [ParaElem]
subtitle authors :: [[ParaElem]]
authors date :: [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 hdr :: [ParaElem]
hdr -> (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr
ContentSlide hdr :: [ParaElem]
hdr shapes :: [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 hdr :: [ParaElem]
hdr shapes1 :: [Shape]
shapes1 shapes2 :: [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 hdr :: [ParaElem]
hdr (shapesL1 :: [Shape]
shapesL1, shapesL2 :: [Shape]
shapesL2) (shapesR1 :: [Shape]
shapesR1, shapesR2 :: [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 hdr :: [ParaElem]
hdr textShapes :: [Shape]
textShapes contentShapes :: [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
BlankSlide -> Bool
False
emptySlide :: Slide -> Bool
emptySlide :: Slide -> Bool
emptySlide (Slide _ layout :: Layout
layout notes :: SpeakerNotes
notes backgroundImage :: 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 ins :: [Inline]
ins -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
Para ins :: [Inline]
ins -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
LineBlock inss :: [[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 _ txt :: Text
txt -> Text -> Bool
textIsBlank Text
txt
RawBlock _ txt :: Text
txt -> Text -> Bool
textIsBlank Text
txt
BlockQuote bls :: [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
OrderedList _ blss :: [[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 blss :: [[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 ds :: [([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 (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 _ _ ils :: [Inline]
ils -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ils
HorizontalRule -> Bool
True
Table{} -> Bool
False
Div _ bls :: [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
Null -> Bool
True
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 txt :: Text
txt) -> Text -> Bool
textIsBlank Text
txt
(Emph ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Underline ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Strong ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Strikeout ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Superscript ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Subscript ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(SmallCaps ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Quoted _ ins :: [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Cite _ _) -> Bool
False
(Code _ txt :: Text
txt) -> Text -> Bool
textIsBlank Text
txt
Space -> Bool
True
SoftBreak -> Bool
True
LineBreak -> Bool
True
(Math _ txt :: Text
txt) -> Text -> Bool
textIsBlank Text
txt
(RawInline _ txt :: Text
txt) -> Text -> Bool
textIsBlank Text
txt
(Link _ ins :: [Inline]
ins (t1 :: Text
t1, t2 :: 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 _ ins :: [Inline]
ins (t1 :: Text
t1, t2 :: 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 bls :: [Block]
bls) -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
(Span _ ins :: [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 blks :: [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
(metadataslides :: [Slide]
metadataslides, blks' :: [Block]
blks') <- case Maybe Slide
mbMetadataSlide of
Just sld :: Slide
sld ->
do (s :: Slide
s, bs :: [Block]
bs) <- Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks
([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Slide
s], [Block]
bs)
Nothing -> ([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Block]
blks)
[[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)
mapM
(\n :: Integer
n -> Text -> Pres SlideId
runUniqueSlideId (Text -> Pres SlideId) -> Text -> Pres SlideId
forall a b. (a -> b) -> a -> b
$ "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 (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
blksLst) [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)
mapM
(\(bs :: [Block]
bs, ident :: SlideId
ident) ->
(WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\st :: WriterEnv
st -> WriterEnv
st{envCurSlideId :: SlideId
envCurSlideId = SlideId
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
[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 (m :: * -> *) a. Monad m => a -> m a
return [Slide
toc]
else [Slide] -> Pres [Slide]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Slide]
endNotesSlides <- if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
endNotesSlideBlocks
then [Slide] -> Pres [Slide]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do Slide
endNotesSlide <- (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
(\env :: WriterEnv
env -> WriterEnv
env { envCurSlideId :: SlideId
envCurSlideId = SlideId
endNotesSlideId
, envInNoteSlide :: Bool
envInNoteSlide = Bool
True
})
([Block] -> Pres Slide
blocksToSlide [Block]
endNotesSlideBlocks)
[Slide] -> Pres [Slide]
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)
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
meta =
let keywords :: Maybe [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta "keywords" Meta
meta of
Just (MetaList xs :: [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 [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
ss :: [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]
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 "description" Meta
meta of
[] -> Maybe Text
forall a. Maybe a
Nothing
ss :: [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 "_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` ["title", "author", "keywords", "description"
, "subject","lang","category"]] of
[] -> Maybe [(Text, Text)]
forall a. Maybe a
Nothing
ss :: [(Text, Text)]
ss -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text, Text)]
ss
in
DocProps :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [(Text, Text)]
-> DocProps
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 "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 "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 "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 opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blks :: [Block]
blks) =
let env :: WriterEnv
env = WriterEnv
forall a. Default a => a
def { envOpts :: WriterOptions
envOpts = WriterOptions
opts
, envMetadata :: Meta
envMetadata = Meta
meta
, envSlideLevel :: Int
envSlideLevel = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
getSlideLevel [Block]
blks) (WriterOptions -> Maybe Int
writerSlideLevel WriterOptions
opts)
}
(presSlides :: [Slide]
presSlides, msgs :: [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 tokSty :: TokenStyle
tokSty rProps :: RunProps
rProps =
RunProps
rProps{ rSolidFill :: Maybe Color
rSolidFill = TokenStyle -> Maybe Color
tokenColor TokenStyle
tokSty Maybe Color -> Maybe Color -> Maybe Color
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunProps -> Maybe Color
rSolidFill RunProps
rProps
, rPropBold :: Bool
rPropBold = TokenStyle -> Bool
tokenBold TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropBold RunProps
rProps
, rPropItalics :: Bool
rPropItalics = TokenStyle -> Bool
tokenItalic TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropItalics RunProps
rProps
, rPropUnderline :: Bool
rPropUnderline = TokenStyle -> Bool
tokenUnderline TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropUnderline RunProps
rProps
}
formatToken :: Style -> Token -> ParaElem
formatToken :: Style -> Token -> ParaElem
formatToken sty :: Style
sty (tokType :: TokenType
tokType, txt :: Text
txt) =
let rProps :: RunProps
rProps = RunProps
forall a. Default a => a
def{rPropCode :: Bool
rPropCode = Bool
True, rSolidFill :: Maybe Color
rSolidFill = Style -> Maybe Color
defaultColor Style
sty}
rProps' :: RunProps
rProps' = case 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 tokSty :: TokenStyle
tokSty -> TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps
Nothing -> RunProps
rProps
in
RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
txt
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine sty :: Style
sty _ srcLn :: 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 sty :: Style
sty opts :: FormatOptions
opts srcLns :: [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