{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Patat.Presentation.Read
( readPresentation
, detectSlideLevel
, readMetaSettings
) where
import Control.Monad.Except (ExceptT (..), runExceptT,
throwError)
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as AKM
import Data.Bifunctor (first)
import Data.Maybe (fromMaybe)
import Data.Sequence.Extended (Seq)
import qualified Data.Sequence.Extended as Seq
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Yaml as Yaml
import Patat.EncodingFallback (EncodingFallback)
import qualified Patat.EncodingFallback as EncodingFallback
import Patat.Eval (eval)
import Patat.Presentation.Fragment
import qualified Patat.Presentation.Instruction as Instruction
import Patat.Presentation.Internal
import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes
import Prelude
import qualified Skylighting as Skylighting
import System.Directory (XdgDirectory (XdgConfig),
doesFileExist,
getHomeDirectory,
getXdgDirectory)
import System.FilePath (splitFileName, takeExtension,
(</>))
import qualified Text.Pandoc.Error as Pandoc
import qualified Text.Pandoc.Extended as Pandoc
readPresentation :: FilePath -> IO (Either String Presentation)
readPresentation :: String -> IO (Either String Presentation)
readPresentation String
filePath = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
(EncodingFallback
enc, Text
src) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (EncodingFallback, Text)
EncodingFallback.readFile String
filePath
PresentationSettings
homeSettings <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either String PresentationSettings)
readHomeSettings
PresentationSettings
xdgSettings <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either String PresentationSettings)
readXdgSettings
PresentationSettings
metaSettings <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Either String PresentationSettings
readMetaSettings Text
src
let settings :: PresentationSettings
settings =
PresentationSettings
metaSettings forall a. Semigroup a => a -> a -> a
<>
PresentationSettings
xdgSettings forall a. Semigroup a => a -> a -> a
<>
PresentationSettings
homeSettings forall a. Semigroup a => a -> a -> a
<>
PresentationSettings
defaultPresentationSettings
SyntaxMap
syntaxMap <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ [String] -> IO (Either String SyntaxMap)
readSyntaxMap forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$
PresentationSettings -> Maybe [String]
psSyntaxDefinitions PresentationSettings
settings
let pexts :: ExtensionList
pexts = forall a. a -> Maybe a -> a
fromMaybe ExtensionList
defaultExtensionList (PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
settings)
Text -> Either PandocError Pandoc
reader <- case ExtensionList
-> String -> Maybe (Text -> Either PandocError Pandoc)
readExtension ExtensionList
pexts String
ext of
Maybe (Text -> Either PandocError Pandoc)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"Unknown file extension: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
ext
Just Text -> Either PandocError Pandoc
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Text -> Either PandocError Pandoc
x
Pandoc
doc <- case Text -> Either PandocError Pandoc
reader Text
src of
Left PandocError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String
"Could not parse document: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PandocError
e
Right Pandoc
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x
Presentation
pres <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
String
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either String Presentation
pandocToPresentation String
filePath EncodingFallback
enc PresentationSettings
settings SyntaxMap
syntaxMap Pandoc
doc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Presentation -> IO Presentation
eval Presentation
pres
where
ext :: String
ext = String -> String
takeExtension String
filePath
readSyntaxMap :: [FilePath] -> IO (Either String Skylighting.SyntaxMap)
readSyntaxMap :: [String] -> IO (Either String SyntaxMap)
readSyntaxMap =
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Syntax -> SyntaxMap -> SyntaxMap
Skylighting.addSyntaxDefinition forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Either String Syntax)
Skylighting.loadSyntaxFromFile)
readExtension
:: ExtensionList -> String
-> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc)
readExtension :: ExtensionList
-> String -> Maybe (Text -> Either PandocError Pandoc)
readExtension (ExtensionList Extensions
extensions) String
fileExt = case String
fileExt of
String
".markdown" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".md" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdown" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdtext" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdtxt" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mdwn" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mkd" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".mkdn" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".lhs" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
lhsOpts
String
"" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
String
".org" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
Pandoc.runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readOrg ReaderOptions
readerOpts
String
".txt" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pandoc
Pandoc.readPlainText
String
_ -> forall a. Maybe a
Nothing
where
readerOpts :: ReaderOptions
readerOpts = forall a. Default a => a
Pandoc.def
{ readerExtensions :: Extensions
Pandoc.readerExtensions =
Extensions
extensions forall a. Semigroup a => a -> a -> a
<> Extensions
absolutelyRequiredExtensions
}
lhsOpts :: ReaderOptions
lhsOpts = ReaderOptions
readerOpts
{ readerExtensions :: Extensions
Pandoc.readerExtensions =
ReaderOptions -> Extensions
Pandoc.readerExtensions ReaderOptions
readerOpts forall a. Semigroup a => a -> a -> a
<>
[Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_literate_haskell]
}
absolutelyRequiredExtensions :: Extensions
absolutelyRequiredExtensions =
[Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_yaml_metadata_block]
pandocToPresentation
:: FilePath -> EncodingFallback -> PresentationSettings
-> Skylighting.SyntaxMap -> Pandoc.Pandoc -> Either String Presentation
pandocToPresentation :: String
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either String Presentation
pandocToPresentation String
pFilePath EncodingFallback
pEncodingFallback PresentationSettings
pSettings SyntaxMap
pSyntaxMap
pandoc :: Pandoc
pandoc@(Pandoc.Pandoc Meta
meta [Block]
_) = do
let !pTitle :: [Inline]
pTitle = case Meta -> [Inline]
Pandoc.docTitle Meta
meta of
[] -> [Text -> Inline
Pandoc.Str forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitFileName String
pFilePath]
[Inline]
title -> [Inline]
title
!pSlides :: Seq Slide
pSlides = PresentationSettings -> Pandoc -> Seq Slide
pandocToSlides PresentationSettings
pSettings Pandoc
pandoc
!pBreadcrumbs :: Seq Breadcrumbs
pBreadcrumbs = Seq Slide -> Seq Breadcrumbs
collectBreadcrumbs Seq Slide
pSlides
!pActiveFragment :: (Int, Int)
pActiveFragment = (Int
0, Int
0)
!pAuthor :: [Inline]
pAuthor = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Meta -> [[Inline]]
Pandoc.docAuthors Meta
meta)
forall (m :: * -> *) a. Monad m => a -> m a
return Presentation {String
[Inline]
(Int, Int)
SyntaxMap
Seq Breadcrumbs
Seq Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: SyntaxMap
pActiveFragment :: (Int, Int)
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: String
pAuthor :: [Inline]
pActiveFragment :: (Int, Int)
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pTitle :: [Inline]
pSyntaxMap :: SyntaxMap
pSettings :: PresentationSettings
pEncodingFallback :: EncodingFallback
pFilePath :: String
..}
parseMetadataBlock :: T.Text -> Maybe (Either String A.Value)
parseMetadataBlock :: Text -> Maybe (Either String Value)
parseMetadataBlock Text
src = case Text -> [Text]
T.lines Text
src of
(Text
"---" : [Text]
ls) -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"---", Text
"..."]) [Text]
ls of
([Text]
_, []) -> forall a. Maybe a
Nothing
([Text]
block, (Text
_ : [Text]
_)) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
Yaml.prettyPrintParseException forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$! [Text]
block
[Text]
_ -> forall a. Maybe a
Nothing
readMetaSettings :: T.Text -> Either String PresentationSettings
readMetaSettings :: Text -> Either String PresentationSettings
readMetaSettings Text
src = case Text -> Maybe (Either String Value)
parseMetadataBlock Text
src of
Maybe (Either String Value)
Nothing -> forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
Just (Left String
err) -> forall a b. a -> Either a b
Left String
err
Just (Right (A.Object Object
obj)) | Just Value
val <- forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"patat" Object
obj ->
forall a. Result a -> Either String a
resultToEither forall a b. (a -> b) -> a -> b
$! forall a. FromJSON a => Value -> Result a
A.fromJSON Value
val
Just (Right Value
_) -> forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
where
resultToEither :: A.Result a -> Either String a
resultToEither :: forall a. Result a -> Either String a
resultToEither (A.Success a
x) = forall a b. b -> Either a b
Right a
x
resultToEither (A.Error String
e) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$!
String
"Error parsing patat settings from metadata: " forall a. [a] -> [a] -> [a]
++ String
e
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings = do
String
home <- IO String
getHomeDirectory
String -> IO (Either String PresentationSettings)
readSettings forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
".patat.yaml"
readXdgSettings :: IO (Either String PresentationSettings)
readXdgSettings :: IO (Either String PresentationSettings)
readXdgSettings =
XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig (String
"patat" String -> String -> String
</> String
"config.yaml") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (Either String PresentationSettings)
readSettings
readSettings :: FilePath -> IO (Either String PresentationSettings)
readSettings :: String -> IO (Either String PresentationSettings)
readSettings String
path = do
Bool
exists <- String -> IO Bool
doesFileExist String
path
if Bool -> Bool
not Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty)
else do
Either ParseException PresentationSettings
errOrPs <- forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case Either ParseException PresentationSettings
errOrPs of
Left ParseException
err -> forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show ParseException
err)
Right PresentationSettings
ps -> forall a b. b -> Either a b
Right PresentationSettings
ps
pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> Seq.Seq Slide
pandocToSlides :: PresentationSettings -> Pandoc -> Seq Slide
pandocToSlides PresentationSettings
settings Pandoc
pandoc =
let slideLevel :: Int
slideLevel = forall a. a -> Maybe a -> a
fromMaybe (Pandoc -> Int
detectSlideLevel Pandoc
pandoc) (PresentationSettings -> Maybe Int
psSlideLevel PresentationSettings
settings)
unfragmented :: [Slide]
unfragmented = Int -> Pandoc -> [Slide]
splitSlides Int
slideLevel Pandoc
pandoc
fragmented :: [Slide]
fragmented = forall a b. (a -> b) -> [a] -> [b]
map Slide -> Slide
fragmentSlide [Slide]
unfragmented in
forall a. [a] -> Seq a
Seq.fromList [Slide]
fragmented
where
fragmentSlide :: Slide -> Slide
fragmentSlide Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
TitleSlide Int
_ [Inline]
_ -> Slide
slide
ContentSlide Instructions Block
instrs0 ->
let instrs1 :: Instructions Block
instrs1 = FragmentSettings -> Instructions Block -> Instructions Block
fragmentInstructions FragmentSettings
fragmentSettings Instructions Block
instrs0 in
Slide
slide {slideContent :: SlideContent
slideContent = Instructions Block -> SlideContent
ContentSlide Instructions Block
instrs1}
fragmentSettings :: FragmentSettings
fragmentSettings = FragmentSettings
{ fsIncrementalLists :: Bool
fsIncrementalLists = forall a. a -> Maybe a -> a
fromMaybe Bool
False (PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
settings)
}
detectSlideLevel :: Pandoc.Pandoc -> Int
detectSlideLevel :: Pandoc -> Int
detectSlideLevel (Pandoc.Pandoc Meta
_meta [Block]
blocks0) =
Int -> [Block] -> Int
go Int
6 forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
SpeakerNotes.remove [Block]
blocks0
where
go :: Int -> [Block] -> Int
go Int
level (Pandoc.Header Int
n Attr
_ [Inline]
_ : Block
x : [Block]
xs)
| Int
n forall a. Ord a => a -> a -> Bool
< Int
level Bool -> Bool -> Bool
&& Bool -> Bool
not (Block -> Bool
isHeader Block
x) = Int -> [Block] -> Int
go Int
n [Block]
xs
| Bool
otherwise = Int -> [Block] -> Int
go Int
level (Block
xforall a. a -> [a] -> [a]
:[Block]
xs)
go Int
level (Block
_ : [Block]
xs) = Int -> [Block] -> Int
go Int
level [Block]
xs
go Int
level [] = Int
level
isHeader :: Block -> Bool
isHeader (Pandoc.Header Int
_ Attr
_ [Inline]
_) = Bool
True
isHeader Block
_ = Bool
False
splitSlides :: Int -> Pandoc.Pandoc -> [Slide]
splitSlides :: Int -> Pandoc -> [Slide]
splitSlides Int
slideLevel (Pandoc.Pandoc Meta
_meta [Block]
blocks0)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Block
Pandoc.HorizontalRule) [Block]
blocks0 = [Block] -> [Slide]
splitAtRules [Block]
blocks0
| Bool
otherwise = [Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
blocks0
where
mkContentSlide :: [Pandoc.Block] -> [Slide]
mkContentSlide :: [Block] -> [Slide]
mkContentSlide [Block]
bs0 = case [Block] -> (SpeakerNotes, [Block])
SpeakerNotes.partition [Block]
bs0 of
(SpeakerNotes
_, []) -> []
(SpeakerNotes
sn, [Block]
bs1) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeakerNotes -> SlideContent -> Slide
Slide SpeakerNotes
sn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instructions Block -> SlideContent
ContentSlide forall a b. (a -> b) -> a -> b
$
forall a. [Instruction a] -> Instructions a
Instruction.fromList [forall a. [a] -> Instruction a
Instruction.Append [Block]
bs1]
splitAtRules :: [Block] -> [Slide]
splitAtRules [Block]
blocks = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Block
Pandoc.HorizontalRule) [Block]
blocks of
([Block]
xs, []) -> [Block] -> [Slide]
mkContentSlide [Block]
xs
([Block]
xs, (Block
_rule : [Block]
ys)) -> [Block] -> [Slide]
mkContentSlide [Block]
xs forall a. [a] -> [a] -> [a]
++ [Block] -> [Slide]
splitAtRules [Block]
ys
splitAtHeaders :: [Block] -> [Block] -> [Slide]
splitAtHeaders [Block]
acc [] =
[Block] -> [Slide]
mkContentSlide (forall a. [a] -> [a]
reverse [Block]
acc)
splitAtHeaders [Block]
acc (b :: Block
b@(Pandoc.Header Int
i Attr
_ [Inline]
txt) : [Block]
bs0)
| Int
i forall a. Ord a => a -> a -> Bool
> Int
slideLevel = [Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs0
| Int
i forall a. Eq a => a -> a -> Bool
== Int
slideLevel =
[Block] -> [Slide]
mkContentSlide (forall a. [a] -> [a]
reverse [Block]
acc) forall a. [a] -> [a] -> [a]
++ [Block] -> [Block] -> [Slide]
splitAtHeaders [Block
b] [Block]
bs0
| Bool
otherwise =
let (SpeakerNotes
sn, [Block]
bs1) = [Block] -> (SpeakerNotes, [Block])
SpeakerNotes.split [Block]
bs0 in
[Block] -> [Slide]
mkContentSlide (forall a. [a] -> [a]
reverse [Block]
acc) forall a. [a] -> [a] -> [a]
++
[SpeakerNotes -> SlideContent -> Slide
Slide SpeakerNotes
sn forall a b. (a -> b) -> a -> b
$ Int -> [Inline] -> SlideContent
TitleSlide Int
i [Inline]
txt] forall a. [a] -> [a] -> [a]
++
[Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
bs1
splitAtHeaders [Block]
acc (Block
b : [Block]
bs) =
[Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs
collectBreadcrumbs :: Seq Slide -> Seq Breadcrumbs
collectBreadcrumbs :: Seq Slide -> Seq Breadcrumbs
collectBreadcrumbs = Breadcrumbs -> Seq SlideContent -> Seq Breadcrumbs
go [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Slide -> SlideContent
slideContent
where
go :: Breadcrumbs -> Seq SlideContent -> Seq Breadcrumbs
go Breadcrumbs
breadcrumbs Seq SlideContent
slides0 = case forall a. Seq a -> ViewL a
Seq.viewl Seq SlideContent
slides0 of
ViewL SlideContent
Seq.EmptyL -> forall a. Seq a
Seq.empty
ContentSlide Instructions Block
_ Seq.:< Seq SlideContent
slides ->
Breadcrumbs
breadcrumbs forall a. a -> Seq a -> Seq a
`Seq.cons` Breadcrumbs -> Seq SlideContent -> Seq Breadcrumbs
go Breadcrumbs
breadcrumbs Seq SlideContent
slides
TitleSlide Int
lvl [Inline]
inlines Seq.:< Seq SlideContent
slides ->
let parent :: Breadcrumbs
parent = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
< Int
lvl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Breadcrumbs
breadcrumbs in
Breadcrumbs
parent forall a. a -> Seq a -> Seq a
`Seq.cons` Breadcrumbs -> Seq SlideContent -> Seq Breadcrumbs
go (Breadcrumbs
parent forall a. [a] -> [a] -> [a]
++ [(Int
lvl, [Inline]
inlines)]) Seq SlideContent
slides