-- | 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                   (guard)
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           Patat.Presentation.Fragment
import           Patat.Presentation.Internal
import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes
import           Patat.Presentation.Syntax
import           Patat.Transition                (parseTransitionSettings)
import           Patat.Unique
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 :: UniqueGen -> FilePath -> IO (Either String Presentation)
readPresentation :: UniqueGen -> String -> IO (Either String Presentation)
readPresentation UniqueGen
uniqueGen String
filePath = ExceptT String IO Presentation -> IO (Either String Presentation)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Presentation -> IO (Either String Presentation))
-> ExceptT String IO Presentation
-> IO (Either String Presentation)
forall a b. (a -> b) -> a -> b
$ do
    -- We need to read the settings first.
    (EncodingFallback
enc, Text
src)   <- IO (EncodingFallback, Text)
-> ExceptT String IO (EncodingFallback, Text)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EncodingFallback, Text)
 -> ExceptT String IO (EncodingFallback, Text))
-> IO (EncodingFallback, Text)
-> ExceptT String IO (EncodingFallback, Text)
forall a b. (a -> b) -> a -> b
$ String -> IO (EncodingFallback, Text)
EncodingFallback.readFile String
filePath
    PresentationSettings
homeSettings <- IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either String PresentationSettings)
readHomeSettings
    PresentationSettings
xdgSettings  <- IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT IO (Either String PresentationSettings)
readXdgSettings
    PresentationSettings
metaSettings <- IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String PresentationSettings)
 -> ExceptT String IO PresentationSettings)
-> IO (Either String PresentationSettings)
-> ExceptT String IO PresentationSettings
forall a b. (a -> b) -> a -> b
$ Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PresentationSettings
 -> IO (Either String PresentationSettings))
-> Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a b. (a -> b) -> a -> b
$ Text -> Either String 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 String SyntaxMap) -> ExceptT String IO SyntaxMap
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String SyntaxMap) -> ExceptT String IO SyntaxMap)
-> IO (Either String SyntaxMap) -> ExceptT String IO SyntaxMap
forall a b. (a -> b) -> a -> b
$ [String] -> IO (Either String SyntaxMap)
readSyntaxMap ([String] -> IO (Either String SyntaxMap))
-> [String] -> IO (Either String SyntaxMap)
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$
        PresentationSettings -> Maybe [String]
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
-> String -> Maybe (Text -> Either PandocError Pandoc)
readExtension ExtensionList
pexts String
ext of
        Maybe (Text -> Either PandocError Pandoc)
Nothing -> String -> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO (Text -> Either PandocError Pandoc))
-> String -> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ String
"Unknown file extension: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
ext
        Just Text -> Either PandocError Pandoc
x  -> (Text -> Either PandocError Pandoc)
-> ExceptT String IO (Text -> Either PandocError Pandoc)
forall a. a -> ExceptT String 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 -> String -> ExceptT String IO Pandoc
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO Pandoc)
-> String -> ExceptT String IO Pandoc
forall a b. (a -> b) -> a -> b
$ String
"Could not parse document: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PandocError -> String
forall a. Show a => a -> String
show PandocError
e
        Right Pandoc
x -> Pandoc -> ExceptT String IO Pandoc
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
x

    Presentation
pres <- IO (Either String Presentation) -> ExceptT String IO Presentation
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Presentation) -> ExceptT String IO Presentation)
-> IO (Either String Presentation)
-> ExceptT String IO Presentation
forall a b. (a -> b) -> a -> b
$ Either String Presentation -> IO (Either String Presentation)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Presentation -> IO (Either String Presentation))
-> Either String Presentation -> IO (Either String Presentation)
forall a b. (a -> b) -> a -> b
$
        UniqueGen
-> String
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either String Presentation
pandocToPresentation UniqueGen
uniqueGen String
filePath EncodingFallback
enc PresentationSettings
settings SyntaxMap
syntaxMap Pandoc
doc
    Presentation -> ExceptT String IO Presentation
forall a. a -> ExceptT String IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Presentation -> ExceptT String IO Presentation)
-> Presentation -> ExceptT String IO Presentation
forall a b. (a -> b) -> a -> b
$ Presentation -> Presentation
fragmentPresentation (Presentation -> Presentation) -> Presentation -> Presentation
forall a b. (a -> b) -> a -> b
$ Presentation -> Presentation
Eval.parseEvalBlocks 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 =
    ExceptT String IO SyntaxMap -> IO (Either String SyntaxMap)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO SyntaxMap -> IO (Either String SyntaxMap))
-> ([String] -> ExceptT String IO SyntaxMap)
-> [String]
-> IO (Either String SyntaxMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([Syntax] -> SyntaxMap)
-> ExceptT String IO [Syntax] -> ExceptT String IO SyntaxMap
forall a b. (a -> b) -> ExceptT String IO a -> ExceptT String 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 String IO [Syntax] -> ExceptT String IO SyntaxMap)
-> ([String] -> ExceptT String IO [Syntax])
-> [String]
-> ExceptT String IO SyntaxMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (String -> ExceptT String IO Syntax)
-> [String] -> ExceptT String 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 String Syntax) -> ExceptT String IO Syntax
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String Syntax) -> ExceptT String IO Syntax)
-> (String -> IO (Either String Syntax))
-> String
-> ExceptT String IO Syntax
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" -> (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
    String
".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
    String
".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
    String
".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
    String
".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
    String
".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
    String
".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
    String
".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
    String
".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
    String
""          -> (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
    String
".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
    String
".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
    String
_           -> 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
    :: UniqueGen -> FilePath -> EncodingFallback -> PresentationSettings
    -> Skylighting.SyntaxMap -> Pandoc.Pandoc -> Either String Presentation
pandocToPresentation :: UniqueGen
-> String
-> EncodingFallback
-> PresentationSettings
-> SyntaxMap
-> Pandoc
-> Either String Presentation
pandocToPresentation UniqueGen
pUniqueGen 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
Str (Text -> Inline)
-> ((String, String) -> Text) -> (String, String) -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> ((String, String) -> String) -> (String, String) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> Inline) -> (String, String) -> Inline
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitFileName String
pFilePath]
            [Inline]
title -> [Inline] -> [Inline]
fromPandocInlines [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]
fromPandocInlines ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ 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 String PresentationSettings)
-> Seq Slide -> Either String (Seq PresentationSettings)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
Seq.traverseWithIndex
        (\Int
i Slide
slide -> case Slide -> Either String PresentationSettings
slideSettings Slide
slide of
            Left String
err  -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left (String -> Either String PresentationSettings)
-> String -> Either String PresentationSettings
forall a b. (a -> b) -> a -> b
$ String
"on slide " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
            Right PresentationSettings
cfg -> PresentationSettings -> Either String PresentationSettings
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PresentationSettings
cfg)
        Seq Slide
pSlides
    Seq (Maybe TransitionGen)
pTransitionGens <- Seq PresentationSettings
-> (PresentationSettings -> Either String (Maybe TransitionGen))
-> Either String (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 String (Maybe TransitionGen))
 -> Either String (Seq (Maybe TransitionGen)))
-> (PresentationSettings -> Either String (Maybe TransitionGen))
-> Either String (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 String (Maybe TransitionGen)
forall a. a -> Either String 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 String TransitionGen
-> Either String (Maybe TransitionGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransitionSettings -> Either String TransitionGen
parseTransitionSettings TransitionSettings
ts
    Presentation -> Either String Presentation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Presentation -> Either String Presentation)
-> Presentation -> Either String Presentation
forall a b. (a -> b) -> a -> b
$ Presentation {String
[Inline]
(Int, Int)
HashMap Var [Block]
EvalBlocks
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
UniqueGen
pUniqueGen :: UniqueGen
pFilePath :: String
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 :: String
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
pUniqueGen :: UniqueGen
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 String 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 String Value)
forall a. Maybe a
Nothing
        ([Text]
block, (Text
_ : [Text]
_)) -> Either String Value -> Maybe (Either String Value)
forall a. a -> Maybe a
Just (Either String Value -> Maybe (Either String Value))
-> ([Text] -> Either String Value)
-> [Text]
-> Maybe (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> String)
-> Either ParseException Value -> Either String 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 -> String
Yaml.prettyPrintParseException (Either ParseException Value -> Either String Value)
-> ([Text] -> Either ParseException Value)
-> [Text]
-> Either String 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 String Value))
-> [Text] -> Maybe (Either String Value)
forall a b. (a -> b) -> a -> b
$! [Text]
block
    [Text]
_            -> Maybe (Either String 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 String PresentationSettings
readMetaSettings Text
src = case Text -> Maybe (Either String Value)
parseMetadataBlock Text
src of
    Maybe (Either String Value)
Nothing -> PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty
    Just (Left String
err) -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left String
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 ->
       (String -> String)
-> Either String PresentationSettings
-> Either String 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 (\String
err -> String
"Error parsing patat settings from metadata: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err) (Either String PresentationSettings
 -> Either String PresentationSettings)
-> Either String PresentationSettings
-> Either String PresentationSettings
forall a b. (a -> b) -> a -> b
$!
       Result PresentationSettings -> Either String PresentationSettings
forall a. Result a -> Either String a
A.resultToEither (Result PresentationSettings -> Either String PresentationSettings)
-> Result PresentationSettings
-> Either String 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 String 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 String PresentationSettings)
readHomeSettings = do
    String
home <- IO String
getHomeDirectory
    String -> IO (Either String PresentationSettings)
readSettings (String -> IO (Either String PresentationSettings))
-> String -> IO (Either String PresentationSettings)
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") IO String
-> (String -> IO (Either String PresentationSettings))
-> IO (Either String PresentationSettings)
forall a b. IO a -> (a -> IO b) -> IO b
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 Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PresentationSettings -> Either String PresentationSettings
forall a b. b -> Either a b
Right PresentationSettings
forall a. Monoid a => a
mempty)
        else do
            Either ParseException PresentationSettings
errOrPs <- String -> IO (Either ParseException PresentationSettings)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
path
            Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PresentationSettings
 -> IO (Either String PresentationSettings))
-> Either String PresentationSettings
-> IO (Either String PresentationSettings)
forall a b. (a -> b) -> a -> b
$! case Either ParseException PresentationSettings
errOrPs of
                Left  ParseException
err -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left (ParseException -> String
forall a. Show a => a -> String
show ParseException
err)
                Right PresentationSettings
ps  -> PresentationSettings -> Either String 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 Meta
_meta [Block]
pblocks) =
    let blocks :: [Block]
blocks       = [Block] -> [Block]
fromPandocBlocks [Block]
pblocks
        slideLevel :: Int
slideLevel   = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Block] -> Int
detectSlideLevel [Block]
blocks) (PresentationSettings -> Maybe Int
psSlideLevel PresentationSettings
settings)
        unfragmented :: [Slide]
unfragmented = Int -> [Block] -> [Slide]
splitSlides Int
slideLevel [Block]
blocks in
    [Slide] -> Seq Slide
forall a. [a] -> Seq a
Seq.fromList [Slide]
unfragmented


--------------------------------------------------------------------------------
-- | Find level of header that starts slides.  This is defined as the least
-- header that occurs before a non-header in the blocks.
detectSlideLevel :: [Block] -> Int
detectSlideLevel :: [Block] -> Int
detectSlideLevel [Block]
blocks0 =
    Int -> [Block] -> Int
go Int
6 ([Block] -> Int) -> [Block] -> Int
forall a b. (a -> b) -> a -> b
$ (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isComment) [Block]
blocks0
  where
    go :: Int -> [Block] -> Int
go Int
level (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 (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 -> [Block] -> [Slide]
splitSlides :: Int -> [Block] -> [Slide]
splitSlides Int
slideLevel [Block]
blocks0
    | (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isHorizontalRule [Block]
blocks0 = [Block] -> [Slide]
splitAtRules   [Block]
blocks0
    | Bool
otherwise                    = [Block] -> [Block] -> [Slide]
splitAtHeaders [] [Block]
blocks0
  where
    mkContentSlide :: [Block] -> [Slide]
    mkContentSlide :: [Block] -> [Slide]
mkContentSlide [Block]
bs0 = do
        let bs1 :: [Block]
bs1  = (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isComment) [Block]
bs0
            sns :: SpeakerNotes
sns  = [Text] -> SpeakerNotes
SpeakerNotes.SpeakerNotes [Text
s | SpeakerNote Text
s <- [Block]
bs0]
            cfgs :: Either String PresentationSettings
cfgs = [Either String PresentationSettings]
-> Either String PresentationSettings
concatCfgs [Either String PresentationSettings
cfg | Config Either String PresentationSettings
cfg <- [Block]
bs0]
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
bs1  -- Never create empty slides
        Slide -> [Slide]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Slide -> [Slide]) -> Slide -> [Slide]
forall a b. (a -> b) -> a -> b
$ SpeakerNotes
-> Either String PresentationSettings -> SlideContent -> Slide
Slide SpeakerNotes
sns Either String PresentationSettings
cfgs (SlideContent -> Slide) -> SlideContent -> Slide
forall a b. (a -> b) -> a -> b
$ [Block] -> SlideContent
ContentSlide [Block]
bs1

    splitAtRules :: [Block] -> [Slide]
splitAtRules [Block]
blocks = case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isHorizontalRule [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@(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 ([Block]
cmnts, [Block]
bs1) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isComment) [Block]
bs0
                sns :: SpeakerNotes
sns  = [Text] -> SpeakerNotes
SpeakerNotes.SpeakerNotes [Text
s | SpeakerNote Text
s <- [Block]
cmnts]
                cfgs :: Either String PresentationSettings
cfgs = [Either String PresentationSettings]
-> Either String PresentationSettings
concatCfgs [Either String PresentationSettings
cfg | Config Either String PresentationSettings
cfg <- [Block]
cmnts] in
            [Block] -> [Slide]
mkContentSlide ([Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc) [Slide] -> [Slide] -> [Slide]
forall a. [a] -> [a] -> [a]
++
            [SpeakerNotes
-> Either String PresentationSettings -> SlideContent -> Slide
Slide SpeakerNotes
sns Either String PresentationSettings
cfgs (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

    concatCfgs
        :: [Either String PresentationSettings]
        -> Either String PresentationSettings
    concatCfgs :: [Either String PresentationSettings]
-> Either String PresentationSettings
concatCfgs = ([PresentationSettings] -> PresentationSettings)
-> Either String [PresentationSettings]
-> Either String PresentationSettings
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PresentationSettings] -> PresentationSettings
forall a. Monoid a => [a] -> a
mconcat (Either String [PresentationSettings]
 -> Either String PresentationSettings)
-> ([Either String PresentationSettings]
    -> Either String [PresentationSettings])
-> [Either String PresentationSettings]
-> Either String PresentationSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String PresentationSettings]
-> Either String [PresentationSettings]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence


--------------------------------------------------------------------------------
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 [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