-- | 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.Extended            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           Data.Traversable               (for)
import qualified Data.Yaml                      as Yaml
import           Patat.EncodingFallback         (EncodingFallback)
import qualified Patat.EncodingFallback         as EncodingFallback
import qualified Patat.Eval                     as Eval
import qualified Patat.Presentation.Comments    as Comments
import           Patat.Presentation.Fragment
import qualified Patat.Presentation.Instruction as Instruction
import           Patat.Presentation.Instruction (VarGen)
import           Patat.Presentation.Internal
import           Patat.Transition               (parseTransitionSettings)
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 :: VarGen -> FilePath -> IO (Either String Presentation)
readPresentation :: VarGen -> [Char] -> IO (Either [Char] Presentation)
readPresentation VarGen
varGen [Char]
filePath = ExceptT [Char] IO Presentation -> IO (Either [Char] Presentation)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO Presentation -> IO (Either [Char] Presentation))
-> ExceptT [Char] IO Presentation
-> IO (Either [Char] Presentation)
forall a b. (a -> b) -> a -> b
$ do
    -- We need to read the settings first.
    (EncodingFallback
enc, Text
src)   <- IO (EncodingFallback, Text)
-> ExceptT [Char] IO (EncodingFallback, Text)
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EncodingFallback, Text)
 -> ExceptT [Char] IO (EncodingFallback, Text))
-> IO (EncodingFallback, Text)
-> ExceptT [Char] IO (EncodingFallback, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (EncodingFallback, Text)
EncodingFallback.readFile [Char]
filePath
    PresentationSettings
homeSettings <- IO (Either [Char] PresentationSettings)
-> ExceptT [Char] IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either [Char] PresentationSettings)
readHomeSettings
    PresentationSettings
xdgSettings  <- IO (Either [Char] PresentationSettings)
-> ExceptT [Char] IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either [Char] PresentationSettings)
readXdgSettings
    PresentationSettings
metaSettings <- IO (Either [Char] PresentationSettings)
-> ExceptT [Char] IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] PresentationSettings)
 -> ExceptT [Char] IO PresentationSettings)
-> IO (Either [Char] PresentationSettings)
-> ExceptT [Char] IO PresentationSettings
forall a b. (a -> b) -> a -> b
$ Either [Char] PresentationSettings
-> IO (Either [Char] PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] PresentationSettings
 -> IO (Either [Char] PresentationSettings))
-> Either [Char] PresentationSettings
-> IO (Either [Char] PresentationSettings)
forall a b. (a -> b) -> a -> b
$ Text -> Either [Char] PresentationSettings
readMetaSettings Text
src
    let settings :: PresentationSettings
settings =
            PresentationSettings
metaSettings PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<>
            PresentationSettings
xdgSettings  PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<>
            PresentationSettings
homeSettings PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<>
            PresentationSettings
defaultPresentationSettings

    SyntaxMap
syntaxMap <- IO (Either [Char] SyntaxMap) -> ExceptT [Char] IO SyntaxMap
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] SyntaxMap) -> ExceptT [Char] IO SyntaxMap)
-> IO (Either [Char] SyntaxMap) -> ExceptT [Char] IO SyntaxMap
forall a b. (a -> b) -> a -> b
$ [[Char]] -> IO (Either [Char] SyntaxMap)
readSyntaxMap ([[Char]] -> IO (Either [Char] SyntaxMap))
-> [[Char]] -> IO (Either [Char] SyntaxMap)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
        PresentationSettings -> Maybe [[Char]]
psSyntaxDefinitions PresentationSettings
settings
    let pexts :: ExtensionList
pexts = ExtensionList -> Maybe ExtensionList -> ExtensionList
forall a. a -> Maybe a -> a
fromMaybe ExtensionList
defaultExtensionList (PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
settings)
    Text -> Either PandocError Pandoc
reader <- case ExtensionList
-> [Char] -> Maybe (Text -> Either PandocError Pandoc)
readExtension ExtensionList
pexts [Char]
ext of
        Maybe (Text -> Either PandocError Pandoc)
Nothing -> [Char] -> ExceptT [Char] IO (Text -> Either PandocError Pandoc)
forall a. [Char] -> ExceptT [Char] IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] IO (Text -> Either PandocError Pandoc))
-> [Char] -> ExceptT [Char] IO (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown file extension: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
ext
        Just Text -> Either PandocError Pandoc
x  -> (Text -> Either PandocError Pandoc)
-> ExceptT [Char] IO (Text -> Either PandocError Pandoc)
forall a. a -> ExceptT [Char] IO a
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 -> [Char] -> ExceptT [Char] IO Pandoc
forall a. [Char] -> ExceptT [Char] IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] IO Pandoc)
-> [Char] -> ExceptT [Char] IO Pandoc
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not parse document: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PandocError -> [Char]
forall a. Show a => a -> [Char]
show PandocError
e
        Right Pandoc
x -> Pandoc -> ExceptT [Char] IO Pandoc
forall a. a -> ExceptT [Char] IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x

    Presentation
pres <- IO (Either [Char] Presentation) -> ExceptT [Char] IO Presentation
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] Presentation) -> ExceptT [Char] IO Presentation)
-> IO (Either [Char] Presentation)
-> ExceptT [Char] IO Presentation
forall a b. (a -> b) -> a -> b
$ Either [Char] Presentation -> IO (Either [Char] Presentation)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] Presentation -> IO (Either [Char] Presentation))
-> Either [Char] Presentation -> IO (Either [Char] Presentation)
forall a b. (a -> b) -> a -> b
$
        VarGen
-> [Char]
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either [Char] Presentation
pandocToPresentation VarGen
varGen [Char]
filePath EncodingFallback
enc PresentationSettings
settings SyntaxMap
syntaxMap Pandoc
doc
    Presentation -> ExceptT [Char] IO Presentation
forall a. a -> ExceptT [Char] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Presentation -> ExceptT [Char] IO Presentation)
-> Presentation -> ExceptT [Char] IO Presentation
forall a b. (a -> b) -> a -> b
$ Presentation -> Presentation
Eval.parseEvalBlocks Presentation
pres
  where
    ext :: [Char]
ext = [Char] -> [Char]
takeExtension [Char]
filePath


--------------------------------------------------------------------------------
readSyntaxMap :: [FilePath] -> IO (Either String Skylighting.SyntaxMap)
readSyntaxMap :: [[Char]] -> IO (Either [Char] SyntaxMap)
readSyntaxMap =
    ExceptT [Char] IO SyntaxMap -> IO (Either [Char] SyntaxMap)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO SyntaxMap -> IO (Either [Char] SyntaxMap))
-> ([[Char]] -> ExceptT [Char] IO SyntaxMap)
-> [[Char]]
-> IO (Either [Char] SyntaxMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([Syntax] -> SyntaxMap)
-> ExceptT [Char] IO [Syntax] -> ExceptT [Char] IO SyntaxMap
forall a b. (a -> b) -> ExceptT [Char] IO a -> ExceptT [Char] IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Syntax -> SyntaxMap -> SyntaxMap)
-> SyntaxMap -> [Syntax] -> SyntaxMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Syntax -> SyntaxMap -> SyntaxMap
Skylighting.addSyntaxDefinition SyntaxMap
forall a. Monoid a => a
mempty) (ExceptT [Char] IO [Syntax] -> ExceptT [Char] IO SyntaxMap)
-> ([[Char]] -> ExceptT [Char] IO [Syntax])
-> [[Char]]
-> ExceptT [Char] IO SyntaxMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([Char] -> ExceptT [Char] IO Syntax)
-> [[Char]] -> ExceptT [Char] IO [Syntax]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IO (Either [Char] Syntax) -> ExceptT [Char] IO Syntax
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either [Char] Syntax) -> ExceptT [Char] IO Syntax)
-> ([Char] -> IO (Either [Char] Syntax))
-> [Char]
-> ExceptT [Char] IO Syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO (Either [Char] Syntax)
Skylighting.loadSyntaxFromFile)


--------------------------------------------------------------------------------
readExtension
    :: ExtensionList -> String
    -> Maybe (T.Text -> Either Pandoc.PandocError Pandoc.Pandoc)
readExtension :: ExtensionList
-> [Char] -> Maybe (Text -> Either PandocError Pandoc)
readExtension (ExtensionList Extensions
extensions) [Char]
fileExt = case [Char]
fileExt of
    [Char]
".markdown" -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".md"       -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mdown"    -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mdtext"   -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mdtxt"    -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mdwn"     -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mkd"      -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".mkdn"     -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".lhs"      -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
lhsOpts
    [Char]
""          -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
readerOpts
    [Char]
".org"      -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readOrg      ReaderOptions
readerOpts
    [Char]
".txt"      -> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a. a -> Maybe a
Just ((Text -> Either PandocError Pandoc)
 -> Maybe (Text -> Either PandocError Pandoc))
-> (Text -> Either PandocError Pandoc)
-> Maybe (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ Pandoc -> Either PandocError Pandoc
forall a. a -> Either PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pandoc -> Either PandocError Pandoc)
-> (Text -> Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pandoc
Pandoc.readPlainText
    [Char]
_           -> Maybe (Text -> Either PandocError Pandoc)
forall a. Maybe a
Nothing

  where
    readerOpts :: ReaderOptions
readerOpts = ReaderOptions
forall a. Default a => a
Pandoc.def
        { Pandoc.readerExtensions =
            extensions <> absolutelyRequiredExtensions
        }

    lhsOpts :: ReaderOptions
lhsOpts = ReaderOptions
readerOpts
        { Pandoc.readerExtensions =
            Pandoc.readerExtensions readerOpts <>
            Pandoc.extensionsFromList [Pandoc.Ext_literate_haskell]
        }

    absolutelyRequiredExtensions :: Extensions
absolutelyRequiredExtensions =
        [Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_yaml_metadata_block]


--------------------------------------------------------------------------------
pandocToPresentation
    :: VarGen -> FilePath -> EncodingFallback -> PresentationSettings
    -> Skylighting.SyntaxMap -> Pandoc.Pandoc -> Either String Presentation
pandocToPresentation :: VarGen
-> [Char]
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either [Char] Presentation
pandocToPresentation VarGen
pVarGen [Char]
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 (Text -> Inline)
-> (([Char], [Char]) -> Text) -> ([Char], [Char]) -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd (([Char], [Char]) -> Inline) -> ([Char], [Char]) -> Inline
forall a b. (a -> b) -> a -> b
$ [Char] -> ([Char], [Char])
splitFileName [Char]
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         = [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Meta -> [[Inline]]
Pandoc.docAuthors Meta
meta)
        !pEvalBlocks :: EvalBlocks
pEvalBlocks     = EvalBlocks
forall a. Monoid a => a
mempty
        !pVars :: HashMap Var [Block]
pVars           = HashMap Var [Block]
forall a. Monoid a => a
mempty
    Seq PresentationSettings
pSlideSettings <- (Int -> Slide -> Either [Char] PresentationSettings)
-> Seq Slide -> Either [Char] (Seq PresentationSettings)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
Seq.traverseWithIndex
        (\Int
i ->
            ([Char] -> [Char])
-> Either [Char] PresentationSettings
-> Either [Char] PresentationSettings
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\[Char]
err -> [Char]
"on slide " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err) (Either [Char] PresentationSettings
 -> Either [Char] PresentationSettings)
-> (Slide -> Either [Char] PresentationSettings)
-> Slide
-> Either [Char] PresentationSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Comment -> Either [Char] PresentationSettings
Comments.parseSlideSettings (Comment -> Either [Char] PresentationSettings)
-> (Slide -> Comment)
-> Slide
-> Either [Char] PresentationSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slide -> Comment
slideComment)
        Seq Slide
pSlides
    Seq (Maybe TransitionGen)
pTransitionGens <- Seq PresentationSettings
-> (PresentationSettings -> Either [Char] (Maybe TransitionGen))
-> Either [Char] (Seq (Maybe TransitionGen))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Seq PresentationSettings
pSlideSettings ((PresentationSettings -> Either [Char] (Maybe TransitionGen))
 -> Either [Char] (Seq (Maybe TransitionGen)))
-> (PresentationSettings -> Either [Char] (Maybe TransitionGen))
-> Either [Char] (Seq (Maybe TransitionGen))
forall a b. (a -> b) -> a -> b
$ \PresentationSettings
slideSettings ->
        case PresentationSettings -> Maybe TransitionSettings
psTransition (PresentationSettings
slideSettings PresentationSettings
-> PresentationSettings -> PresentationSettings
forall a. Semigroup a => a -> a -> a
<> PresentationSettings
pSettings) of
            Maybe TransitionSettings
Nothing -> Maybe TransitionGen -> Either [Char] (Maybe TransitionGen)
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TransitionGen
forall a. Maybe a
Nothing
            Just TransitionSettings
ts -> TransitionGen -> Maybe TransitionGen
forall a. a -> Maybe a
Just (TransitionGen -> Maybe TransitionGen)
-> Either [Char] TransitionGen
-> Either [Char] (Maybe TransitionGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransitionSettings -> Either [Char] TransitionGen
parseTransitionSettings TransitionSettings
ts
    Presentation -> Either [Char] Presentation
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return Presentation {[Char]
[Inline]
(Int, Int)
HashMap Var [Block]
EvalBlocks
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
VarGen
PresentationSettings
pVarGen :: VarGen
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pSettings :: PresentationSettings
pSyntaxMap :: SyntaxMap
pTitle :: [Inline]
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pActiveFragment :: (Int, Int)
pAuthor :: [Inline]
pEvalBlocks :: EvalBlocks
pVars :: HashMap Var [Block]
pSlideSettings :: Seq PresentationSettings
pTransitionGens :: Seq (Maybe TransitionGen)
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pSlideSettings :: Seq PresentationSettings
pTransitionGens :: Seq (Maybe TransitionGen)
pActiveFragment :: (Int, Int)
pSyntaxMap :: SyntaxMap
pEvalBlocks :: EvalBlocks
pVarGen :: VarGen
pVars :: HashMap Var [Block]
..}


--------------------------------------------------------------------------------
-- | 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 [Char] Value)
parseMetadataBlock Text
src = case Text -> [Text]
T.lines Text
src of
    (Text
"---" : [Text]
ls) -> case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"---", Text
"..."]) [Text]
ls of
        ([Text]
_,     [])      -> Maybe (Either [Char] Value)
forall a. Maybe a
Nothing
        ([Text]
block, (Text
_ : [Text]
_)) -> Either [Char] Value -> Maybe (Either [Char] Value)
forall a. a -> Maybe a
Just (Either [Char] Value -> Maybe (Either [Char] Value))
-> ([Text] -> Either [Char] Value)
-> [Text]
-> Maybe (Either [Char] Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> [Char])
-> Either ParseException Value -> Either [Char] Value
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> [Char]
Yaml.prettyPrintParseException (Either ParseException Value -> Either [Char] Value)
-> ([Text] -> Either ParseException Value)
-> [Text]
-> Either [Char] Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> Either ParseException Value)
-> ([Text] -> ByteString) -> [Text] -> Either ParseException Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Maybe (Either [Char] Value))
-> [Text] -> Maybe (Either [Char] Value)
forall a b. (a -> b) -> a -> b
$! [Text]
block
    [Text]
_            -> Maybe (Either [Char] Value)
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- | Read settings from the metadata block in the Pandoc document.
readMetaSettings :: T.Text -> Either String PresentationSettings
readMetaSettings :: Text -> Either [Char] PresentationSettings
readMetaSettings Text
src = case Text -> Maybe (Either [Char] Value)
parseMetadataBlock Text
src of
    Maybe (Either [Char] Value)
Nothing -> PresentationSettings -> Either [Char] PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty
    Just (Left [Char]
err) -> [Char] -> Either [Char] PresentationSettings
forall a b. a -> Either a b
Left [Char]
err
    Just (Right (A.Object Object
obj)) | Just Value
val <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"patat" Object
obj ->
       ([Char] -> [Char])
-> Either [Char] PresentationSettings
-> Either [Char] PresentationSettings
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\[Char]
err -> [Char]
"Error parsing patat settings from metadata: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err) (Either [Char] PresentationSettings
 -> Either [Char] PresentationSettings)
-> Either [Char] PresentationSettings
-> Either [Char] PresentationSettings
forall a b. (a -> b) -> a -> b
$!
       Result PresentationSettings -> Either [Char] PresentationSettings
forall a. Result a -> Either [Char] a
A.resultToEither (Result PresentationSettings -> Either [Char] PresentationSettings)
-> Result PresentationSettings
-> Either [Char] PresentationSettings
forall a b. (a -> b) -> a -> b
$! Value -> Result PresentationSettings
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
val
    Just (Right Value
_) -> PresentationSettings -> Either [Char] PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
-- | Read settings from "$HOME/.patat.yaml".
readHomeSettings :: IO (Either String PresentationSettings)
readHomeSettings :: IO (Either [Char] PresentationSettings)
readHomeSettings = do
    [Char]
home <- IO [Char]
getHomeDirectory
    [Char] -> IO (Either [Char] PresentationSettings)
readSettings ([Char] -> IO (Either [Char] PresentationSettings))
-> [Char] -> IO (Either [Char] PresentationSettings)
forall a b. (a -> b) -> a -> b
$ [Char]
home [Char] -> [Char] -> [Char]
</> [Char]
".patat.yaml"


--------------------------------------------------------------------------------
-- | Read settings from "$XDG_CONFIG_DIRECTORY/patat/config.yaml".
readXdgSettings :: IO (Either String PresentationSettings)
readXdgSettings :: IO (Either [Char] PresentationSettings)
readXdgSettings =
    XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig ([Char]
"patat" [Char] -> [Char] -> [Char]
</> [Char]
"config.yaml") IO [Char]
-> ([Char] -> IO (Either [Char] PresentationSettings))
-> IO (Either [Char] PresentationSettings)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO (Either [Char] PresentationSettings)
readSettings


--------------------------------------------------------------------------------
-- | Read settings from the specified path, if it exists.
readSettings :: FilePath -> IO (Either String PresentationSettings)
readSettings :: [Char] -> IO (Either [Char] PresentationSettings)
readSettings [Char]
path = do
    Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
path
    if Bool -> Bool
not Bool
exists
        then Either [Char] PresentationSettings
-> IO (Either [Char] PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PresentationSettings -> Either [Char] PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty)
        else do
            Either ParseException PresentationSettings
errOrPs <- [Char] -> IO (Either ParseException PresentationSettings)
forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Yaml.decodeFileEither [Char]
path
            Either [Char] PresentationSettings
-> IO (Either [Char] PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] PresentationSettings
 -> IO (Either [Char] PresentationSettings))
-> Either [Char] PresentationSettings
-> IO (Either [Char] PresentationSettings)
forall a b. (a -> b) -> a -> b
$! case Either ParseException PresentationSettings
errOrPs of
                Left  ParseException
err -> [Char] -> Either [Char] PresentationSettings
forall a b. a -> Either a b
Left (ParseException -> [Char]
forall a. Show a => a -> [Char]
show ParseException
err)
                Right PresentationSettings
ps  -> PresentationSettings -> Either [Char] PresentationSettings
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   = Int -> Maybe Int -> Int
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   = (Slide -> Slide) -> [Slide] -> [Slide]
forall a b. (a -> b) -> [a] -> [b]
map Slide -> Slide
fragmentSlide [Slide]
unfragmented in
    [Slide] -> Seq Slide
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 = ContentSlide instrs1}

    fragmentSettings :: FragmentSettings
fragmentSettings = FragmentSettings
        { fsIncrementalLists :: Bool
fsIncrementalLists = Bool -> Maybe Bool -> Bool
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 ([Block] -> Int) -> [Block] -> Int
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
Comments.remove [Block]
blocks0
  where
    go :: Int -> [Block] -> Int
go Int
level (Pandoc.Header Int
n Attr
_ [Inline]
_ : Block
x : [Block]
xs)
        | Int
n Int -> Int -> Bool
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
xBlock -> [Block] -> [Block]
forall 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)
    | (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Block -> Block -> Bool
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] -> (Comment, [Block])
Comments.partition [Block]
bs0 of
        (Comment
_,  [])  -> [] -- Never create empty slides
        (Comment
sn, [Block]
bs1) -> Slide -> [Slide]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Slide -> [Slide])
-> (Instructions Block -> Slide) -> Instructions Block -> [Slide]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SlideContent -> Slide
Slide Comment
sn (SlideContent -> Slide)
-> (Instructions Block -> SlideContent)
-> Instructions Block
-> Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instructions Block -> SlideContent
ContentSlide (Instructions Block -> [Slide]) -> Instructions Block -> [Slide]
forall a b. (a -> b) -> a -> b
$
            [Instruction Block] -> Instructions Block
forall a. [Instruction a] -> Instructions a
Instruction.fromList [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Instruction.Append [Block]
bs1]

    splitAtRules :: [Block] -> [Slide]
splitAtRules [Block]
blocks = case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Block -> Block -> Bool
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 [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Block] -> [Slide]
splitAtRules [Block]
ys

    splitAtHeaders :: [Block] -> [Block] -> [Slide]
splitAtHeaders [Block]
acc [] =
        [Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc)
    splitAtHeaders [Block]
acc (b :: Block
b@(Pandoc.Header Int
i Attr
_ [Inline]
txt) : [Block]
bs0)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
slideLevel  = [Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs0
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
slideLevel =
            [Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc) [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++ [Block] -> [Block] -> [Slide]
splitAtHeaders [Block
b] [Block]
bs0
        | Bool
otherwise       =
            let (Comment
sn, [Block]
bs1) = [Block] -> (Comment, [Block])
Comments.split [Block]
bs0 in
            [Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc) [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++
            [Comment -> SlideContent -> Slide
Slide Comment
sn (SlideContent -> Slide) -> SlideContent -> Slide
forall a b. (a -> b) -> a -> b
$ Int -> [Inline] -> SlideContent
TitleSlide Int
i [Inline]
txt] [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++
            [Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
bs1
    splitAtHeaders [Block]
acc (Block
b : [Block]
bs) =
        [Block] -> [Block] -> [Slide]
splitAtHeaders (Block
b Block -> [Block] -> [Block]
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 [] (Seq SlideContent -> Seq Breadcrumbs)
-> (Seq Slide -> Seq SlideContent) -> Seq Slide -> Seq Breadcrumbs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slide -> SlideContent) -> Seq Slide -> Seq SlideContent
forall a b. (a -> b) -> Seq a -> Seq b
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 Seq SlideContent -> ViewL SlideContent
forall a. Seq a -> ViewL a
Seq.viewl Seq SlideContent
slides0 of
        ViewL SlideContent
Seq.EmptyL -> Seq Breadcrumbs
forall a. Seq a
Seq.empty
        ContentSlide Instructions Block
_ Seq.:< Seq SlideContent
slides ->
            Breadcrumbs
breadcrumbs Breadcrumbs -> Seq Breadcrumbs -> Seq 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 = ((Int, [Inline]) -> Bool) -> Breadcrumbs -> Breadcrumbs
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lvl) (Int -> Bool)
-> ((Int, [Inline]) -> Int) -> (Int, [Inline]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Inline]) -> Int
forall a b. (a, b) -> a
fst) Breadcrumbs
breadcrumbs in
            Breadcrumbs
parent Breadcrumbs -> Seq Breadcrumbs -> Seq Breadcrumbs
forall a. a -> Seq a -> Seq a
`Seq.cons` Breadcrumbs -> Seq SlideContent -> Seq Breadcrumbs
go (Breadcrumbs
parent Breadcrumbs -> Breadcrumbs -> Breadcrumbs
forall a. [a] -> [a] -> [a]
++ [(Int
lvl, [Inline]
inlines)]) Seq SlideContent
slides