{-# 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
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
$cshowsPrec :: Int -> WriterEnv -> ShowS
showsPrec :: Int -> WriterEnv -> ShowS
$cshow :: WriterEnv -> String
show :: WriterEnv -> String
$cshowList :: [WriterEnv] -> ShowS
showList :: [WriterEnv] -> ShowS
Show)
instance Default WriterEnv where
def :: WriterEnv
def = WriterEnv { envMetadata :: Meta
envMetadata = Meta
forall a. Monoid a => a
mempty
, envRunProps :: RunProps
envRunProps = RunProps
forall a. Default a => a
def
, envParaProps :: ParaProps
envParaProps = ParaProps
forall a. Default a => a
def
, envSlideLevel :: Int
envSlideLevel = Int
2
, envOpts :: WriterOptions
envOpts = WriterOptions
forall a. Default a => a
def
, envSlideHasHeader :: Bool
envSlideHasHeader = Bool
False
, envInList :: Bool
envInList = Bool
False
, envInNoteSlide :: Bool
envInNoteSlide = Bool
False
, envCurSlideId :: SlideId
envCurSlideId = Text -> SlideId
SlideId Text
"Default"
, envInSpeakerNotes :: Bool
envInSpeakerNotes = Bool
False
, envInIncrementalDiv :: Maybe InIncrementalDiv
envInIncrementalDiv = Maybe InIncrementalDiv
forall a. Maybe a
Nothing
, envInListInBlockQuote :: Bool
envInListInBlockQuote = Bool
False
}
data WriterState = WriterState { WriterState -> Map Int [Block]
stNoteIds :: M.Map Int [Block]
, WriterState -> Map Text SlideId
stAnchorMap :: M.Map T.Text SlideId
, WriterState -> Set SlideId
stSlideIdSet :: S.Set SlideId
, WriterState -> [LogMessage]
stLog :: [LogMessage]
, WriterState -> SpeakerNotes
stSpeakerNotes :: SpeakerNotes
} deriving (Int -> WriterState -> ShowS
[WriterState] -> ShowS
WriterState -> String
(Int -> WriterState -> ShowS)
-> (WriterState -> String)
-> ([WriterState] -> ShowS)
-> Show WriterState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriterState -> ShowS
showsPrec :: Int -> WriterState -> ShowS
$cshow :: WriterState -> String
show :: WriterState -> String
$cshowList :: [WriterState] -> ShowS
showList :: [WriterState] -> ShowS
Show, WriterState -> WriterState -> Bool
(WriterState -> WriterState -> Bool)
-> (WriterState -> WriterState -> Bool) -> Eq WriterState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriterState -> WriterState -> Bool
== :: WriterState -> WriterState -> Bool
$c/= :: WriterState -> WriterState -> Bool
/= :: WriterState -> WriterState -> Bool
Eq)
instance Default WriterState where
def :: WriterState
def = WriterState { stNoteIds :: Map Int [Block]
stNoteIds = Map Int [Block]
forall a. Monoid a => a
mempty
, stAnchorMap :: Map Text SlideId
stAnchorMap = Map Text SlideId
forall a. Monoid a => a
mempty
, 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
$cshowsPrec :: Int -> InIncrementalDiv -> ShowS
showsPrec :: Int -> InIncrementalDiv -> ShowS
$cshow :: InIncrementalDiv -> String
show :: InIncrementalDiv -> String
$cshowList :: [InIncrementalDiv] -> ShowS
showList :: [InIncrementalDiv] -> ShowS
Show)
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental :: Pres Bool
listShouldBeIncremental = do
Bool
incrementalOption <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Bool
writerIncremental (WriterOptions -> Bool)
-> (WriterEnv -> WriterOptions) -> WriterEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterEnv -> WriterOptions
envOpts)
Maybe InIncrementalDiv
inIncrementalDiv <- (WriterEnv -> Maybe InIncrementalDiv)
-> ReaderT WriterEnv (State WriterState) (Maybe InIncrementalDiv)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Maybe InIncrementalDiv
envInIncrementalDiv
Bool
inBlockQuote <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInListInBlockQuote
let toBoolean :: InIncrementalDiv -> Bool
toBoolean = (\case InIncrementalDiv
InIncremental -> Bool
True
InIncrementalDiv
InNonIncremental -> Bool
False)
maybeInvert :: Bool -> Bool
maybeInvert = if Bool
inBlockQuote then Bool -> Bool
not else Bool -> Bool
forall a. a -> a
id
Bool -> Pres Bool
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool
maybeInvert (Bool
-> (InIncrementalDiv -> Bool) -> Maybe InIncrementalDiv -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
incrementalOption InIncrementalDiv -> Bool
toBoolean Maybe InIncrementalDiv
inIncrementalDiv))
metadataSlideId :: SlideId
metadataSlideId :: SlideId
metadataSlideId = Text -> SlideId
SlideId Text
"Metadata"
tocSlideId :: SlideId
tocSlideId :: SlideId
tocSlideId = Text -> SlideId
SlideId Text
"TOC"
endNotesSlideId :: SlideId
endNotesSlideId :: SlideId
endNotesSlideId = Text -> SlideId
SlideId Text
"EndNotes"
reservedSlideIds :: S.Set SlideId
reservedSlideIds :: Set SlideId
reservedSlideIds = [SlideId] -> Set SlideId
forall a. Ord a => [a] -> Set a
S.fromList [ SlideId
metadataSlideId
, SlideId
tocSlideId
, SlideId
endNotesSlideId
]
uniqueSlideId' :: Integer -> S.Set SlideId -> T.Text -> SlideId
uniqueSlideId' :: Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' Integer
n Set SlideId
idSet Text
s =
let s' :: Text
s' = if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Text
s else Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
n
in if Text -> SlideId
SlideId Text
s' SlideId -> Set SlideId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set SlideId
idSet
then Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Set SlideId
idSet Text
s
else Text -> SlideId
SlideId Text
s'
uniqueSlideId :: S.Set SlideId -> T.Text -> SlideId
uniqueSlideId :: Set SlideId -> Text -> SlideId
uniqueSlideId = Integer -> Set SlideId -> Text -> SlideId
uniqueSlideId' Integer
0
runUniqueSlideId :: T.Text -> Pres SlideId
runUniqueSlideId :: Text -> Pres SlideId
runUniqueSlideId Text
s = do
Set SlideId
idSet <- (WriterState -> Set SlideId)
-> ReaderT WriterEnv (State WriterState) (Set SlideId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set SlideId
stSlideIdSet
let sldId :: SlideId
sldId = Set SlideId -> Text -> SlideId
uniqueSlideId Set SlideId
idSet Text
s
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSlideIdSet :: 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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return SlideId
sldId
addLogMessage :: LogMessage -> Pres ()
addLogMessage :: LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage LogMessage
msg = (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stLog :: [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 :: forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
st Pres a
p = (a
pres, [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ WriterState -> [LogMessage]
stLog WriterState
finalSt)
where (a
pres, WriterState
finalSt) = State WriterState a -> WriterState -> (a, WriterState)
forall s a. State s a -> s -> (a, s)
runState (Pres a -> WriterEnv -> State WriterState a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Pres a
p WriterEnv
env) WriterState
st
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs = ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m [b]
f [a]
xs)
type Pixels = Integer
data Presentation = Presentation DocProps [Slide]
deriving (Int -> Presentation -> ShowS
[Presentation] -> ShowS
Presentation -> String
(Int -> Presentation -> ShowS)
-> (Presentation -> String)
-> ([Presentation] -> ShowS)
-> Show Presentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presentation -> ShowS
showsPrec :: Int -> Presentation -> ShowS
$cshow :: Presentation -> String
show :: Presentation -> String
$cshowList :: [Presentation] -> ShowS
showList :: [Presentation] -> ShowS
Show)
data DocProps = DocProps { DocProps -> Maybe Text
dcTitle :: Maybe T.Text
, DocProps -> Maybe Text
dcSubject :: Maybe T.Text
, DocProps -> Maybe Text
dcCreator :: Maybe T.Text
, DocProps -> Maybe [Text]
dcKeywords :: Maybe [T.Text]
, DocProps -> Maybe Text
dcDescription :: Maybe T.Text
, DocProps -> Maybe Text
cpCategory :: Maybe T.Text
, DocProps -> Maybe Text
dcDate :: Maybe T.Text
, DocProps -> Maybe [(Text, Text)]
customProperties :: Maybe [(T.Text, T.Text)]
} deriving (Int -> DocProps -> ShowS
[DocProps] -> ShowS
DocProps -> String
(Int -> DocProps -> ShowS)
-> (DocProps -> String) -> ([DocProps] -> ShowS) -> Show DocProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocProps -> ShowS
showsPrec :: Int -> DocProps -> ShowS
$cshow :: DocProps -> String
show :: DocProps -> String
$cshowList :: [DocProps] -> ShowS
showList :: [DocProps] -> ShowS
Show, DocProps -> DocProps -> Bool
(DocProps -> DocProps -> Bool)
-> (DocProps -> DocProps -> Bool) -> Eq DocProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocProps -> DocProps -> Bool
== :: DocProps -> DocProps -> Bool
$c/= :: DocProps -> DocProps -> Bool
/= :: DocProps -> DocProps -> Bool
Eq)
data Slide = Slide { Slide -> SlideId
slideId :: SlideId
, Slide -> Layout
slideLayout :: Layout
, Slide -> SpeakerNotes
slideSpeakerNotes :: SpeakerNotes
, Slide -> Maybe String
slideBackgroundImage :: Maybe FilePath
} deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> String
(Int -> Slide -> ShowS)
-> (Slide -> String) -> ([Slide] -> ShowS) -> Show Slide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slide -> ShowS
showsPrec :: Int -> Slide -> ShowS
$cshow :: Slide -> String
show :: Slide -> String
$cshowList :: [Slide] -> ShowS
showList :: [Slide] -> ShowS
Show, Slide -> Slide -> Bool
(Slide -> Slide -> Bool) -> (Slide -> Slide -> Bool) -> Eq Slide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slide -> Slide -> Bool
== :: Slide -> Slide -> Bool
$c/= :: Slide -> Slide -> Bool
/= :: Slide -> Slide -> Bool
Eq)
newtype SlideId = SlideId T.Text
deriving (Int -> SlideId -> ShowS
[SlideId] -> ShowS
SlideId -> String
(Int -> SlideId -> ShowS)
-> (SlideId -> String) -> ([SlideId] -> ShowS) -> Show SlideId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlideId -> ShowS
showsPrec :: Int -> SlideId -> ShowS
$cshow :: SlideId -> String
show :: SlideId -> String
$cshowList :: [SlideId] -> ShowS
showList :: [SlideId] -> ShowS
Show, SlideId -> SlideId -> Bool
(SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool) -> Eq SlideId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlideId -> SlideId -> Bool
== :: SlideId -> SlideId -> Bool
$c/= :: SlideId -> SlideId -> Bool
/= :: SlideId -> SlideId -> Bool
Eq, Eq SlideId
Eq SlideId
-> (SlideId -> SlideId -> Ordering)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> Bool)
-> (SlideId -> SlideId -> SlideId)
-> (SlideId -> SlideId -> SlideId)
-> Ord SlideId
SlideId -> SlideId -> Bool
SlideId -> SlideId -> Ordering
SlideId -> SlideId -> SlideId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SlideId -> SlideId -> Ordering
compare :: SlideId -> SlideId -> Ordering
$c< :: SlideId -> SlideId -> Bool
< :: SlideId -> SlideId -> Bool
$c<= :: SlideId -> SlideId -> Bool
<= :: SlideId -> SlideId -> Bool
$c> :: SlideId -> SlideId -> Bool
> :: SlideId -> SlideId -> Bool
$c>= :: SlideId -> SlideId -> Bool
>= :: SlideId -> SlideId -> Bool
$cmax :: SlideId -> SlideId -> SlideId
max :: SlideId -> SlideId -> SlideId
$cmin :: SlideId -> SlideId -> SlideId
min :: SlideId -> SlideId -> SlideId
Ord)
newtype SpeakerNotes = SpeakerNotes {SpeakerNotes -> [Paragraph]
fromSpeakerNotes :: [Paragraph]}
deriving (Int -> SpeakerNotes -> ShowS
[SpeakerNotes] -> ShowS
SpeakerNotes -> String
(Int -> SpeakerNotes -> ShowS)
-> (SpeakerNotes -> String)
-> ([SpeakerNotes] -> ShowS)
-> Show SpeakerNotes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpeakerNotes -> ShowS
showsPrec :: Int -> SpeakerNotes -> ShowS
$cshow :: SpeakerNotes -> String
show :: SpeakerNotes -> String
$cshowList :: [SpeakerNotes] -> ShowS
showList :: [SpeakerNotes] -> ShowS
Show, SpeakerNotes -> SpeakerNotes -> Bool
(SpeakerNotes -> SpeakerNotes -> Bool)
-> (SpeakerNotes -> SpeakerNotes -> Bool) -> Eq SpeakerNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpeakerNotes -> SpeakerNotes -> Bool
== :: SpeakerNotes -> SpeakerNotes -> Bool
$c/= :: SpeakerNotes -> SpeakerNotes -> Bool
/= :: SpeakerNotes -> SpeakerNotes -> Bool
Eq, Semigroup SpeakerNotes
SpeakerNotes
Semigroup SpeakerNotes
-> SpeakerNotes
-> (SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> ([SpeakerNotes] -> SpeakerNotes)
-> Monoid SpeakerNotes
[SpeakerNotes] -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SpeakerNotes
mempty :: SpeakerNotes
$cmappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
mappend :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$cmconcat :: [SpeakerNotes] -> SpeakerNotes
mconcat :: [SpeakerNotes] -> SpeakerNotes
Monoid, NonEmpty SpeakerNotes -> SpeakerNotes
SpeakerNotes -> SpeakerNotes -> SpeakerNotes
(SpeakerNotes -> SpeakerNotes -> SpeakerNotes)
-> (NonEmpty SpeakerNotes -> SpeakerNotes)
-> (forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes)
-> Semigroup SpeakerNotes
forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
<> :: SpeakerNotes -> SpeakerNotes -> SpeakerNotes
$csconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
sconcat :: NonEmpty SpeakerNotes -> SpeakerNotes
$cstimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
stimes :: forall b. Integral b => b -> SpeakerNotes -> SpeakerNotes
Semigroup)
data Layout = MetadataSlide [ParaElem] [ParaElem] [[ParaElem]] [ParaElem]
| 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
$cshowsPrec :: Int -> Layout -> ShowS
showsPrec :: Int -> Layout -> ShowS
$cshow :: Layout -> String
show :: Layout -> String
$cshowList :: [Layout] -> ShowS
showList :: [Layout] -> ShowS
Show, Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
/= :: Layout -> Layout -> Bool
Eq)
data Shape = Pic PicProps FilePath T.Text [ParaElem]
| GraphicFrame [Graphic] [ParaElem]
| TextBox [Paragraph]
| RawOOXMLShape T.Text
deriving (Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Shape -> ShowS
showsPrec :: Int -> Shape -> ShowS
$cshow :: Shape -> String
show :: Shape -> String
$cshowList :: [Shape] -> ShowS
showList :: [Shape] -> ShowS
Show, Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
/= :: Shape -> Shape -> Bool
Eq)
type TableCell = [Paragraph]
type SimpleCell = [Block]
data TableProps = TableProps { TableProps -> Bool
tblPrFirstRow :: Bool
, TableProps -> Bool
tblPrBandRow :: Bool
} deriving (Int -> TableProps -> ShowS
[TableProps] -> ShowS
TableProps -> String
(Int -> TableProps -> ShowS)
-> (TableProps -> String)
-> ([TableProps] -> ShowS)
-> Show TableProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableProps -> ShowS
showsPrec :: Int -> TableProps -> ShowS
$cshow :: TableProps -> String
show :: TableProps -> String
$cshowList :: [TableProps] -> ShowS
showList :: [TableProps] -> ShowS
Show, TableProps -> TableProps -> Bool
(TableProps -> TableProps -> Bool)
-> (TableProps -> TableProps -> Bool) -> Eq TableProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableProps -> TableProps -> Bool
== :: TableProps -> TableProps -> Bool
$c/= :: TableProps -> TableProps -> Bool
/= :: TableProps -> TableProps -> Bool
Eq)
data Graphic = Tbl TableProps [TableCell] [[TableCell]]
deriving (Int -> Graphic -> ShowS
[Graphic] -> ShowS
Graphic -> String
(Int -> Graphic -> ShowS)
-> (Graphic -> String) -> ([Graphic] -> ShowS) -> Show Graphic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Graphic -> ShowS
showsPrec :: Int -> Graphic -> ShowS
$cshow :: Graphic -> String
show :: Graphic -> String
$cshowList :: [Graphic] -> ShowS
showList :: [Graphic] -> ShowS
Show, Graphic -> Graphic -> Bool
(Graphic -> Graphic -> Bool)
-> (Graphic -> Graphic -> Bool) -> Eq Graphic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Graphic -> Graphic -> Bool
== :: Graphic -> Graphic -> Bool
$c/= :: Graphic -> Graphic -> Bool
/= :: Graphic -> Graphic -> Bool
Eq)
data Paragraph = Paragraph { Paragraph -> ParaProps
paraProps :: ParaProps
, Paragraph -> [ParaElem]
paraElems :: [ParaElem]
} deriving (Int -> Paragraph -> ShowS
[Paragraph] -> ShowS
Paragraph -> String
(Int -> Paragraph -> ShowS)
-> (Paragraph -> String)
-> ([Paragraph] -> ShowS)
-> Show Paragraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Paragraph -> ShowS
showsPrec :: Int -> Paragraph -> ShowS
$cshow :: Paragraph -> String
show :: Paragraph -> String
$cshowList :: [Paragraph] -> ShowS
showList :: [Paragraph] -> ShowS
Show, Paragraph -> Paragraph -> Bool
(Paragraph -> Paragraph -> Bool)
-> (Paragraph -> Paragraph -> Bool) -> Eq Paragraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Paragraph -> Paragraph -> Bool
== :: Paragraph -> Paragraph -> Bool
$c/= :: Paragraph -> Paragraph -> Bool
/= :: Paragraph -> Paragraph -> Bool
Eq)
data BulletType = Bullet
| AutoNumbering ListAttributes
deriving (Int -> BulletType -> ShowS
[BulletType] -> ShowS
BulletType -> String
(Int -> BulletType -> ShowS)
-> (BulletType -> String)
-> ([BulletType] -> ShowS)
-> Show BulletType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulletType -> ShowS
showsPrec :: Int -> BulletType -> ShowS
$cshow :: BulletType -> String
show :: BulletType -> String
$cshowList :: [BulletType] -> ShowS
showList :: [BulletType] -> ShowS
Show, BulletType -> BulletType -> Bool
(BulletType -> BulletType -> Bool)
-> (BulletType -> BulletType -> Bool) -> Eq BulletType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulletType -> BulletType -> Bool
== :: BulletType -> BulletType -> Bool
$c/= :: BulletType -> BulletType -> Bool
/= :: BulletType -> BulletType -> Bool
Eq)
data Algnment = AlgnLeft | AlgnRight | AlgnCenter
deriving (Int -> Algnment -> ShowS
[Algnment] -> ShowS
Algnment -> String
(Int -> Algnment -> ShowS)
-> (Algnment -> String) -> ([Algnment] -> ShowS) -> Show Algnment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Algnment -> ShowS
showsPrec :: Int -> Algnment -> ShowS
$cshow :: Algnment -> String
show :: Algnment -> String
$cshowList :: [Algnment] -> ShowS
showList :: [Algnment] -> ShowS
Show, Algnment -> Algnment -> Bool
(Algnment -> Algnment -> Bool)
-> (Algnment -> Algnment -> Bool) -> Eq Algnment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Algnment -> Algnment -> Bool
== :: Algnment -> Algnment -> Bool
$c/= :: Algnment -> Algnment -> Bool
/= :: Algnment -> Algnment -> Bool
Eq)
data ParaProps = ParaProps { ParaProps -> Maybe Integer
pPropMarginLeft :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropMarginRight :: Maybe Pixels
, ParaProps -> Int
pPropLevel :: Int
, ParaProps -> Maybe BulletType
pPropBullet :: Maybe BulletType
, ParaProps -> Maybe Algnment
pPropAlign :: Maybe Algnment
, ParaProps -> Maybe Integer
pPropSpaceBefore :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropIndent :: Maybe Pixels
, ParaProps -> Bool
pPropIncremental :: Bool
} deriving (Int -> ParaProps -> ShowS
[ParaProps] -> ShowS
ParaProps -> String
(Int -> ParaProps -> ShowS)
-> (ParaProps -> String)
-> ([ParaProps] -> ShowS)
-> Show ParaProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParaProps -> ShowS
showsPrec :: Int -> ParaProps -> ShowS
$cshow :: ParaProps -> String
show :: ParaProps -> String
$cshowList :: [ParaProps] -> ShowS
showList :: [ParaProps] -> ShowS
Show, ParaProps -> ParaProps -> Bool
(ParaProps -> ParaProps -> Bool)
-> (ParaProps -> ParaProps -> Bool) -> Eq ParaProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParaProps -> ParaProps -> Bool
== :: ParaProps -> ParaProps -> Bool
$c/= :: ParaProps -> ParaProps -> Bool
/= :: ParaProps -> ParaProps -> Bool
Eq)
instance Default ParaProps where
def :: ParaProps
def = ParaProps { pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropMarginRight :: Maybe Integer
pPropMarginRight = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropLevel :: Int
pPropLevel = Int
0
, pPropBullet :: Maybe BulletType
pPropBullet = Maybe BulletType
forall a. Maybe a
Nothing
, pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
forall a. Maybe a
Nothing
, pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = Maybe Integer
forall a. Maybe a
Nothing
, pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropIncremental :: Bool
pPropIncremental = Bool
False
}
newtype TeXString = TeXString {TeXString -> Text
unTeXString :: T.Text}
deriving (TeXString -> TeXString -> Bool
(TeXString -> TeXString -> Bool)
-> (TeXString -> TeXString -> Bool) -> Eq TeXString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeXString -> TeXString -> Bool
== :: TeXString -> TeXString -> Bool
$c/= :: TeXString -> TeXString -> Bool
/= :: TeXString -> TeXString -> Bool
Eq, Int -> TeXString -> ShowS
[TeXString] -> ShowS
TeXString -> String
(Int -> TeXString -> ShowS)
-> (TeXString -> String)
-> ([TeXString] -> ShowS)
-> Show TeXString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeXString -> ShowS
showsPrec :: Int -> TeXString -> ShowS
$cshow :: TeXString -> String
show :: TeXString -> String
$cshowList :: [TeXString] -> ShowS
showList :: [TeXString] -> ShowS
Show)
data ParaElem = Break
| Run RunProps T.Text
| MathElem MathType TeXString
| RawOOXMLParaElem T.Text
deriving (Int -> ParaElem -> ShowS
[ParaElem] -> ShowS
ParaElem -> String
(Int -> ParaElem -> ShowS)
-> (ParaElem -> String) -> ([ParaElem] -> ShowS) -> Show ParaElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParaElem -> ShowS
showsPrec :: Int -> ParaElem -> ShowS
$cshow :: ParaElem -> String
show :: ParaElem -> String
$cshowList :: [ParaElem] -> ShowS
showList :: [ParaElem] -> ShowS
Show, ParaElem -> ParaElem -> Bool
(ParaElem -> ParaElem -> Bool)
-> (ParaElem -> ParaElem -> Bool) -> Eq ParaElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParaElem -> ParaElem -> Bool
== :: ParaElem -> ParaElem -> Bool
$c/= :: ParaElem -> ParaElem -> Bool
/= :: ParaElem -> ParaElem -> Bool
Eq)
data Strikethrough = NoStrike | SingleStrike | DoubleStrike
deriving (Int -> Strikethrough -> ShowS
[Strikethrough] -> ShowS
Strikethrough -> String
(Int -> Strikethrough -> ShowS)
-> (Strikethrough -> String)
-> ([Strikethrough] -> ShowS)
-> Show Strikethrough
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Strikethrough -> ShowS
showsPrec :: Int -> Strikethrough -> ShowS
$cshow :: Strikethrough -> String
show :: Strikethrough -> String
$cshowList :: [Strikethrough] -> ShowS
showList :: [Strikethrough] -> ShowS
Show, Strikethrough -> Strikethrough -> Bool
(Strikethrough -> Strikethrough -> Bool)
-> (Strikethrough -> Strikethrough -> Bool) -> Eq Strikethrough
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strikethrough -> Strikethrough -> Bool
== :: Strikethrough -> Strikethrough -> Bool
$c/= :: Strikethrough -> Strikethrough -> Bool
/= :: Strikethrough -> Strikethrough -> Bool
Eq)
data Capitals = NoCapitals | SmallCapitals | AllCapitals
deriving (Int -> Capitals -> ShowS
[Capitals] -> ShowS
Capitals -> String
(Int -> Capitals -> ShowS)
-> (Capitals -> String) -> ([Capitals] -> ShowS) -> Show Capitals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Capitals -> ShowS
showsPrec :: Int -> Capitals -> ShowS
$cshow :: Capitals -> String
show :: Capitals -> String
$cshowList :: [Capitals] -> ShowS
showList :: [Capitals] -> ShowS
Show, Capitals -> Capitals -> Bool
(Capitals -> Capitals -> Bool)
-> (Capitals -> Capitals -> Bool) -> Eq Capitals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Capitals -> Capitals -> Bool
== :: Capitals -> Capitals -> Bool
$c/= :: Capitals -> Capitals -> Bool
/= :: Capitals -> Capitals -> Bool
Eq)
type URL = T.Text
data LinkTarget = ExternalTarget (URL, T.Text)
| InternalTarget SlideId
deriving (Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkTarget -> ShowS
showsPrec :: Int -> LinkTarget -> ShowS
$cshow :: LinkTarget -> String
show :: LinkTarget -> String
$cshowList :: [LinkTarget] -> ShowS
showList :: [LinkTarget] -> ShowS
Show, LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
/= :: LinkTarget -> LinkTarget -> Bool
Eq)
data RunProps = RunProps { RunProps -> Bool
rPropBold :: Bool
, RunProps -> Bool
rPropItalics :: Bool
, RunProps -> Maybe Strikethrough
rStrikethrough :: Maybe Strikethrough
, RunProps -> Maybe Int
rBaseline :: Maybe Int
, RunProps -> Maybe Capitals
rCap :: Maybe Capitals
, RunProps -> Maybe LinkTarget
rLink :: Maybe LinkTarget
, RunProps -> Bool
rPropCode :: Bool
, RunProps -> Bool
rPropBlockQuote :: Bool
, RunProps -> Maybe Integer
rPropForceSize :: Maybe Pixels
, RunProps -> Maybe Color
rSolidFill :: Maybe Color
, RunProps -> Bool
rPropUnderline :: Bool
} deriving (Int -> RunProps -> ShowS
[RunProps] -> ShowS
RunProps -> String
(Int -> RunProps -> ShowS)
-> (RunProps -> String) -> ([RunProps] -> ShowS) -> Show RunProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunProps -> ShowS
showsPrec :: Int -> RunProps -> ShowS
$cshow :: RunProps -> String
show :: RunProps -> String
$cshowList :: [RunProps] -> ShowS
showList :: [RunProps] -> ShowS
Show, RunProps -> RunProps -> Bool
(RunProps -> RunProps -> Bool)
-> (RunProps -> RunProps -> Bool) -> Eq RunProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunProps -> RunProps -> Bool
== :: RunProps -> RunProps -> Bool
$c/= :: RunProps -> RunProps -> Bool
/= :: RunProps -> RunProps -> Bool
Eq)
instance Default RunProps where
def :: RunProps
def = RunProps { rPropBold :: Bool
rPropBold = Bool
False
, rPropItalics :: Bool
rPropItalics = Bool
False
, rStrikethrough :: Maybe Strikethrough
rStrikethrough = Maybe Strikethrough
forall a. Maybe a
Nothing
, rBaseline :: Maybe Int
rBaseline = Maybe Int
forall a. Maybe a
Nothing
, rCap :: Maybe Capitals
rCap = Maybe Capitals
forall a. Maybe a
Nothing
, rLink :: Maybe LinkTarget
rLink = Maybe LinkTarget
forall a. Maybe a
Nothing
, rPropCode :: Bool
rPropCode = Bool
False
, rPropBlockQuote :: Bool
rPropBlockQuote = Bool
False
, rPropForceSize :: Maybe Integer
rPropForceSize = Maybe Integer
forall a. Maybe a
Nothing
, rSolidFill :: Maybe Color
rSolidFill = Maybe Color
forall a. Maybe a
Nothing
, rPropUnderline :: Bool
rPropUnderline = Bool
False
}
data PicProps = PicProps { PicProps -> Maybe LinkTarget
picPropLink :: Maybe LinkTarget
, PicProps -> Maybe Dimension
picWidth :: Maybe Dimension
, PicProps -> Maybe Dimension
picHeight :: Maybe Dimension
} deriving (Int -> PicProps -> ShowS
[PicProps] -> ShowS
PicProps -> String
(Int -> PicProps -> ShowS)
-> (PicProps -> String) -> ([PicProps] -> ShowS) -> Show PicProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PicProps -> ShowS
showsPrec :: Int -> PicProps -> ShowS
$cshow :: PicProps -> String
show :: PicProps -> String
$cshowList :: [PicProps] -> ShowS
showList :: [PicProps] -> ShowS
Show, PicProps -> PicProps -> Bool
(PicProps -> PicProps -> Bool)
-> (PicProps -> PicProps -> Bool) -> Eq PicProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PicProps -> PicProps -> Bool
== :: PicProps -> PicProps -> Bool
$c/= :: PicProps -> PicProps -> Bool
/= :: PicProps -> PicProps -> Bool
Eq)
instance Default PicProps where
def :: PicProps
def = PicProps { picPropLink :: Maybe LinkTarget
picPropLink = Maybe LinkTarget
forall a. Maybe a
Nothing
, picWidth :: Maybe Dimension
picWidth = Maybe Dimension
forall a. Maybe a
Nothing
, picHeight :: Maybe Dimension
picHeight = Maybe Dimension
forall a. Maybe a
Nothing
}
inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems :: [Inline] -> Pres [ParaElem]
inlinesToParElems = (Inline -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Inline -> Pres [ParaElem]
inlineToParElems
inlineToParElems :: Inline -> Pres [ParaElem]
inlineToParElems :: Inline -> Pres [ParaElem]
inlineToParElems (Str Text
s) = do
RunProps
pr <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
[ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [RunProps -> Text -> ParaElem
Run RunProps
pr Text
s]
inlineToParElems (Emph [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: 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 [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: 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 [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: 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 [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: 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 [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
30000}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Subscript [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: RunProps
envRunProps = (WriterEnv -> RunProps
envRunProps WriterEnv
r){rBaseline :: Maybe Int
rBaseline=Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
25000)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (SmallCaps [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps :: 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 Inline
Space = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
SoftBreak = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
LineBreak = [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaElem
Break]
inlineToParElems (Link Attr
_ [Inline]
ils (Text
url, Text
title)) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps :: 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 Attr
_ Text
str) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps :: 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 Text
str) =
[ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [MathType -> TeXString -> ParaElem
MathElem MathType
mathtype (Text -> TeXString
TeXString Text
str)]
inlineToParElems (Note [Block]
blks) = do
Bool
inSpNotes <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInSpeakerNotes
if Bool
inSpNotes
then [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Map Int [Block]
notes <- (WriterState -> Map Int [Block])
-> ReaderT WriterEnv (State WriterState) (Map Int [Block])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Int [Block]
stNoteIds
let maxNoteId :: Int
maxNoteId = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ Map Int [Block] -> [Int]
forall k a. Map k a -> [k]
M.keys Map Int [Block]
notes
curNoteId :: Int
curNoteId = Int
maxNoteId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNoteIds :: 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 a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envRunProps :: 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 Attr
_ [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Quoted QuoteType
quoteType [Inline]
ils) =
[Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ [Text -> Inline
Str Text
open] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ils [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
close]
where (Text
open, Text
close) = case QuoteType
quoteType of
QuoteType
SingleQuote -> (Text
"\x2018", Text
"\x2019")
QuoteType
DoubleQuote -> (Text
"\x201C", Text
"\x201D")
inlineToParElems il :: Inline
il@(RawInline Format
fmt Text
s) =
case Format
fmt of
Format Text
"openxml" -> [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> ParaElem
RawOOXMLParaElem Text
s]
Format
_ -> do LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
[ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
inlineToParElems (Cite [Citation]
_ [Inline]
ils) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Image Attr
_ [Inline]
alt (Text, Text)
_) = [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
alt
isListType :: Block -> Bool
isListType :: Block -> Bool
isListType (OrderedList ListAttributes
_ [[Block]]
_) = Bool
True
isListType (BulletList [[Block]]
_) = Bool
True
isListType (DefinitionList [([Inline], [[Block]])]
_) = Bool
True
isListType Block
_ = Bool
False
registerAnchorId :: T.Text -> Pres ()
registerAnchorId :: Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
anchor = do
Map Text SlideId
anchorMap <- (WriterState -> Map Text SlideId)
-> ReaderT WriterEnv (State WriterState) (Map Text SlideId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text SlideId
stAnchorMap
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
Bool
-> ReaderT WriterEnv (State WriterState) ()
-> ReaderT WriterEnv (State WriterState) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
anchor) (ReaderT WriterEnv (State WriterState) ()
-> ReaderT WriterEnv (State WriterState) ())
-> ReaderT WriterEnv (State WriterState) ()
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st {stAnchorMap :: 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 = Integer
20
noteSize :: Pixels
noteSize :: Integer
noteSize = Integer
18
blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs :: Block -> Pres [Paragraph]
blockToParagraphs (Plain [Inline]
ils) = Block -> Pres [Paragraph]
blockToParagraphs ([Inline] -> Block
Para [Inline]
ils)
blockToParagraphs (Para [Inline]
ils) = do
[ParaElem]
parElems <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
blockToParagraphs (LineBlock [[Inline]]
ilsList) = do
[ParaElem]
parElems <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
ilsList
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pProps [ParaElem]
parElems]
blockToParagraphs (CodeBlock Attr
attr Text
str) = do
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps :: 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 Integer
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 Style
sty ->
case SyntaxMap
-> (FormatOptions -> [SourceLine] -> [ParaElem])
-> Attr
-> Text
-> Either Text [ParaElem]
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
synMap (Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines Style
sty) Attr
attr Text
str of
Right [ParaElem]
pElems -> do ParaProps
pPropsNew <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
pPropsNew [ParaElem]
pElems]
Left Text
_ -> Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Text -> Inline
Str Text
str]
Maybe Style
Nothing -> Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Text -> Inline
Str Text
str]
blockToParagraphs (BlockQuote (Block
blk : [Block]
blks)) | Block -> Bool
isListType Block
blk = do
[Paragraph]
ps <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInListInBlockQuote :: 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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
ps [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ [Paragraph]
ps'
blockToParagraphs (BlockQuote [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps :: ParaProps
envParaProps = (WriterEnv -> ParaProps
envParaProps WriterEnv
r){ pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100
, pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
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 Format
_ Text
_) = do LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
blockToParagraphs (Header Int
_ (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
ils) = do
Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
[ParaElem]
parElems <- (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
e->WriterEnv
e{envRunProps :: 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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaProps -> [ParaElem] -> Paragraph
Paragraph ParaProps
forall a. Default a => a
def{pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
30} [ParaElem]
parElems]
blockToParagraphs (BulletList [[Block]]
blksLst) = do
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
Bool
incremental <- Pres Bool
listShouldBeIncremental
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList :: 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 ListAttributes
listAttr [[Block]]
blksLst) = do
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
Bool
incremental <- Pres Bool
listShouldBeIncremental
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{ envInList :: 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 [([Inline], [[Block]])]
entries) = do
Bool
incremental <- Pres Bool
listShouldBeIncremental
let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go ([Inline]
ils, [[Block]]
blksLst) = do
[Paragraph]
term <-Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph]) -> Block -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [[Inline] -> Inline
Strong [Inline]
ils]
[Paragraph]
definition <- ([Block] -> Pres [Paragraph]) -> [[Block]] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Block -> Pres [Paragraph]
blockToParagraphs (Block -> Pres [Paragraph])
-> ([Block] -> Block) -> [Block] -> Pres [Paragraph]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Block
BlockQuote) [[Block]]
blksLst
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
term [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ [Paragraph]
definition
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env {envParaProps :: 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 (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
blks) = let
hasIncremental :: Bool
hasIncremental = Text
"incremental" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
hasNonIncremental :: Bool
hasNonIncremental = Text
"nonincremental" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
incremental :: Maybe InIncrementalDiv
incremental = if | Bool
hasIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InIncremental
| Bool
hasNonIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InNonIncremental
| Bool
otherwise -> Maybe InIncrementalDiv
forall a. Maybe a
Nothing
addIncremental :: WriterEnv -> WriterEnv
addIncremental WriterEnv
env = WriterEnv
env { envInIncrementalDiv :: Maybe InIncrementalDiv
envInIncrementalDiv = Maybe InIncrementalDiv
incremental }
in (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WriterEnv -> WriterEnv
addIncremental ((Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks)
blockToParagraphs (Figure Attr
attr Caption
capt [Block]
blks) =
Block -> Pres [Paragraph]
blockToParagraphs (Attr -> Caption -> [Block] -> Block
Shared.figureDiv Attr
attr Caption
capt [Block]
blks)
blockToParagraphs hr :: Block
hr@Block
HorizontalRule = Block -> Pres [Paragraph]
notRendered Block
hr
blockToParagraphs tbl :: Block
tbl@Table{} = Block -> Pres [Paragraph]
notRendered Block
tbl
notRendered :: Block -> Pres [Paragraph]
notRendered :: Block -> Pres [Paragraph]
notRendered Block
blk = do
LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> LogMessage -> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
blk
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
multiParList :: [Block] -> Pres [Paragraph]
multiParList :: [Block] -> Pres [Paragraph]
multiParList [] = [Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
multiParList (Block
b:[Block]
bs) = do
ParaProps
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
[Paragraph]
p <- Block -> Pres [Paragraph]
blockToParagraphs Block
b
let level :: Int
level = ParaProps -> Int
pPropLevel ParaProps
pProps
[Paragraph]
ps <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env
{ envParaProps :: 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
+ Int
1
}
})
(Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ (Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
bs
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [Paragraph]
p [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ [Paragraph]
ps
cellToParagraphs :: Alignment -> SimpleCell -> Pres [Paragraph]
cellToParagraphs :: Alignment -> [Block] -> Pres [Paragraph]
cellToParagraphs Alignment
algn [Block]
tblCell = do
[[Paragraph]]
paras <- (Block -> Pres [Paragraph])
-> [Block] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
tblCell
let alignment :: Maybe Algnment
alignment = case Alignment
algn of
Alignment
AlignLeft -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnLeft
Alignment
AlignRight -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnRight
Alignment
AlignCenter -> Algnment -> Maybe Algnment
forall a. a -> Maybe a
Just Algnment
AlgnCenter
Alignment
AlignDefault -> Maybe Algnment
forall a. Maybe a
Nothing
paras' :: [[Paragraph]]
paras' = ([Paragraph] -> [Paragraph]) -> [[Paragraph]] -> [[Paragraph]]
forall a b. (a -> b) -> [a] -> [b]
map ((Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
p -> Paragraph
p{paraProps :: ParaProps
paraProps = (Paragraph -> ParaProps
paraProps Paragraph
p){pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
alignment}})) [[Paragraph]]
paras
[Paragraph] -> Pres [Paragraph]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Paragraph] -> Pres [Paragraph])
-> [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$ [[Paragraph]] -> [Paragraph]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Paragraph]]
paras'
rowToParagraphs :: [Alignment] -> [SimpleCell] -> Pres [[Paragraph]]
rowToParagraphs :: [Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algns [[Block]]
tblCells = do
let pairs :: [(Alignment, [Block])]
pairs = [Alignment] -> [[Block]] -> [(Alignment, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Alignment]
algns [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [[Block]]
tblCells
((Alignment, [Block]) -> Pres [Paragraph])
-> [(Alignment, [Block])]
-> ReaderT WriterEnv (State WriterState) [[Paragraph]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Alignment -> [Block] -> Pres [Paragraph])
-> (Alignment, [Block]) -> Pres [Paragraph]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Alignment -> [Block] -> Pres [Paragraph]
cellToParagraphs) [(Alignment, [Block])]
pairs
withAttr :: Attr -> Shape -> Shape
withAttr :: Attr -> Shape -> Shape
withAttr Attr
attr (Pic PicProps
picPr String
url Text
title [ParaElem]
caption) =
let picPr' :: PicProps
picPr' = PicProps
picPr { picWidth :: Maybe Dimension
picWidth = Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr
, picHeight :: Maybe Dimension
picHeight = Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr
}
in
PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
picPr' String
url Text
title [ParaElem]
caption
withAttr Attr
_ Shape
sp = Shape
sp
blockToShape :: Block -> Pres Shape
blockToShape :: Block -> Pres Shape
blockToShape (Plain [Inline]
ils) = Block -> Pres Shape
blockToShape ([Inline] -> Block
Para [Inline]
ils)
blockToShape (Para (Inline
il:[Inline]
_)) | Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il =
Attr -> Shape -> Shape
withAttr Attr
attr (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def (Text -> String
T.unpack Text
url) Text
title ([ParaElem] -> Shape) -> Pres [ParaElem] -> Pres Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
blockToShape (Para (Inline
il:[Inline]
_)) | Link Attr
_ (Inline
il':[Inline]
_) (Text, Text)
target <- Inline
il
, Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il' =
Attr -> Shape -> Shape
withAttr Attr
attr (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def{picPropLink :: 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 (Figure Attr
_figattr Caption
_caption [Block
b]) = Block -> Pres Shape
blockToShape Block
b
blockToShape (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
algn, [Double]
_, [[Block]]
hdrCells, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
[ParaElem]
caption' <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
caption
[[Paragraph]]
hdrCells' <- [Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algn [[Block]]
hdrCells
[[[Paragraph]]]
rows' <- ([[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]])
-> [[[Block]]]
-> ReaderT WriterEnv (State WriterState) [[[Paragraph]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Alignment]
-> [[Block]] -> ReaderT WriterEnv (State WriterState) [[Paragraph]]
rowToParagraphs [Alignment]
algn) [[[Block]]]
rows
let tblPr :: TableProps
tblPr = if [[Block]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
hdrCells
then TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
False
, tblPrBandRow :: Bool
tblPrBandRow = Bool
True
}
else TableProps { tblPrFirstRow :: Bool
tblPrFirstRow = Bool
True
, tblPrBandRow :: Bool
tblPrBandRow = Bool
True
}
Shape -> Pres Shape
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
forall a b. (a -> b) -> a -> b
$ [Graphic] -> [ParaElem] -> Shape
GraphicFrame [TableProps -> [[Paragraph]] -> [[[Paragraph]]] -> Graphic
Tbl TableProps
tblPr [[Paragraph]]
hdrCells' [[[Paragraph]]]
rows'] [ParaElem]
caption'
blockToShape (RawBlock (Format Text
"openxml") Text
str) = Shape -> Pres Shape
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
forall a b. (a -> b) -> a -> b
$ Text -> Shape
RawOOXMLShape Text
str
blockToShape Block
blk = do [Paragraph]
paras <- Block -> Pres [Paragraph]
blockToParagraphs Block
blk
let paras' :: [Paragraph]
paras' = (Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
par -> Paragraph
par{paraElems :: [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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> Pres Shape) -> Shape -> Pres Shape
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox [Paragraph]
paras'
combineShapes :: [Shape] -> [Shape]
combineShapes :: [Shape] -> [Shape]
combineShapes [] = []
combineShapes (pic :: Shape
pic@Pic{} : [Shape]
ss) = Shape
pic Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (Shape
s : TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes (Shape
s Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss)
combineShapes (TextBox (Paragraph
p:[Paragraph]
ps) : TextBox (Paragraph
p':[Paragraph]
ps') : [Shape]
ss) =
[Shape] -> [Shape]
combineShapes ([Shape] -> [Shape]) -> [Shape] -> [Shape]
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox ((Paragraph
pParagraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps) [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ (Paragraph
p'Paragraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps')) Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss
combineShapes (Shape
s:[Shape]
ss) = Shape
s Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
isNotesDiv :: Block -> Bool
isNotesDiv :: Block -> Bool
isNotesDiv (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
_) = Bool
True
isNotesDiv Block
_ = Bool
False
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes [Block]
blks = [Shape] -> [Shape]
combineShapes ([Shape] -> [Shape]) -> Pres [Shape] -> Pres [Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres Shape) -> [Block] -> Pres [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres Shape
blockToShape [Block]
blks
isImage :: Inline -> Bool
isImage :: Inline -> Bool
isImage Image{} = Bool
True
isImage (Link Attr
_ (Image{} : [Inline]
_) (Text, Text)
_) = Bool
True
isImage Inline
_ = Bool
False
plainOrPara :: Block -> Maybe [Inline]
plainOrPara :: Block -> Maybe [Inline]
plainOrPara (Plain [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara (Para [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara Block
_ = Maybe [Inline]
forall a. Maybe a
Nothing
notText :: Block -> Bool
notText :: Block -> Bool
notText Block
block | Block -> Bool
startsWithImage Block
block = Bool
True
notText Table{} = Bool
True
notText Block
_ = Bool
False
startsWithImage :: Block -> Bool
startsWithImage :: Block -> Bool
startsWithImage Block
block = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
Inline
inline <- Block -> Maybe [Inline]
plainOrPara Block
block Maybe [Inline] -> ([Inline] -> Maybe Inline) -> Maybe Inline
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Inline] -> Maybe Inline
forall a. [a] -> Maybe a
listToMaybe
Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> Bool
isImage Inline
inline)
splitBlocks' ::
[Block] ->
[[Block]] ->
[Block] ->
Pres [[Block]]
splitBlocks' :: [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [Block]
cur [[Block]]
acc [] = [[Block]] -> Pres [[Block]]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Block]] -> Pres [[Block]]) -> [[Block]] -> Pres [[Block]]
forall a b. (a -> b) -> a -> b
$ [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])
splitBlocks' [Block]
cur [[Block]]
acc (Block
HorizontalRule : [Block]
blks) =
[Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks
splitBlocks' [Block]
cur [[Block]]
acc (h :: Block
h@(Header Int
n Attr
_ [Inline]
_) : [Block]
blks) = do
Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
slideLevel of
Ordering
LT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
h Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]) [Block]
blks'
Ordering
EQ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
nts) ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)])) [Block]
blks'
Ordering
GT -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' ([Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
nts)) [[Block]]
acc [Block]
blks'
splitBlocks' [Block]
cur [[Block]]
acc (Plain [Inline]
ils : [Block]
blks) = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [Block]
cur [[Block]]
acc ([Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
splitBlocks' [Block]
cur [[Block]]
acc (Para (Inline
il:[Inline]
ils) : [Block]
blks) | Inline -> Bool
isImage Inline
il = do
Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let ([Block]
nts, [Block]
blks') = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
then (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
else ([], [Block]
blks)
case [Block]
cur of
[Header Int
n Attr
_ [Inline]
_] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
[Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts])
(if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks')
[Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
(if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
then [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]
else [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Para [Inline
il]] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts])
(if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils then [Block]
blks' else [Inline] -> Block
Para [Inline]
ils Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks')
splitBlocks' [Block]
cur [[Block]]
acc (tbl :: Block
tbl@Table{} : [Block]
blks) = do
Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
case [Block]
cur of
[Header Int
n Attr
_ [Inline]
_] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
[Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
tbl] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
[Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' []
(if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
notText [Block]
cur
then [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
tbl Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]
else [[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
tbl] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts]))
[Block]
blks'
splitBlocks' [Block]
cur [[Block]]
acc (d :: Block
d@(Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
_): [Block]
blks) | Text
"columns" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = do
Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let ([Block]
nts, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
case [Block]
cur of
[Header Int
n Attr
_ [Inline]
_] | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel Bool -> Bool -> Bool
|| Int
slideLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
[Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [[Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
d] [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
nts]) [Block]
blks'
[Block]
_ -> [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] ([[Block]]
acc [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ ([[Block]
cur | Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
cur)]) [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block
d Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
nts]) [Block]
blks'
splitBlocks' [Block]
cur [[Block]]
acc (Block
blk : [Block]
blks) = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' ([Block]
cur [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
blk]) [[Block]]
acc [Block]
blks
splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks = [Block] -> [[Block]] -> [Block] -> Pres [[Block]]
splitBlocks' [] []
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide :: Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
_ (Block
blk : [Block]
blks) SpeakerNotes
spkNotes
| Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
divBlks <- Block
blk
, Text
"columns" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
, Div (Text
_, [Text]
clsL, [(Text, Text)]
_) [Block]
blksL : Div (Text
_, [Text]
clsR, [(Text, Text)]
_) [Block]
blksR : [Block]
remaining <- [Block]
divBlks
, Text
"column" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsL, Text
"column" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
clsR = do
(Block -> ReaderT WriterEnv (State WriterState) ())
-> [Block] -> ReaderT WriterEnv (State WriterState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage (LogMessage -> ReaderT WriterEnv (State WriterState) ())
-> (Block -> LogMessage)
-> Block
-> ReaderT WriterEnv (State WriterState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> LogMessage
BlockNotRendered) ([Block]
blks [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
remaining)
let mkTwoColumn :: [Block] -> [Block] -> Pres Slide
mkTwoColumn [Block]
left [Block]
right = do
[Block]
blksL' <- [[Block]] -> [Block]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Block]] -> [Block])
-> ([[Block]] -> [[Block]]) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Block]] -> [Block])
-> Pres [[Block]] -> ReaderT WriterEnv (State WriterState) [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [[Block]]
splitBlocks [Block]
left
[Block]
blksR' <- [[Block]] -> [Block]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Block]] -> [Block])
-> ([[Block]] -> [[Block]]) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Block]] -> [Block])
-> Pres [[Block]] -> ReaderT WriterEnv (State WriterState) [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [[Block]]
splitBlocks [Block]
right
[Shape]
shapesL <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL'
[Shape]
shapesR <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR'
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
SlideId
sldId
([ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [] [Shape]
shapesL [Shape]
shapesR)
SpeakerNotes
spkNotes
Maybe String
forall a. Maybe a
Nothing
let mkComparison :: [Block] -> [Block] -> [Block] -> [Block] -> Pres Slide
mkComparison [Block]
blksL1 [Block]
blksL2 [Block]
blksR1 [Block]
blksR2 = do
[Shape]
shapesL1 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL1
[Shape]
shapesL2 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL2
[Shape]
shapesR1 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR1
[Shape]
shapesR2 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksR2
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
SlideId
sldId
([ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [] ([Shape]
shapesL1, [Shape]
shapesL2) ([Shape]
shapesR1, [Shape]
shapesR2))
SpeakerNotes
spkNotes
Maybe String
forall a. Maybe a
Nothing
let ([Block]
blksL1, [Block]
blksL2) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksL
([Block]
blksR1, [Block]
blksR2) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText [Block]
blksR
if (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]
blksL1, [Block]
blksL2]) Bool -> Bool -> Bool
&& (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]
blksR1, [Block]
blksR2])
then [Block] -> [Block] -> Pres Slide
mkTwoColumn [Block]
blksL [Block]
blksR
else [Block] -> [Block] -> [Block] -> [Block] -> Pres Slide
mkComparison [Block]
blksL1 [Block]
blksL2 [Block]
blksR1 [Block]
blksR2
bodyBlocksToSlide Int
_ (Block
blk : [Block]
blks) SpeakerNotes
spkNotes = do
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
Bool
inNoteSlide <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInNoteSlide
let mkSlide :: Layout -> Slide
mkSlide Layout
s =
SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
s SpeakerNotes
spkNotes Maybe String
forall a. Maybe a
Nothing
if Bool
inNoteSlide
then Layout -> Slide
mkSlide (Layout -> Slide) -> ([Shape] -> Layout) -> [Shape] -> Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] ([Shape] -> Slide) -> Pres [Shape] -> Pres Slide
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Integer -> Pres [Shape] -> Pres [Shape]
forall a. Integer -> Pres a -> Pres a
forceFontSize Integer
noteSize ([Block] -> Pres [Shape]
blocksToShapes (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks))
else let
contentOrBlankSlide :: Pres Slide
contentOrBlankSlide =
if [Block] -> Bool
makesBlankSlide (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
then Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Layout -> Slide
mkSlide Layout
BlankSlide)
else Layout -> Slide
mkSlide (Layout -> Slide) -> ([Shape] -> Layout) -> [Shape] -> Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParaElem] -> [Shape] -> Layout
ContentSlide [] ([Shape] -> Slide) -> Pres [Shape] -> Pres Slide
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> Pres [Shape]
blocksToShapes (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks)
in case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
notText (Block
blk Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks) of
([], [Block]
_) -> Pres Slide
contentOrBlankSlide
([Block]
_, []) -> Pres Slide
contentOrBlankSlide
([Block]
textBlocks, [Block]
contentBlocks) -> do
[Shape]
textShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
textBlocks
[Shape]
contentShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
contentBlocks
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> Slide
mkSlide ([ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [] [Shape]
textShapes [Shape]
contentShapes))
bodyBlocksToSlide Int
_ [] SpeakerNotes
spkNotes = do
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$
SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
SlideId
sldId
Layout
BlankSlide
SpeakerNotes
spkNotes
Maybe String
forall a. Maybe a
Nothing
blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' :: Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' Int
lvl (Header Int
n (Text
ident, [Text]
_, [(Text, Text)]
attributes) [Inline]
ils : [Block]
blks) SpeakerNotes
spkNotes
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lvl = do
Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
SlideId
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
[ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId ([ParaElem] -> Layout
TitleSlide [ParaElem]
hdr) SpeakerNotes
spkNotes Maybe String
backgroundImage
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lvl Bool -> Bool -> Bool
|| Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = do
Text -> ReaderT WriterEnv (State WriterState) ()
registerAnchorId Text
ident
[ParaElem]
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
Slide
slide <- Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes
let layout :: Layout
layout = case Slide -> Layout
slideLayout Slide
slide of
ContentSlide [ParaElem]
_ [Shape]
cont -> [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr [Shape]
cont
TwoColumnSlide [ParaElem]
_ [Shape]
contL [Shape]
contR -> [ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [ParaElem]
hdr [Shape]
contL [Shape]
contR
ComparisonSlide [ParaElem]
_ ([Shape], [Shape])
contL ([Shape], [Shape])
contR -> [ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [ParaElem]
hdr ([Shape], [Shape])
contL ([Shape], [Shape])
contR
ContentWithCaptionSlide [ParaElem]
_ [Shape]
text [Shape]
content -> [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr [Shape]
text [Shape]
content
Layout
BlankSlide -> if (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ils then Layout
BlankSlide else [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr []
Layout
layout' -> Layout
layout'
Slide -> Pres Slide
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide -> Pres Slide) -> Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ Slide
slide{slideLayout :: Layout
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 Text
"background-image" [(Text, Text)]
attributes
Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-background-image" [(Text, Text)]
attributes)
blocksToSlide' Int
lvl [Block]
blks SpeakerNotes
spkNotes = Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres SpeakerNotes -> Pres SpeakerNotes
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envInSpeakerNotes :: 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 Block
_ = SpeakerNotes -> Pres SpeakerNotes
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return SpeakerNotes
forall a. Monoid a => a
mempty
handleSpeakerNotes :: Block -> Pres ()
handleSpeakerNotes :: Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes Block
blk = do
SpeakerNotes
spNotes <- Block -> Pres SpeakerNotes
blockToSpeakerNotes Block
blk
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes :: 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' [Block]
blks = do
(Block -> ReaderT WriterEnv (State WriterState) ())
-> [Block] -> ReaderT WriterEnv (State WriterState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes [Block]
blks
[Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b. (a -> b) -> a -> b
$ (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isNotesDiv) [Block]
blks
handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks = do
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes :: 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
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
([Block] -> m [Block]) -> [Block] -> m [Block]
walkM [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks
SpeakerNotes
spkNotes <- (WriterState -> SpeakerNotes) -> Pres SpeakerNotes
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> SpeakerNotes
stSpeakerNotes
([Block], SpeakerNotes) -> Pres ([Block], SpeakerNotes)
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block]
blks', SpeakerNotes
spkNotes)
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide [Block]
blks = do
([Block]
blks', SpeakerNotes
spkNotes) <- [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks
Int
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
Int -> [Block] -> SpeakerNotes -> Pres Slide
blocksToSlide' Int
slideLevel [Block]
blks' SpeakerNotes
spkNotes
makeNoteEntry :: (Int, [Block]) -> [Block]
makeNoteEntry :: (Int, [Block]) -> [Block]
makeNoteEntry (Int
n, [Block]
blks) =
let enum :: Inline
enum = Text -> Inline
Str (Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".")
in
case [Block]
blks of
(Para [Inline]
ils : [Block]
blks') -> [Inline] -> Block
Para (Inline
enum Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks'
[Block]
_ -> [Inline] -> Block
Para [Inline
enum] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks
forceFontSize :: Pixels -> Pres a -> Pres a
forceFontSize :: forall a. Integer -> Pres a -> Pres a
forceFontSize Integer
px Pres a
x = do
RunProps
rpr <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
(WriterEnv -> WriterEnv) -> Pres a -> Pres a
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r {envRunProps :: 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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else let title :: [Inline]
title = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"notes-title" Meta
meta of
[] -> [Text -> Inline
Str Text
"Notes"]
[Inline]
ls -> [Inline]
ls
ident :: Text
ident = Extensions -> [Inline] -> Set Text -> Text
Shared.uniqueIdent Extensions
exts [Inline]
title Set Text
anchorSet
hdr :: Block
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel (Text
ident, [], []) [Inline]
title
blks :: [Block]
blks = ((Int, [Block]) -> [Block]) -> [(Int, [Block])] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [Block]) -> [Block]
makeNoteEntry ([(Int, [Block])] -> [Block]) -> [(Int, [Block])] -> [Block]
forall a b. (a -> b) -> a -> b
$
Map Int [Block] -> [(Int, [Block])]
forall k a. Map k a -> [(k, a)]
M.toList Map Int [Block]
noteIds
in [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b. (a -> b) -> a -> b
$ Block
hdr Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blks
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide = do
Meta
meta <- (WriterEnv -> Meta) -> ReaderT WriterEnv (State WriterState) Meta
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
[ParaElem]
title <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
[ParaElem]
subtitle <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Inline]
lookupMetaInlines Text
"subtitle" Meta
meta
[[ParaElem]]
authors <- ([Inline] -> Pres [ParaElem])
-> [[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> Pres [ParaElem]
inlinesToParElems ([[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]])
-> [[Inline]] -> ReaderT WriterEnv (State WriterState) [[ParaElem]]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
[ParaElem]
date <- [Inline] -> Pres [ParaElem]
inlinesToParElems ([Inline] -> Pres [ParaElem]) -> [Inline] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docDate Meta
meta
if [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
title Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
subtitle Bool -> Bool -> Bool
&& [[ParaElem]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ParaElem]]
authors Bool -> Bool -> Bool
&& [ParaElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParaElem]
date
then Maybe Slide -> Pres (Maybe Slide)
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Slide
forall a. Maybe a
Nothing
else Maybe Slide -> Pres (Maybe Slide)
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Slide -> Pres (Maybe Slide))
-> Maybe Slide -> Pres (Maybe Slide)
forall a b. (a -> b) -> a -> b
$
Slide -> Maybe Slide
forall a. a -> Maybe a
Just (Slide -> Maybe Slide) -> Slide -> Maybe Slide
forall a b. (a -> b) -> a -> b
$
SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide
SlideId
metadataSlideId
([ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> Layout
MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date)
SpeakerNotes
forall a. Monoid a => a
mempty
Maybe String
forall a. Maybe a
Nothing
addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide :: Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide (Slide SlideId
sldId layout :: Layout
layout@MetadataSlide{} SpeakerNotes
spkNotes Maybe String
backgroundImage) [Block]
blks =
do let ([Block]
ntsBlks, [Block]
blks') = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isNotesDiv [Block]
blks
SpeakerNotes
spkNotes' <- [SpeakerNotes] -> SpeakerNotes
forall a. Monoid a => [a] -> a
mconcat ([SpeakerNotes] -> SpeakerNotes)
-> ReaderT WriterEnv (State WriterState) [SpeakerNotes]
-> Pres SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres SpeakerNotes)
-> [Block] -> ReaderT WriterEnv (State WriterState) [SpeakerNotes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres SpeakerNotes
blockToSpeakerNotes [Block]
ntsBlks
(Slide, [Block]) -> Pres (Slide, [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
layout (SpeakerNotes
spkNotes SpeakerNotes -> SpeakerNotes -> SpeakerNotes
forall a. Semigroup a => a -> a -> a
<> SpeakerNotes
spkNotes') Maybe String
backgroundImage, [Block]
blks')
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks = (Slide, [Block]) -> Pres (Slide, [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide
sld, [Block]
blks)
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide [Block]
blks = (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId :: 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 Text
"toc-title" Meta
meta of
[] -> [Text -> Inline
Str Text
"Table of Contents"]
[Inline]
ls -> [Inline]
ls
hdr :: Block
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel Attr
nullAttr [Inline]
tocTitle
[Block] -> Pres Slide
blocksToSlide [Block
hdr, Block
contents]
combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' Maybe ParaElem
mbPElem [] = Maybe ParaElem -> [ParaElem]
forall a. Maybe a -> [a]
maybeToList Maybe ParaElem
mbPElem
combineParaElems' Maybe ParaElem
Nothing (ParaElem
pElem : [ParaElem]
pElems) =
Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems
combineParaElems' (Just ParaElem
pElem') (ParaElem
pElem : [ParaElem]
pElems)
| Run RunProps
rPr' Text
s' <- ParaElem
pElem'
, Run RunProps
rPr Text
s <- ParaElem
pElem
, RunProps
rPr RunProps -> RunProps -> Bool
forall a. Eq a => a -> a -> Bool
== RunProps
rPr' =
Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just (ParaElem -> Maybe ParaElem) -> ParaElem -> Maybe ParaElem
forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rPr' (Text -> ParaElem) -> Text -> ParaElem
forall a b. (a -> b) -> a -> b
$ Text
s' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) [ParaElem]
pElems
| Bool
otherwise =
ParaElem
pElem' ParaElem -> [ParaElem] -> [ParaElem]
forall a. a -> [a] -> [a]
: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' (ParaElem -> Maybe ParaElem
forall a. a -> Maybe a
Just ParaElem
pElem) [ParaElem]
pElems
combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems :: [ParaElem] -> [ParaElem]
combineParaElems = Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' Maybe ParaElem
forall a. Maybe a
Nothing
applyToParagraph :: Monad m => (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f Paragraph
para = do
[ParaElem]
paraElems' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f ([ParaElem] -> m [ParaElem]) -> [ParaElem] -> m [ParaElem]
forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para
Paragraph -> m Paragraph
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Paragraph -> m Paragraph) -> Paragraph -> m Paragraph
forall a b. (a -> b) -> a -> b
$ Paragraph
para {paraElems :: [ParaElem]
paraElems = [ParaElem]
paraElems'}
applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f (Pic PicProps
pPr String
fp Text
title [ParaElem]
pes) = PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
pPr String
fp Text
title ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (GraphicFrame [Graphic]
gfx [ParaElem]
pes) = [Graphic] -> [ParaElem] -> Shape
GraphicFrame [Graphic]
gfx ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (TextBox [Paragraph]
paras) = [Paragraph] -> Shape
TextBox ([Paragraph] -> Shape) -> m [Paragraph] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Paragraph -> m Paragraph) -> [Paragraph] -> m [Paragraph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
applyToShape ParaElem -> m ParaElem
_ (RawOOXMLShape Text
str) = Shape -> m Shape
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> m Shape) -> Shape -> m Shape
forall a b. (a -> b) -> a -> b
$ Text -> Shape
RawOOXMLShape Text
str
applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f (MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date) = do
[ParaElem]
title' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
title
[ParaElem]
subtitle' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
subtitle
[[ParaElem]]
authors' <- ([ParaElem] -> m [ParaElem]) -> [[ParaElem]] -> m [[ParaElem]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f) [[ParaElem]]
authors
[ParaElem]
date' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
date
Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> Layout
MetadataSlide [ParaElem]
title' [ParaElem]
subtitle' [[ParaElem]]
authors' [ParaElem]
date'
applyToLayout ParaElem -> m ParaElem
f (TitleSlide [ParaElem]
title) = [ParaElem] -> Layout
TitleSlide ([ParaElem] -> Layout) -> m [ParaElem] -> m Layout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
title
applyToLayout ParaElem -> m ParaElem
f (ContentSlide [ParaElem]
hdr [Shape]
content) = do
[ParaElem]
hdr' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
[Shape]
content' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
content
Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> Layout
ContentSlide [ParaElem]
hdr' [Shape]
content'
applyToLayout ParaElem -> m ParaElem
f (TwoColumnSlide [ParaElem]
hdr [Shape]
contentL [Shape]
contentR) = do
[ParaElem]
hdr' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
[Shape]
contentL' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL
[Shape]
contentR' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR
Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> [Shape] -> Layout
TwoColumnSlide [ParaElem]
hdr' [Shape]
contentL' [Shape]
contentR'
applyToLayout ParaElem -> m ParaElem
f (ComparisonSlide [ParaElem]
hdr ([Shape]
contentL1, [Shape]
contentL2) ([Shape]
contentR1, [Shape]
contentR2)) = do
[ParaElem]
hdr' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
[Shape]
contentL1' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL1
[Shape]
contentL2' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentL2
[Shape]
contentR1' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR1
[Shape]
contentR2' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentR2
Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> ([Shape], [Shape]) -> ([Shape], [Shape]) -> Layout
ComparisonSlide [ParaElem]
hdr' ([Shape]
contentL1', [Shape]
contentL2') ([Shape]
contentR1', [Shape]
contentR2')
applyToLayout ParaElem -> m ParaElem
f (ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes) = do
[ParaElem]
hdr' <- (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
hdr
[Shape]
textShapes' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
textShapes
[Shape]
contentShapes' <- (Shape -> m Shape) -> [Shape] -> m [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Shape -> m Shape
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f) [Shape]
contentShapes
Layout -> m Layout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ [ParaElem] -> [Shape] -> [Shape] -> Layout
ContentWithCaptionSlide [ParaElem]
hdr' [Shape]
textShapes' [Shape]
contentShapes'
applyToLayout ParaElem -> m ParaElem
_ Layout
BlankSlide = Layout -> m Layout
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Layout
BlankSlide
applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide ParaElem -> m ParaElem
f Slide
slide = do
Layout
layout' <- (ParaElem -> m ParaElem) -> Layout -> m Layout
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f (Layout -> m Layout) -> Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ Slide -> Layout
slideLayout Slide
slide
let paras :: [Paragraph]
paras = SpeakerNotes -> [Paragraph]
fromSpeakerNotes (SpeakerNotes -> [Paragraph]) -> SpeakerNotes -> [Paragraph]
forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide
SpeakerNotes
notes' <- [Paragraph] -> SpeakerNotes
SpeakerNotes ([Paragraph] -> SpeakerNotes) -> m [Paragraph] -> m SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Paragraph -> m Paragraph) -> [Paragraph] -> m [Paragraph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
Slide -> m Slide
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Slide
slide{slideLayout :: Layout
slideLayout = Layout
layout', slideSpeakerNotes :: SpeakerNotes
slideSpeakerNotes = SpeakerNotes
notes'}
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor (Run RunProps
rProps Text
s)
| Just (ExternalTarget (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
anchor), Text
_)) <- RunProps -> Maybe LinkTarget
rLink RunProps
rProps
= do
Map Text SlideId
anchorMap <- (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 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}
Maybe SlideId
Nothing -> RunProps
rProps{rLink :: Maybe LinkTarget
rLink = Maybe LinkTarget
forall a. Maybe a
Nothing}
ParaElem -> Pres ParaElem
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParaElem -> Pres ParaElem) -> ParaElem -> Pres ParaElem
forall a b. (a -> b) -> a -> b
$ RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
s
replaceAnchor ParaElem
pe = ParaElem -> Pres ParaElem
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ParaElem
pe
emptyParaElem :: ParaElem -> Bool
emptyParaElem :: ParaElem -> Bool
emptyParaElem (Run RunProps
_ Text
s) =
Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim Text
s
emptyParaElem (MathElem MathType
_ TeXString
ts) =
Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
Shared.trim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TeXString -> Text
unTeXString TeXString
ts
emptyParaElem ParaElem
_ = Bool
False
emptyParagraph :: Paragraph -> Bool
emptyParagraph :: Paragraph -> Bool
emptyParagraph Paragraph
para = (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem ([ParaElem] -> Bool) -> [ParaElem] -> Bool
forall a b. (a -> b) -> a -> b
$ Paragraph -> [ParaElem]
paraElems Paragraph
para
emptyShape :: Shape -> Bool
emptyShape :: Shape -> Bool
emptyShape (TextBox [Paragraph]
paras) = (Paragraph -> Bool) -> [Paragraph] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Paragraph -> Bool
emptyParagraph [Paragraph]
paras
emptyShape Shape
_ = Bool
False
emptyLayout :: Layout -> Bool
emptyLayout :: Layout -> Bool
emptyLayout Layout
layout = case Layout
layout of
MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date ->
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
title Bool -> Bool -> Bool
&&
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
subtitle Bool -> Bool -> Bool
&&
([ParaElem] -> Bool) -> [[ParaElem]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem) [[ParaElem]]
authors Bool -> Bool -> Bool
&&
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
date
TitleSlide [ParaElem]
hdr -> (ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr
ContentSlide [ParaElem]
hdr [Shape]
shapes ->
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes
TwoColumnSlide [ParaElem]
hdr [Shape]
shapes1 [Shape]
shapes2 ->
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes1 Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapes2
ComparisonSlide [ParaElem]
hdr ([Shape]
shapesL1, [Shape]
shapesL2) ([Shape]
shapesR1, [Shape]
shapesR2) ->
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL1 Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesL2 Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR1 Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
shapesR2
ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes ->
(ParaElem -> Bool) -> [ParaElem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ParaElem -> Bool
emptyParaElem [ParaElem]
hdr Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
textShapes Bool -> Bool -> Bool
&&
(Shape -> Bool) -> [Shape] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Shape -> Bool
emptyShape [Shape]
contentShapes
Layout
BlankSlide -> Bool
False
emptySlide :: Slide -> Bool
emptySlide :: Slide -> Bool
emptySlide (Slide SlideId
_ Layout
layout SpeakerNotes
notes Maybe String
backgroundImage)
= (SpeakerNotes
notes SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
== SpeakerNotes
forall a. Monoid a => a
mempty)
Bool -> Bool -> Bool
&& Layout -> Bool
emptyLayout Layout
layout
Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
backgroundImage
makesBlankSlide :: [Block] -> Bool
makesBlankSlide :: [Block] -> Bool
makesBlankSlide = (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank
blockIsBlank :: Block -> Bool
blockIsBlank :: Block -> Bool
blockIsBlank
= \case
Plain [Inline]
ins -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
Para [Inline]
ins -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
LineBlock [[Inline]]
inss -> ([Inline] -> Bool) -> [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank) [[Inline]]
inss
CodeBlock Attr
_ Text
txt -> Text -> Bool
textIsBlank Text
txt
RawBlock Format
_ Text
txt -> Text -> Bool
textIsBlank Text
txt
BlockQuote [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
OrderedList ListAttributes
_ [[Block]]
blss -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
BulletList [[Block]]
blss -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank) [[Block]]
blss
DefinitionList [([Inline], [[Block]])]
ds -> (([Inline], [[Block]]) -> Bool) -> [([Inline], [[Block]])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool)
-> (([Inline], [[Block]]) -> (Bool, Bool))
-> ([Inline], [[Block]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Bool)
-> ([[Block]] -> Bool) -> ([Inline], [[Block]]) -> (Bool, Bool)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank) (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank))) [([Inline], [[Block]])]
ds
Header Int
_ Attr
_ [Inline]
ils -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ils
Block
HorizontalRule -> Bool
True
Figure Attr
_ Caption
_ [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
Table{} -> Bool
False
Div Attr
_ [Block]
bls -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
textIsBlank :: T.Text -> Bool
textIsBlank :: Text -> Bool
textIsBlank = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace
inlineIsBlank :: Inline -> Bool
inlineIsBlank :: Inline -> Bool
inlineIsBlank
= \case
(Str Text
txt) -> Text -> Bool
textIsBlank Text
txt
(Emph [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Underline [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Strong [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Strikeout [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Superscript [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Subscript [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(SmallCaps [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Quoted QuoteType
_ [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
(Cite [Citation]
_ [Inline]
_) -> Bool
False
(Code Attr
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
Inline
Space -> Bool
True
Inline
SoftBreak -> Bool
True
Inline
LineBreak -> Bool
True
(Math MathType
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
(RawInline Format
_ Text
txt) -> Text -> Bool
textIsBlank Text
txt
(Link Attr
_ [Inline]
ins (Text
t1, Text
t2)) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t1 Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t2
(Image Attr
_ [Inline]
ins (Text
t1, Text
t2)) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t1 Bool -> Bool -> Bool
&& Text -> Bool
textIsBlank Text
t2
(Note [Block]
bls) -> (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
blockIsBlank [Block]
bls
(Span Attr
_ [Inline]
ins) -> (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
inlineIsBlank [Inline]
ins
blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides [Block]
blks = do
WriterOptions
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
Maybe Slide
mbMetadataSlide <- Pres (Maybe Slide)
getMetaSlide
([Slide]
metadataslides, [Block]
blks') <- case Maybe Slide
mbMetadataSlide of
Just Slide
sld ->
do (Slide
s, [Block]
bs) <- Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks
([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Slide
s], [Block]
bs)
Maybe Slide
Nothing -> ([Slide], [Block])
-> ReaderT WriterEnv (State WriterState) ([Slide], [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Block]
blks)
[[Block]]
blksLst <- [Block] -> Pres [[Block]]
splitBlocks [Block]
blks'
[SlideId]
bodySlideIds <- (Integer -> Pres SlideId)
-> [Integer] -> ReaderT WriterEnv (State WriterState) [SlideId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
(\Integer
n -> Text -> Pres SlideId
runUniqueSlideId (Text -> Pres SlideId) -> Text -> Pres SlideId
forall a b. (a -> b) -> a -> b
$ Text
"BodySlide" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
tshow Integer
n)
(Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
blksLst) [Integer
1..] :: [Integer])
[Slide]
bodyslides <- (([Block], SlideId) -> Pres Slide)
-> [([Block], SlideId)] -> Pres [Slide]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
(\([Block]
bs, SlideId
ident) ->
(WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
st -> WriterEnv
st{envCurSlideId :: 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 a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
toc]
else [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Slide]
endNotesSlides <- if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
endNotesSlideBlocks
then [Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do Slide
endNotesSlide <- (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
(\WriterEnv
env -> WriterEnv
env { envCurSlideId :: SlideId
envCurSlideId = SlideId
endNotesSlideId
, envInNoteSlide :: Bool
envInNoteSlide = Bool
True
})
([Block] -> Pres Slide
blocksToSlide [Block]
endNotesSlideBlocks)
[Slide] -> Pres [Slide]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Slide
endNotesSlide]
let slides :: [Slide]
slides = [Slide]
metadataslides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
tocSlides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
bodyslides [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Slide]
endNotesSlides
slides' :: [Slide]
slides' = (Slide -> Bool) -> [Slide] -> [Slide]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Slide -> Bool) -> Slide -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slide -> Bool
emptySlide) [Slide]
slides
(Slide -> Pres Slide) -> [Slide] -> Pres [Slide]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> Pres ParaElem) -> Slide -> Pres Slide
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide ParaElem -> Pres ParaElem
replaceAnchor) [Slide]
slides'
metaToDocProps :: Meta -> DocProps
metaToDocProps :: Meta -> DocProps
metaToDocProps Meta
meta =
let keywords :: Maybe [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"keywords" Meta
meta of
Just (MetaList [MetaValue]
xs) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify [MetaValue]
xs
Maybe MetaValue
_ -> Maybe [Text]
forall a. Maybe a
Nothing
authors :: Maybe Text
authors = case ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta of
[] -> Maybe Text
forall a. Maybe a
Nothing
[Text]
ss -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
ss
description :: Maybe Text
description = case (Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta of
[] -> Maybe Text
forall a. Maybe a
Nothing
[Text]
ss -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"_x000d_\n" [Text]
ss
customProperties' :: Maybe [(Text, Text)]
customProperties' = case [(Text
k, Text -> Meta -> Text
lookupMetaString Text
k Meta
meta) | Text
k <- Map Text MetaValue -> [Text]
forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"title", Text
"author", Text
"keywords", Text
"description"
, Text
"subject",Text
"lang",Text
"category"]] of
[] -> Maybe [(Text, Text)]
forall a. Maybe a
Nothing
[(Text, Text)]
ss -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text, Text)]
ss
in
DocProps{ dcTitle :: Maybe Text
dcTitle = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta
, dcSubject :: Maybe Text
dcSubject = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"subject" Meta
meta
, dcCreator :: Maybe Text
dcCreator = Maybe Text
authors
, dcKeywords :: Maybe [Text]
dcKeywords = Maybe [Text]
keywords
, dcDescription :: Maybe Text
dcDescription = Maybe Text
description
, cpCategory :: Maybe Text
cpCategory = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"category" Meta
meta
, dcDate :: Maybe Text
dcDate =
let t :: Text
t = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (Meta -> [Inline]
docDate Meta
meta)
in if Text -> Bool
T.null Text
t
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
, customProperties :: Maybe [(Text, Text)]
customProperties = Maybe [(Text, Text)]
customProperties'
}
documentToPresentation :: WriterOptions
-> Pandoc
-> (Presentation, [LogMessage])
documentToPresentation :: WriterOptions -> Pandoc -> (Presentation, [LogMessage])
documentToPresentation WriterOptions
opts (Pandoc Meta
meta [Block]
blks) =
let env :: WriterEnv
env = WriterEnv
forall a. Default a => a
def { envOpts :: 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)
}
([Slide]
presSlides, [LogMessage]
msgs) = WriterEnv -> WriterState -> Pres [Slide] -> ([Slide], [LogMessage])
forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
forall a. Default a => a
def (Pres [Slide] -> ([Slide], [LogMessage]))
-> Pres [Slide] -> ([Slide], [LogMessage])
forall a b. (a -> b) -> a -> b
$ [Block] -> Pres [Slide]
blocksToPresentationSlides [Block]
blks
docProps :: DocProps
docProps = Meta -> DocProps
metaToDocProps Meta
meta
in
(DocProps -> [Slide] -> Presentation
Presentation DocProps
docProps [Slide]
presSlides, [LogMessage]
msgs)
applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps =
RunProps
rProps{ rSolidFill :: Maybe Color
rSolidFill = TokenStyle -> Maybe Color
tokenColor TokenStyle
tokSty Maybe Color -> Maybe Color -> Maybe Color
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunProps -> Maybe Color
rSolidFill RunProps
rProps
, rPropBold :: Bool
rPropBold = TokenStyle -> Bool
tokenBold TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropBold RunProps
rProps
, rPropItalics :: Bool
rPropItalics = TokenStyle -> Bool
tokenItalic TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropItalics RunProps
rProps
, rPropUnderline :: Bool
rPropUnderline = TokenStyle -> Bool
tokenUnderline TokenStyle
tokSty Bool -> Bool -> Bool
|| RunProps -> Bool
rPropUnderline RunProps
rProps
}
formatToken :: Style -> Token -> ParaElem
formatToken :: Style -> Token -> ParaElem
formatToken Style
sty (TokenType
tokType, Text
txt) =
let rProps :: RunProps
rProps = 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 TokenStyle
tokSty -> TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps
Maybe TokenStyle
Nothing -> RunProps
rProps
in
RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
txt
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
_ SourceLine
srcLn = (Token -> ParaElem) -> SourceLine -> [ParaElem]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> Token -> ParaElem
formatToken Style
sty) SourceLine
srcLn
formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines Style
sty FormatOptions
opts [SourceLine]
srcLns = [ParaElem] -> [[ParaElem]] -> [ParaElem]
forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break] ([[ParaElem]] -> [ParaElem]) -> [[ParaElem]] -> [ParaElem]
forall a b. (a -> b) -> a -> b
$
(SourceLine -> [ParaElem]) -> [SourceLine] -> [[ParaElem]]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
opts) [SourceLine]
srcLns