{-# 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
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)
inIncrementalDiv <- asks envInIncrementalDiv
inBlockQuote <- asks envInListInBlockQuote
let toBoolean = (\case InIncrementalDiv
InIncremental -> Bool
True
InIncrementalDiv
InNonIncremental -> Bool
False)
maybeInvert = if Bool
inBlockQuote then Bool -> Bool
not else Bool -> Bool
forall a. a -> a
id
pure (maybeInvert (maybe incrementalOption toBoolean 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
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 = Set SlideId -> Text -> SlideId
uniqueSlideId Set SlideId
idSet Text
s
modify $ \WriterState
st -> WriterState
st{stSlideIdSet = S.insert sldId idSet}
return sldId
addLogMessage :: LogMessage -> Pres ()
addLogMessage :: LogMessage -> ReaderT WriterEnv (State WriterState) ()
addLogMessage LogMessage
msg = (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stLog = msg : stLog st}
type Pres = ReaderT WriterEnv (State WriterState)
runPres :: WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres :: forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
st Pres a
p = (a
pres, [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> a -> b
$ WriterState -> [LogMessage]
stLog WriterState
finalSt)
where (a
pres, WriterState
finalSt) = State WriterState a -> WriterState -> (a, WriterState)
forall s a. State s a -> s -> (a, s)
runState (Pres a -> WriterEnv -> State WriterState a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Pres a
p WriterEnv
env) WriterState
st
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 [Double] TableProps [TableCell] [[TableCell]]
deriving (Int -> Graphic -> ShowS
[Graphic] -> ShowS
Graphic -> String
(Int -> Graphic -> ShowS)
-> (Graphic -> String) -> ([Graphic] -> ShowS) -> Show Graphic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Graphic -> ShowS
showsPrec :: Int -> Graphic -> ShowS
$cshow :: Graphic -> String
show :: Graphic -> String
$cshowList :: [Graphic] -> ShowS
showList :: [Graphic] -> ShowS
Show, Graphic -> Graphic -> Bool
(Graphic -> Graphic -> Bool)
-> (Graphic -> Graphic -> Bool) -> Eq Graphic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Graphic -> Graphic -> Bool
== :: Graphic -> Graphic -> Bool
$c/= :: Graphic -> Graphic -> Bool
/= :: Graphic -> Graphic -> Bool
Eq)
data Paragraph = Paragraph { Paragraph -> ParaProps
paraProps :: ParaProps
, Paragraph -> [ParaElem]
paraElems :: [ParaElem]
} deriving (Int -> Paragraph -> ShowS
[Paragraph] -> ShowS
Paragraph -> String
(Int -> Paragraph -> ShowS)
-> (Paragraph -> String)
-> ([Paragraph] -> ShowS)
-> Show Paragraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Paragraph -> ShowS
showsPrec :: Int -> Paragraph -> ShowS
$cshow :: Paragraph -> String
show :: Paragraph -> String
$cshowList :: [Paragraph] -> ShowS
showList :: [Paragraph] -> ShowS
Show, Paragraph -> Paragraph -> Bool
(Paragraph -> Paragraph -> Bool)
-> (Paragraph -> Paragraph -> Bool) -> Eq Paragraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Paragraph -> Paragraph -> Bool
== :: Paragraph -> Paragraph -> Bool
$c/= :: Paragraph -> Paragraph -> Bool
/= :: Paragraph -> Paragraph -> Bool
Eq)
data BulletType = Bullet
| AutoNumbering ListAttributes
deriving (Int -> BulletType -> ShowS
[BulletType] -> ShowS
BulletType -> String
(Int -> BulletType -> ShowS)
-> (BulletType -> String)
-> ([BulletType] -> ShowS)
-> Show BulletType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BulletType -> ShowS
showsPrec :: Int -> BulletType -> ShowS
$cshow :: BulletType -> String
show :: BulletType -> String
$cshowList :: [BulletType] -> ShowS
showList :: [BulletType] -> ShowS
Show, BulletType -> BulletType -> Bool
(BulletType -> BulletType -> Bool)
-> (BulletType -> BulletType -> Bool) -> Eq BulletType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BulletType -> BulletType -> Bool
== :: BulletType -> BulletType -> Bool
$c/= :: BulletType -> BulletType -> Bool
/= :: BulletType -> BulletType -> Bool
Eq)
data Algnment = AlgnLeft | AlgnRight | AlgnCenter
deriving (Int -> Algnment -> ShowS
[Algnment] -> ShowS
Algnment -> String
(Int -> Algnment -> ShowS)
-> (Algnment -> String) -> ([Algnment] -> ShowS) -> Show Algnment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Algnment -> ShowS
showsPrec :: Int -> Algnment -> ShowS
$cshow :: Algnment -> String
show :: Algnment -> String
$cshowList :: [Algnment] -> ShowS
showList :: [Algnment] -> ShowS
Show, Algnment -> Algnment -> Bool
(Algnment -> Algnment -> Bool)
-> (Algnment -> Algnment -> Bool) -> Eq Algnment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Algnment -> Algnment -> Bool
== :: Algnment -> Algnment -> Bool
$c/= :: Algnment -> Algnment -> Bool
/= :: Algnment -> Algnment -> Bool
Eq)
data ParaProps = ParaProps { ParaProps -> Maybe Integer
pPropMarginLeft :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropMarginRight :: Maybe Pixels
, ParaProps -> Int
pPropLevel :: Int
, ParaProps -> Maybe BulletType
pPropBullet :: Maybe BulletType
, ParaProps -> Maybe Algnment
pPropAlign :: Maybe Algnment
, ParaProps -> Maybe Integer
pPropSpaceBefore :: Maybe Pixels
, ParaProps -> Maybe Integer
pPropIndent :: Maybe Pixels
, ParaProps -> Bool
pPropIncremental :: Bool
} deriving (Int -> ParaProps -> ShowS
[ParaProps] -> ShowS
ParaProps -> String
(Int -> ParaProps -> ShowS)
-> (ParaProps -> String)
-> ([ParaProps] -> ShowS)
-> Show ParaProps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParaProps -> ShowS
showsPrec :: Int -> ParaProps -> ShowS
$cshow :: ParaProps -> String
show :: ParaProps -> String
$cshowList :: [ParaProps] -> ShowS
showList :: [ParaProps] -> ShowS
Show, ParaProps -> ParaProps -> Bool
(ParaProps -> ParaProps -> Bool)
-> (ParaProps -> ParaProps -> Bool) -> Eq ParaProps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParaProps -> ParaProps -> Bool
== :: ParaProps -> ParaProps -> Bool
$c/= :: ParaProps -> ParaProps -> Bool
/= :: ParaProps -> ParaProps -> Bool
Eq)
instance Default ParaProps where
def :: ParaProps
def = ParaProps { pPropMarginLeft :: Maybe Integer
pPropMarginLeft = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropMarginRight :: Maybe Integer
pPropMarginRight = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropLevel :: Int
pPropLevel = Int
0
, pPropBullet :: Maybe BulletType
pPropBullet = Maybe BulletType
forall a. Maybe a
Nothing
, pPropAlign :: Maybe Algnment
pPropAlign = Maybe Algnment
forall a. Maybe a
Nothing
, pPropSpaceBefore :: Maybe Integer
pPropSpaceBefore = Maybe Integer
forall a. Maybe a
Nothing
, pPropIndent :: Maybe Integer
pPropIndent = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
, pPropIncremental :: Bool
pPropIncremental = Bool
False
}
newtype TeXString = TeXString {TeXString -> Text
unTeXString :: T.Text}
deriving (TeXString -> TeXString -> Bool
(TeXString -> TeXString -> Bool)
-> (TeXString -> TeXString -> Bool) -> Eq TeXString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeXString -> TeXString -> Bool
== :: TeXString -> TeXString -> Bool
$c/= :: TeXString -> TeXString -> Bool
/= :: TeXString -> TeXString -> Bool
Eq, Int -> TeXString -> ShowS
[TeXString] -> ShowS
TeXString -> String
(Int -> TeXString -> ShowS)
-> (TeXString -> String)
-> ([TeXString] -> ShowS)
-> Show TeXString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeXString -> ShowS
showsPrec :: Int -> TeXString -> ShowS
$cshow :: TeXString -> String
show :: TeXString -> String
$cshowList :: [TeXString] -> ShowS
showList :: [TeXString] -> ShowS
Show)
data ParaElem = Break
| Run RunProps T.Text
| 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
pr <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
return [Run pr s]
inlineToParElems (Emph [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropItalics=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Underline [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropUnderline=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strong [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rPropBold=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Strikeout [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rStrikethrough=Just SingleStrike}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Superscript [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rBaseline=Just 30000}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Subscript [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rBaseline=Just (-25000)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (SmallCaps [Inline]
ils) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{envRunProps = (envRunProps r){rCap = Just SmallCapitals}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems Inline
Space = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
SoftBreak = Inline -> Pres [ParaElem]
inlineToParElems (Text -> Inline
Str Text
" ")
inlineToParElems Inline
LineBreak = [ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParaElem
Break]
inlineToParElems (Link Attr
_ [Inline]
ils (Text
url, Text
title)) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
inlineToParElems (Code Attr
_ Text
str) =
(WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r ->WriterEnv
r{envRunProps = (envRunProps r){rPropCode = True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
Inline -> Pres [ParaElem]
inlineToParElems (Inline -> Pres [ParaElem]) -> Inline -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
str
inlineToParElems (Math MathType
mathtype Text
str) =
[ParaElem] -> Pres [ParaElem]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return [MathType -> TeXString -> ParaElem
MathElem MathType
mathtype (Text -> TeXString
TeXString Text
str)]
inlineToParElems (Note [Block]
blks) = do
inSpNotes <- (WriterEnv -> Bool) -> Pres Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Bool
envInSpeakerNotes
if inSpNotes
then return []
else do
notes <- gets stNoteIds
let 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
maxNoteId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
modify $ \WriterState
st -> WriterState
st { stNoteIds = M.insert curNoteId blks notes }
local (\WriterEnv
env -> WriterEnv
env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $
inlineToParElems $ Superscript [Str $ tshow 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
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
sldId <- asks envCurSlideId
unless (T.null anchor) $
modify $ \WriterState
st -> WriterState
st {stAnchorMap = M.insert anchor sldId 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
parElems <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
pProps <- asks envParaProps
return [Paragraph pProps parElems]
blockToParagraphs (LineBlock [[Inline]]
ilsList) = do
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
pProps <- asks envParaProps
return [Paragraph pProps parElems]
blockToParagraphs (CodeBlock Attr
attr Text
str) = do
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
local (\WriterEnv
r -> WriterEnv
r{ envParaProps = def{ pPropMarginLeft = Nothing
, pPropBullet = Nothing
, pPropLevel = pPropLevel pProps
, pPropIndent = Just 0
}
, envRunProps = (envRunProps r){rPropCode = True}}) $ do
mbSty <- writerHighlightStyle <$> asks envOpts
synMap <- writerSyntaxMap <$> asks envOpts
case 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 pPropsNew <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
return [Paragraph pPropsNew 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
ps <- (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env { envInListInBlockQuote = True })
(Block -> Pres [Paragraph]
blockToParagraphs Block
blk)
ps' <- blockToParagraphs $ BlockQuote blks
return $ ps ++ ps'
blockToParagraphs (BlockQuote [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
r -> WriterEnv
r{ envParaProps = (envParaProps r){ pPropMarginLeft = Just 100
, pPropIndent = Just 0
}
, envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})(Pres [Paragraph] -> Pres [Paragraph])
-> Pres [Paragraph] -> Pres [Paragraph]
forall a b. (a -> b) -> a -> b
$
(Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks
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
parElems <- (WriterEnv -> WriterEnv) -> Pres [ParaElem] -> Pres [ParaElem]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
e->WriterEnv
e{envRunProps = (envRunProps e){rPropBold=True}}) (Pres [ParaElem] -> Pres [ParaElem])
-> Pres [ParaElem] -> Pres [ParaElem]
forall a b. (a -> b) -> a -> b
$
[Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
return [Paragraph def{pPropSpaceBefore = Just 30} parElems]
blockToParagraphs (BulletList [[Block]]
blksLst) = do
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
incremental <- listShouldBeIncremental
local (\WriterEnv
env -> WriterEnv
env{ envInList = True
, envParaProps = pProps{ pPropBullet = Just Bullet
, pPropMarginLeft = Nothing
, pPropIndent = Nothing
, pPropIncremental = incremental
}}) $
concatMapM multiParList blksLst
blockToParagraphs (OrderedList ListAttributes
listAttr [[Block]]
blksLst) = do
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
incremental <- listShouldBeIncremental
local (\WriterEnv
env -> WriterEnv
env{ envInList = True
, envParaProps = pProps{ pPropBullet = Just (AutoNumbering listAttr)
, pPropMarginLeft = Nothing
, pPropIndent = Nothing
, pPropIncremental = incremental
}}) $
concatMapM multiParList blksLst
blockToParagraphs (DefinitionList [([Inline], [[Block]])]
entries) = do
incremental <- Pres Bool
listShouldBeIncremental
let go :: ([Inline], [[Block]]) -> Pres [Paragraph]
go ([Inline]
ils, [[Block]]
blksLst) = do
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]
definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst
return $ term ++ definition
local (\WriterEnv
env -> WriterEnv
env {envParaProps =
(envParaProps env) {pPropIncremental = incremental}})
$ concatMapM go entries
blockToParagraphs (Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
blks) = let
hasIncremental :: Bool
hasIncremental = Text
"incremental" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
hasNonIncremental :: Bool
hasNonIncremental = Text
"nonincremental" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
incremental :: Maybe InIncrementalDiv
incremental = if | Bool
hasIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InIncremental
| Bool
hasNonIncremental -> InIncrementalDiv -> Maybe InIncrementalDiv
forall a. a -> Maybe a
Just InIncrementalDiv
InNonIncremental
| Bool
otherwise -> Maybe InIncrementalDiv
forall a. Maybe a
Nothing
addIncremental :: WriterEnv -> WriterEnv
addIncremental WriterEnv
env = WriterEnv
env { envInIncrementalDiv = incremental }
in (WriterEnv -> WriterEnv) -> Pres [Paragraph] -> Pres [Paragraph]
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WriterEnv -> WriterEnv
addIncremental ((Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks)
blockToParagraphs (Figure Attr
attr Caption
capt [Block]
blks) =
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
pProps <- (WriterEnv -> ParaProps)
-> ReaderT WriterEnv (State WriterState) ParaProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> ParaProps
envParaProps
p <- blockToParagraphs b
let level = ParaProps -> Int
pPropLevel ParaProps
pProps
ps <- local (\WriterEnv
env -> WriterEnv
env
{ envParaProps = pProps
{ pPropBullet = Nothing
, pPropLevel = level + 1
}
})
$ concatMapM blockToParagraphs bs
return $ p ++ ps
cellToParagraphs :: Alignment -> SimpleCell -> Pres [Paragraph]
cellToParagraphs :: Alignment -> [Block] -> Pres [Paragraph]
cellToParagraphs Alignment
algn [Block]
tblCell = do
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 = 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] -> [Paragraph]) -> [[Paragraph]] -> [[Paragraph]]
forall a b. (a -> b) -> [a] -> [b]
map ((Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
p -> Paragraph
p{paraProps = (paraProps p){pPropAlign = alignment}})) [[Paragraph]]
paras
return $ concat 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 = dimension Width attr
, picHeight = dimension Height attr
}
in
PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
picPr' String
url Text
title [ParaElem]
caption
withAttr Attr
_ Shape
sp = Shape
sp
blockToShape :: Block -> Pres Shape
blockToShape :: Block -> Pres Shape
blockToShape (Plain [Inline]
ils) = Block -> Pres Shape
blockToShape ([Inline] -> Block
Para [Inline]
ils)
blockToShape (Para (Inline
il:[Inline]
_)) | Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il =
Attr -> Shape -> Shape
withAttr Attr
attr (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def (Text -> String
T.unpack Text
url) Text
title ([ParaElem] -> Shape) -> Pres [ParaElem] -> Pres Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
blockToShape (Para (Inline
il:[Inline]
_)) | Link Attr
_ (Inline
il':[Inline]
_) (Text, Text)
target <- Inline
il
, Image Attr
attr [Inline]
ils (Text
url, Text
title) <- Inline
il' =
Attr -> Shape -> Shape
withAttr Attr
attr (Shape -> Shape) -> ([ParaElem] -> Shape) -> [ParaElem] -> Shape
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
forall a. Default a => a
def{picPropLink = Just $ ExternalTarget target} (Text -> String
T.unpack Text
url) Text
title
([ParaElem] -> Shape) -> Pres [ParaElem] -> Pres Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
blockToShape (Figure Attr
_figattr Caption
_caption [Block
b]) = Block -> Pres Shape
blockToShape Block
b
blockToShape (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
algn, [Double]
widths, [[Block]]
hdrCells, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
caption' <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
caption
hdrCells' <- rowToParagraphs algn hdrCells
rows' <- mapM (rowToParagraphs algn) rows
let 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
}
return $ GraphicFrame [Tbl widths tblPr hdrCells' rows'] 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 paras <- Block -> Pres [Paragraph]
blockToParagraphs Block
blk
let paras' = (Paragraph -> Paragraph) -> [Paragraph] -> [Paragraph]
forall a b. (a -> b) -> [a] -> [b]
map (\Paragraph
par -> Paragraph
par{paraElems = combineParaElems $ paraElems par}) [Paragraph]
paras
return $ TextBox paras'
combineShapes :: [Shape] -> [Shape]
combineShapes :: [Shape] -> [Shape]
combineShapes [] = []
combineShapes (pic :: Shape
pic@Pic{} : [Shape]
ss) = Shape
pic Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes [Shape]
ss
combineShapes (Shape
s : TextBox [] : [Shape]
ss) = [Shape] -> [Shape]
combineShapes (Shape
s Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss)
combineShapes (TextBox (Paragraph
p:[Paragraph]
ps) : TextBox (Paragraph
p':[Paragraph]
ps') : [Shape]
ss) =
[Shape] -> [Shape]
combineShapes ([Shape] -> [Shape]) -> [Shape] -> [Shape]
forall a b. (a -> b) -> a -> b
$ [Paragraph] -> Shape
TextBox ((Paragraph
pParagraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps) [Paragraph] -> [Paragraph] -> [Paragraph]
forall a. [a] -> [a] -> [a]
++ (Paragraph
p'Paragraph -> [Paragraph] -> [Paragraph]
forall a. a -> [a] -> [a]
:[Paragraph]
ps')) Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape]
ss
combineShapes (Shape
s:[Shape]
ss) = Shape
s Shape -> [Shape] -> [Shape]
forall a. a -> [a] -> [a]
: [Shape] -> [Shape]
combineShapes [Shape]
ss
isNotesDiv :: Block -> Bool
isNotesDiv :: Block -> Bool
isNotesDiv (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
_) = Bool
True
isNotesDiv Block
_ = Bool
False
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes :: [Block] -> Pres [Shape]
blocksToShapes [Block]
blks = [Shape] -> [Shape]
combineShapes ([Shape] -> [Shape]) -> Pres [Shape] -> Pres [Shape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres Shape) -> [Block] -> Pres [Shape]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> Pres Shape
blockToShape [Block]
blks
isImage :: Inline -> Bool
isImage :: Inline -> Bool
isImage Image{} = Bool
True
isImage (Link Attr
_ (Image{} : [Inline]
_) (Text, Text)
_) = Bool
True
isImage Inline
_ = Bool
False
plainOrPara :: Block -> Maybe [Inline]
plainOrPara :: Block -> Maybe [Inline]
plainOrPara (Plain [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara (Para [Inline]
ils) = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
ils
plainOrPara Block
_ = Maybe [Inline]
forall a. Maybe a
Nothing
notText :: Block -> Bool
notText :: Block -> Bool
notText Block
block | Block -> Bool
startsWithImage Block
block = Bool
True
notText Table{} = Bool
True
notText Figure{} = Bool
True
notText Block
_ = Bool
False
startsWithImage :: Block -> Bool
startsWithImage :: Block -> Bool
startsWithImage Block
block = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
inline <- 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
pure (isImage 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
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let (nts, blks') = span isNotesDiv blks
case compare n 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
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let (nts, blks') = if null ils
then span isNotesDiv blks
else ([], blks)
case 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
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let (nts, blks') = span isNotesDiv blks
case 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
slideLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (State WriterState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envSlideLevel
let (nts, blks') = span isNotesDiv blks
case 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
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
blksR' <- join . take 1 <$> splitBlocks right
shapesL <- blocksToShapes blksL'
shapesR <- blocksToShapes blksR'
sldId <- asks envCurSlideId
return $ Slide
sldId
(TwoColumnSlide [] shapesL shapesR)
spkNotes
Nothing
let mkComparison :: [Block] -> [Block] -> [Block] -> [Block] -> Pres Slide
mkComparison [Block]
blksL1 [Block]
blksL2 [Block]
blksR1 [Block]
blksR2 = do
shapesL1 <- [Block] -> Pres [Shape]
blocksToShapes [Block]
blksL1
shapesL2 <- blocksToShapes blksL2
shapesR1 <- blocksToShapes blksR1
shapesR2 <- blocksToShapes blksR2
sldId <- asks envCurSlideId
return $ Slide
sldId
(ComparisonSlide [] (shapesL1, shapesL2) (shapesR1, shapesR2))
spkNotes
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
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
inNoteSlide <- asks envInNoteSlide
let mkSlide Layout
s =
SlideId -> Layout -> SpeakerNotes -> Maybe String -> Slide
Slide SlideId
sldId Layout
s SpeakerNotes
spkNotes Maybe String
forall a. Maybe a
Nothing
if inNoteSlide
then mkSlide . ContentSlide [] <$>
forceFontSize noteSize (blocksToShapes (blk : blks))
else let
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 break notText (blk : blks) of
([], [Block]
_) -> Pres Slide
contentOrBlankSlide
([Block]
_, []) -> Pres Slide
contentOrBlankSlide
([Block]
textBlocks, [Block]
contentBlocks) -> do
textShapes <- [Block] -> Pres [Shape]
blocksToShapes [Block]
textBlocks
contentShapes <- blocksToShapes contentBlocks
return (mkSlide (ContentWithCaptionSlide [] textShapes contentShapes))
bodyBlocksToSlide Int
_ [] SpeakerNotes
spkNotes = do
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
return $
Slide
sldId
BlankSlide
spkNotes
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
sldId <- (WriterEnv -> SlideId) -> Pres SlideId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> SlideId
envCurSlideId
hdr <- inlinesToParElems ils
return $ Slide sldId (TitleSlide hdr) spkNotes 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
hdr <- [Inline] -> Pres [ParaElem]
inlinesToParElems [Inline]
ils
slide <- bodyBlocksToSlide lvl blks spkNotes
let 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'
return $ slide{slideLayout = layout, slideBackgroundImage = backgroundImage}
where
backgroundImage :: Maybe String
backgroundImage = Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"background-image" [(Text, Text)]
attributes
Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"data-background-image" [(Text, Text)]
attributes)
blocksToSlide' Int
lvl [Block]
blks SpeakerNotes
spkNotes = Int -> [Block] -> SpeakerNotes -> Pres Slide
bodyBlocksToSlide Int
lvl [Block]
blks SpeakerNotes
spkNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes :: Block -> Pres SpeakerNotes
blockToSpeakerNotes (Div (Text
_, [Text
"notes"], [(Text, Text)]
_) [Block]
blks) =
(WriterEnv -> WriterEnv) -> Pres SpeakerNotes -> Pres SpeakerNotes
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envInSpeakerNotes=True}) (Pres SpeakerNotes -> Pres SpeakerNotes)
-> Pres SpeakerNotes -> Pres SpeakerNotes
forall a b. (a -> b) -> a -> b
$
[Paragraph] -> SpeakerNotes
SpeakerNotes ([Paragraph] -> SpeakerNotes)
-> Pres [Paragraph] -> Pres SpeakerNotes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Pres [Paragraph]) -> [Block] -> Pres [Paragraph]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM Block -> Pres [Paragraph]
blockToParagraphs [Block]
blks
blockToSpeakerNotes Block
_ = SpeakerNotes -> Pres SpeakerNotes
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return SpeakerNotes
forall a. Monoid a => a
mempty
handleSpeakerNotes :: Block -> Pres ()
handleSpeakerNotes :: Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes Block
blk = do
spNotes <- Block -> Pres SpeakerNotes
blockToSpeakerNotes Block
blk
modify $ \WriterState
st -> WriterState
st{stSpeakerNotes = stSpeakerNotes st <> spNotes}
handleAndFilterSpeakerNotes' :: [Block] -> Pres [Block]
handleAndFilterSpeakerNotes' :: [Block] -> ReaderT WriterEnv (State WriterState) [Block]
handleAndFilterSpeakerNotes' [Block]
blks = do
(Block -> ReaderT WriterEnv (State WriterState) ())
-> [Block] -> ReaderT WriterEnv (State WriterState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Block -> ReaderT WriterEnv (State WriterState) ()
handleSpeakerNotes [Block]
blks
[Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> ReaderT WriterEnv (State WriterState) [Block])
-> [Block] -> ReaderT WriterEnv (State WriterState) [Block]
forall a b. (a -> b) -> a -> b
$ (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isNotesDiv) [Block]
blks
handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes :: [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks = do
(WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ())
-> (WriterState -> WriterState)
-> ReaderT WriterEnv (State WriterState) ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{stSpeakerNotes = mempty}
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
spkNotes <- gets stSpeakerNotes
return (blks', spkNotes)
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide [Block]
blks = do
(blks', spkNotes) <- [Block] -> Pres ([Block], SpeakerNotes)
handleAndFilterSpeakerNotes [Block]
blks
slideLevel <- asks envSlideLevel
blocksToSlide' slideLevel blks' 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
rpr <- (WriterEnv -> RunProps)
-> ReaderT WriterEnv (State WriterState) RunProps
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> RunProps
envRunProps
local (\WriterEnv
r -> WriterEnv
r {envRunProps = rpr{rPropForceSize = Just px}}) x
makeEndNotesSlideBlocks :: Pres [Block]
makeEndNotesSlideBlocks :: ReaderT WriterEnv (State WriterState) [Block]
makeEndNotesSlideBlocks = do
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
slideLevel <- asks envSlideLevel
exts <- writerExtensions <$> asks envOpts
meta <- asks envMetadata
anchorSet <- M.keysSet <$> gets stAnchorMap
if M.null noteIds
then return []
else let title = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"notes-title" Meta
meta of
[] -> [Text -> Inline
Str Text
"Notes"]
[Inline]
ls -> [Inline]
ls
ident = Extensions -> [Inline] -> Set Text -> Text
Shared.uniqueIdent Extensions
exts [Inline]
title Set Text
anchorSet
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel (Text
ident, [], []) [Inline]
title
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 return $ hdr : blks
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide = do
meta <- (WriterEnv -> Meta) -> ReaderT WriterEnv (State WriterState) Meta
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Meta
envMetadata
title <- inlinesToParElems $ docTitle meta
subtitle <- inlinesToParElems $ lookupMetaInlines "subtitle" meta
authors <- mapM inlinesToParElems $ docAuthors meta
date <- inlinesToParElems $ docDate meta
if null title && null subtitle && null authors && null date
then return Nothing
else return $
Just $
Slide
metadataSlideId
(MetadataSlide title subtitle authors date)
mempty
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
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
return (Slide sldId layout (spkNotes <> spkNotes') backgroundImage, blks')
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks = (Slide, [Block]) -> Pres (Slide, [Block])
forall a. a -> ReaderT WriterEnv (State WriterState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Slide
sld, [Block]
blks)
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide :: [Block] -> Pres Slide
makeTOCSlide [Block]
blks = (WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
env -> WriterEnv
env{envCurSlideId = tocSlideId}) (Pres Slide -> Pres Slide) -> Pres Slide -> Pres Slide
forall a b. (a -> b) -> a -> b
$ do
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 = WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
blks
meta <- asks envMetadata
slideLevel <- asks envSlideLevel
let tocTitle = case Text -> Meta -> [Inline]
lookupMetaInlines Text
"toc-title" Meta
meta of
[] -> [Text -> Inline
Str Text
"Table of Contents"]
[Inline]
ls -> [Inline]
ls
hdr = Int -> Attr -> [Inline] -> Block
Header Int
slideLevel Attr
nullAttr [Inline]
tocTitle
blocksToSlide [hdr, 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
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
return $ para {paraElems = paraElems'}
applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Shape -> m Shape
applyToShape ParaElem -> m ParaElem
f (Pic PicProps
pPr String
fp Text
title [ParaElem]
pes) = PicProps -> String -> Text -> [ParaElem] -> Shape
Pic PicProps
pPr String
fp Text
title ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (GraphicFrame [Graphic]
gfx [ParaElem]
pes) = [Graphic] -> [ParaElem] -> Shape
GraphicFrame [Graphic]
gfx ([ParaElem] -> Shape) -> m [ParaElem] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParaElem -> m ParaElem) -> [ParaElem] -> m [ParaElem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ParaElem -> m ParaElem
f [ParaElem]
pes
applyToShape ParaElem -> m ParaElem
f (TextBox [Paragraph]
paras) = [Paragraph] -> Shape
TextBox ([Paragraph] -> Shape) -> m [Paragraph] -> m Shape
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Paragraph -> m Paragraph) -> [Paragraph] -> m [Paragraph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Paragraph -> m Paragraph
applyToParagraph ParaElem -> m ParaElem
f) [Paragraph]
paras
applyToShape ParaElem -> m ParaElem
_ (RawOOXMLShape Text
str) = Shape -> m Shape
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Shape -> m Shape) -> Shape -> m Shape
forall a b. (a -> b) -> a -> b
$ Text -> Shape
RawOOXMLShape Text
str
applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout :: forall (m :: * -> *).
Monad m =>
(ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout ParaElem -> m ParaElem
f (MetadataSlide [ParaElem]
title [ParaElem]
subtitle [[ParaElem]]
authors [ParaElem]
date) = do
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
subtitle' <- mapM f subtitle
authors' <- mapM (mapM f) authors
date' <- mapM f date
return $ MetadataSlide title' subtitle' authors' 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
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
content' <- mapM (applyToShape f) content
return $ ContentSlide hdr' content'
applyToLayout ParaElem -> m ParaElem
f (TwoColumnSlide [ParaElem]
hdr [Shape]
contentL [Shape]
contentR) = do
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
contentL' <- mapM (applyToShape f) contentL
contentR' <- mapM (applyToShape f) contentR
return $ TwoColumnSlide hdr' contentL' contentR'
applyToLayout ParaElem -> m ParaElem
f (ComparisonSlide [ParaElem]
hdr ([Shape]
contentL1, [Shape]
contentL2) ([Shape]
contentR1, [Shape]
contentR2)) = do
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
contentL1' <- mapM (applyToShape f) contentL1
contentL2' <- mapM (applyToShape f) contentL2
contentR1' <- mapM (applyToShape f) contentR1
contentR2' <- mapM (applyToShape f) contentR2
return $ ComparisonSlide hdr' (contentL1', contentL2') (contentR1', contentR2')
applyToLayout ParaElem -> m ParaElem
f (ContentWithCaptionSlide [ParaElem]
hdr [Shape]
textShapes [Shape]
contentShapes) = do
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
textShapes' <- mapM (applyToShape f) textShapes
contentShapes' <- mapM (applyToShape f) contentShapes
return $ ContentWithCaptionSlide hdr' textShapes' 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' <- (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 = SpeakerNotes -> [Paragraph]
fromSpeakerNotes (SpeakerNotes -> [Paragraph]) -> SpeakerNotes -> [Paragraph]
forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide
notes' <- SpeakerNotes <$> mapM (applyToParagraph f) paras
return slide{slideLayout = layout', slideSpeakerNotes = notes'}
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor (Run RunProps
rProps Text
s)
| Just (ExternalTarget (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
anchor), Text
_)) <- RunProps -> Maybe LinkTarget
rLink RunProps
rProps
= do
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' = case Text -> Map Text SlideId -> Maybe SlideId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
anchor Map Text SlideId
anchorMap of
Just SlideId
n -> RunProps
rProps{rLink = Just $ InternalTarget n}
Maybe SlideId
Nothing -> RunProps
rProps{rLink = Nothing}
return $ Run rProps' 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
opts <- (WriterEnv -> WriterOptions)
-> ReaderT WriterEnv (State WriterState) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> WriterOptions
envOpts
mbMetadataSlide <- getMetaSlide
(metadataslides, blks') <- case mbMetadataSlide of
Just Slide
sld ->
do (s, bs) <- Slide -> [Block] -> Pres (Slide, [Block])
addSpeakerNotesToMetaSlide Slide
sld [Block]
blks
return ([s], 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)
blksLst <- splitBlocks blks'
bodySlideIds <- 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)
(take (length blksLst) [1..] :: [Integer])
bodyslides <- mapM
(\([Block]
bs, SlideId
ident) ->
(WriterEnv -> WriterEnv) -> Pres Slide -> Pres Slide
forall a.
(WriterEnv -> WriterEnv)
-> ReaderT WriterEnv (State WriterState) a
-> ReaderT WriterEnv (State WriterState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnv
st -> WriterEnv
st{envCurSlideId = ident}) ([Block] -> Pres Slide
blocksToSlide [Block]
bs))
(zip blksLst bodySlideIds)
endNotesSlideBlocks <- makeEndNotesSlideBlocks
tocSlides <- if writerTableOfContents opts
then do toc <- makeTOCSlide $ blks' ++ endNotesSlideBlocks
return [toc]
else return []
endNotesSlides <- if null endNotesSlideBlocks
then return []
else do endNotesSlide <- local
(\WriterEnv
env -> WriterEnv
env { envCurSlideId = endNotesSlideId
, envInNoteSlide = True
})
(blocksToSlide endNotesSlideBlocks)
return [endNotesSlide]
let 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 -> 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
mapM (applyToSlide replaceAnchor) slides'
metaToDocProps :: Meta -> DocProps
metaToDocProps :: Meta -> DocProps
metaToDocProps Meta
meta =
let keywords :: Maybe [Text]
keywords = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"keywords" Meta
meta of
Just (MetaList [MetaValue]
xs) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ (MetaValue -> Text) -> [MetaValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify [MetaValue]
xs
Maybe MetaValue
_ -> Maybe [Text]
forall a. Maybe a
Nothing
authors :: Maybe Text
authors = case ([Inline] -> Text) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify ([[Inline]] -> [Text]) -> [[Inline]] -> [Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta of
[] -> Maybe Text
forall a. Maybe a
Nothing
[Text]
ss -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
ss
description :: Maybe Text
description = case (Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Block]
lookupMetaBlocks Text
"description" Meta
meta of
[] -> Maybe Text
forall a. Maybe a
Nothing
[Text]
ss -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"_x000d_\n" [Text]
ss
customProperties' :: Maybe [(Text, Text)]
customProperties' = case [(Text
k, Text -> Meta -> Text
lookupMetaString Text
k Meta
meta) | Text
k <- Map Text MetaValue -> [Text]
forall k a. Map k a -> [k]
M.keys (Meta -> Map Text MetaValue
unMeta Meta
meta)
, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"title", Text
"author", Text
"keywords", Text
"description"
, Text
"subject",Text
"lang",Text
"category"]] of
[] -> Maybe [(Text, Text)]
forall a. Maybe a
Nothing
[(Text, Text)]
ss -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text, Text)]
ss
in
DocProps{ dcTitle :: Maybe Text
dcTitle = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"title" Meta
meta
, dcSubject :: Maybe Text
dcSubject = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"subject" Meta
meta
, dcCreator :: Maybe Text
dcCreator = Maybe Text
authors
, dcKeywords :: Maybe [Text]
dcKeywords = Maybe [Text]
keywords
, dcDescription :: Maybe Text
dcDescription = Maybe Text
description
, cpCategory :: Maybe Text
cpCategory = MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (MetaValue -> Text) -> Maybe MetaValue -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Meta -> Maybe MetaValue
lookupMeta Text
"category" Meta
meta
, dcDate :: Maybe Text
dcDate =
let t :: Text
t = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify (Meta -> [Inline]
docDate Meta
meta)
in if Text -> Bool
T.null Text
t
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
, customProperties :: Maybe [(Text, Text)]
customProperties = Maybe [(Text, Text)]
customProperties'
}
documentToPresentation :: WriterOptions
-> Pandoc
-> (Presentation, [LogMessage])
documentToPresentation :: WriterOptions -> Pandoc -> (Presentation, [LogMessage])
documentToPresentation WriterOptions
opts (Pandoc Meta
meta [Block]
blks) =
let env :: WriterEnv
env = WriterEnv
forall a. Default a => a
def { envOpts = opts
, envMetadata = meta
, envSlideLevel = fromMaybe (getSlideLevel blks) (writerSlideLevel opts)
}
([Slide]
presSlides, [LogMessage]
msgs) = WriterEnv -> WriterState -> Pres [Slide] -> ([Slide], [LogMessage])
forall a. WriterEnv -> WriterState -> Pres a -> (a, [LogMessage])
runPres WriterEnv
env WriterState
forall a. Default a => a
def (Pres [Slide] -> ([Slide], [LogMessage]))
-> Pres [Slide] -> ([Slide], [LogMessage])
forall a b. (a -> b) -> a -> b
$ [Block] -> Pres [Slide]
blocksToPresentationSlides [Block]
blks
docProps :: DocProps
docProps = Meta -> DocProps
metaToDocProps Meta
meta
in
(DocProps -> [Slide] -> Presentation
Presentation DocProps
docProps [Slide]
presSlides, [LogMessage]
msgs)
applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps :: TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps =
RunProps
rProps{ rSolidFill = tokenColor tokSty <|> rSolidFill rProps
, rPropBold = tokenBold tokSty || rPropBold rProps
, rPropItalics = tokenItalic tokSty || rPropItalics rProps
, rPropUnderline = tokenUnderline tokSty || rPropUnderline rProps
}
formatToken :: Style -> Token -> ParaElem
formatToken :: Style -> Token -> ParaElem
formatToken Style
sty (TokenType
tokType, Text
txt) =
let rProps :: RunProps
rProps = RunProps
forall a. Default a => a
def{rPropCode = True, rSolidFill = defaultColor sty}
rProps' :: RunProps
rProps' = case TokenType -> Map TokenType TokenStyle -> Maybe TokenStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TokenType
tokType (Style -> Map TokenType TokenStyle
tokenStyles Style
sty) of
Just TokenStyle
tokSty -> TokenStyle -> RunProps -> RunProps
applyTokStyToRunProps TokenStyle
tokSty RunProps
rProps
Maybe TokenStyle
Nothing -> RunProps
rProps
in
RunProps -> Text -> ParaElem
Run RunProps
rProps' Text
txt
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine :: Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
_ SourceLine
srcLn = (Token -> ParaElem) -> SourceLine -> [ParaElem]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> Token -> ParaElem
formatToken Style
sty) SourceLine
srcLn
formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines :: Style -> FormatOptions -> [SourceLine] -> [ParaElem]
formatSourceLines Style
sty FormatOptions
opts [SourceLine]
srcLns = [ParaElem] -> [[ParaElem]] -> [ParaElem]
forall a. [a] -> [[a]] -> [a]
intercalate [ParaElem
Break] ([[ParaElem]] -> [ParaElem]) -> [[ParaElem]] -> [ParaElem]
forall a b. (a -> b) -> a -> b
$
(SourceLine -> [ParaElem]) -> [SourceLine] -> [[ParaElem]]
forall a b. (a -> b) -> [a] -> [b]
map (Style -> FormatOptions -> SourceLine -> [ParaElem]
formatSourceLine Style
sty FormatOptions
opts) [SourceLine]
srcLns