-- | Read a presentation from disk.
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Patat.Presentation.Read
    ( readPresentation

      -- Exposed for testing mostly.
    , 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
    -- We need to read the settings first.
    (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
..}


--------------------------------------------------------------------------------
-- | This re-parses the pandoc metadata block using the YAML library.  This
-- avoids the problems caused by pandoc involving rendering Markdown.  This
-- should only be used for settings though, not things like title / authors
-- since those /can/ contain markdown.
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


--------------------------------------------------------------------------------
-- | Read settings from the metadata block in the Pandoc document.
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


--------------------------------------------------------------------------------
-- | Read settings from "$HOME/.patat.yaml".
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"


--------------------------------------------------------------------------------
-- | Read settings from "$XDG_CONFIG_DIRECTORY/patat/config.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


--------------------------------------------------------------------------------
-- | Read settings from the specified path, if it exists.
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)
        }


--------------------------------------------------------------------------------
-- | Find level of header that starts slides.  This is defined as the least
-- header that occurs before a non-header in the blocks.
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


--------------------------------------------------------------------------------
-- | Split a pandoc document into slides.  If the document contains horizonal
-- rules, we use those as slide delimiters.  If there are no horizontal rules,
-- we split using headers, determined by the slide level (see
-- 'detectSlideLevel').
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
_,  [])  -> [] -- Never create empty slides
        (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