--------------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
module Patat.Presentation.Internal
    ( Breadcrumbs
    , Presentation (..)
    , PresentationSettings (..)
    , defaultPresentationSettings

    , Margins (..)
    , marginsOf

    , ExtensionList (..)
    , defaultExtensionList

    , ImageSettings (..)

    , EvalSettingsMap
    , EvalSettings (..)

    , Slide (..)
    , SlideContent (..)
    , Instruction.Fragment (..)
    , Index

    , getSlide
    , numFragments

    , ActiveFragment (..)
    , activeFragment
    , activeSpeakerNotes
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                   (mplus)
import qualified Data.Aeson.Extended             as A
import qualified Data.Aeson.TH.Extended          as A
import qualified Data.Foldable                   as Foldable
import           Data.Function                   (on)
import qualified Data.HashMap.Strict             as HMS
import           Data.List                       (intercalate)
import           Data.Maybe                      (fromMaybe)
import           Data.Sequence.Extended          (Seq)
import qualified Data.Sequence.Extended          as Seq
import qualified Data.Text                       as T
import           Patat.EncodingFallback          (EncodingFallback)
import qualified Patat.Presentation.Instruction  as Instruction
import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes
import qualified Patat.Theme                     as Theme
import           Prelude
import qualified Skylighting                     as Skylighting
import qualified Text.Pandoc                     as Pandoc
import           Text.Read                       (readMaybe)


--------------------------------------------------------------------------------
type Breadcrumbs = [(Int, [Pandoc.Inline])]


--------------------------------------------------------------------------------
data Presentation = Presentation
    { Presentation -> FilePath
pFilePath         :: !FilePath
    , Presentation -> EncodingFallback
pEncodingFallback :: !EncodingFallback
    , Presentation -> [Inline]
pTitle            :: ![Pandoc.Inline]
    , Presentation -> [Inline]
pAuthor           :: ![Pandoc.Inline]
    , Presentation -> PresentationSettings
pSettings         :: !PresentationSettings
    , Presentation -> Seq Slide
pSlides           :: !(Seq Slide)
    , Presentation -> Seq Breadcrumbs
pBreadcrumbs      :: !(Seq Breadcrumbs)  -- One for each slide.
    , Presentation -> Index
pActiveFragment   :: !Index
    , Presentation -> SyntaxMap
pSyntaxMap        :: !Skylighting.SyntaxMap
    } deriving (Int -> Presentation -> ShowS
[Presentation] -> ShowS
Presentation -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Presentation] -> ShowS
$cshowList :: [Presentation] -> ShowS
show :: Presentation -> FilePath
$cshow :: Presentation -> FilePath
showsPrec :: Int -> Presentation -> ShowS
$cshowsPrec :: Int -> Presentation -> ShowS
Show)


--------------------------------------------------------------------------------
-- | These are patat-specific settings.  That is where they differ from more
-- general metadata (author, title...)
data PresentationSettings = PresentationSettings
    { PresentationSettings -> Maybe (FlexibleNum Int)
psRows              :: !(Maybe (A.FlexibleNum Int))
    , PresentationSettings -> Maybe (FlexibleNum Int)
psColumns           :: !(Maybe (A.FlexibleNum Int))
    , PresentationSettings -> Maybe Margins
psMargins           :: !(Maybe Margins)
    , PresentationSettings -> Maybe Bool
psWrap              :: !(Maybe Bool)
    , PresentationSettings -> Maybe Theme
psTheme             :: !(Maybe Theme.Theme)
    , PresentationSettings -> Maybe Bool
psIncrementalLists  :: !(Maybe Bool)
    , PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay  :: !(Maybe (A.FlexibleNum Int))
    , PresentationSettings -> Maybe Int
psSlideLevel        :: !(Maybe Int)
    , PresentationSettings -> Maybe ExtensionList
psPandocExtensions  :: !(Maybe ExtensionList)
    , PresentationSettings -> Maybe ImageSettings
psImages            :: !(Maybe ImageSettings)
    , PresentationSettings -> Maybe Bool
psBreadcrumbs       :: !(Maybe Bool)
    , PresentationSettings -> Maybe EvalSettingsMap
psEval              :: !(Maybe EvalSettingsMap)
    , PresentationSettings -> Maybe Bool
psSlideNumber       :: !(Maybe Bool)
    , PresentationSettings -> Maybe [FilePath]
psSyntaxDefinitions :: !(Maybe [FilePath])
    , PresentationSettings -> Maybe Settings
psSpeakerNotes      :: !(Maybe SpeakerNotes.Settings)
    } deriving (Int -> PresentationSettings -> ShowS
[PresentationSettings] -> ShowS
PresentationSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PresentationSettings] -> ShowS
$cshowList :: [PresentationSettings] -> ShowS
show :: PresentationSettings -> FilePath
$cshow :: PresentationSettings -> FilePath
showsPrec :: Int -> PresentationSettings -> ShowS
$cshowsPrec :: Int -> PresentationSettings -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup PresentationSettings where
    PresentationSettings
l <> :: PresentationSettings
-> PresentationSettings -> PresentationSettings
<> PresentationSettings
r = PresentationSettings
        { psRows :: Maybe (FlexibleNum Int)
psRows              = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psRows              PresentationSettings
l PresentationSettings
r
        , psColumns :: Maybe (FlexibleNum Int)
psColumns           = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psColumns           PresentationSettings
l PresentationSettings
r
        , psMargins :: Maybe Margins
psMargins           = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>)  PresentationSettings -> Maybe Margins
psMargins           PresentationSettings
l PresentationSettings
r
        , psWrap :: Maybe Bool
psWrap              = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psWrap              PresentationSettings
l PresentationSettings
r
        , psTheme :: Maybe Theme
psTheme             = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>)  PresentationSettings -> Maybe Theme
psTheme             PresentationSettings
l PresentationSettings
r
        , psIncrementalLists :: Maybe Bool
psIncrementalLists  = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psIncrementalLists  PresentationSettings
l PresentationSettings
r
        , psAutoAdvanceDelay :: Maybe (FlexibleNum Int)
psAutoAdvanceDelay  = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay  PresentationSettings
l PresentationSettings
r
        , psSlideLevel :: Maybe Int
psSlideLevel        = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Int
psSlideLevel        PresentationSettings
l PresentationSettings
r
        , psPandocExtensions :: Maybe ExtensionList
psPandocExtensions  = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe ExtensionList
psPandocExtensions  PresentationSettings
l PresentationSettings
r
        , psImages :: Maybe ImageSettings
psImages            = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe ImageSettings
psImages            PresentationSettings
l PresentationSettings
r
        , psBreadcrumbs :: Maybe Bool
psBreadcrumbs       = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psBreadcrumbs       PresentationSettings
l PresentationSettings
r
        , psEval :: Maybe EvalSettingsMap
psEval              = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>)  PresentationSettings -> Maybe EvalSettingsMap
psEval              PresentationSettings
l PresentationSettings
r
        , psSlideNumber :: Maybe Bool
psSlideNumber       = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psSlideNumber       PresentationSettings
l PresentationSettings
r
        , psSyntaxDefinitions :: Maybe [FilePath]
psSyntaxDefinitions = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>)  PresentationSettings -> Maybe [FilePath]
psSyntaxDefinitions PresentationSettings
l PresentationSettings
r
        , psSpeakerNotes :: Maybe Settings
psSpeakerNotes      = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Settings
psSpeakerNotes      PresentationSettings
l PresentationSettings
r
        }


--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
    mappend :: PresentationSettings
-> PresentationSettings -> PresentationSettings
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: PresentationSettings
mempty  = Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int)
-> Maybe Margins
-> Maybe Bool
-> Maybe Theme
-> Maybe Bool
-> Maybe (FlexibleNum Int)
-> Maybe Int
-> Maybe ExtensionList
-> Maybe ImageSettings
-> Maybe Bool
-> Maybe EvalSettingsMap
-> Maybe Bool
-> Maybe [FilePath]
-> Maybe Settings
-> PresentationSettings
PresentationSettings
                    forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                    forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                    forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = forall a. Monoid a => a
mempty
    { psMargins :: Maybe Margins
psMargins          = forall a. a -> Maybe a
Just Margins
defaultMargins
    , psTheme :: Maybe Theme
psTheme            = forall a. a -> Maybe a
Just Theme
Theme.defaultTheme
    }


--------------------------------------------------------------------------------
data Margins = Margins
    { Margins -> Maybe (FlexibleNum Int)
mLeft  :: !(Maybe (A.FlexibleNum Int))
    , Margins -> Maybe (FlexibleNum Int)
mRight :: !(Maybe (A.FlexibleNum Int))
    } deriving (Int -> Margins -> ShowS
[Margins] -> ShowS
Margins -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Margins] -> ShowS
$cshowList :: [Margins] -> ShowS
show :: Margins -> FilePath
$cshow :: Margins -> FilePath
showsPrec :: Int -> Margins -> ShowS
$cshowsPrec :: Int -> Margins -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup Margins where
    Margins
l <> :: Margins -> Margins -> Margins
<> Margins
r = Margins
        { mLeft :: Maybe (FlexibleNum Int)
mLeft  = Margins -> Maybe (FlexibleNum Int)
mLeft  Margins
l forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Margins -> Maybe (FlexibleNum Int)
mLeft  Margins
r
        , mRight :: Maybe (FlexibleNum Int)
mRight = Margins -> Maybe (FlexibleNum Int)
mRight Margins
l forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Margins -> Maybe (FlexibleNum Int)
mRight Margins
r
        }


--------------------------------------------------------------------------------
instance Monoid Margins where
    mappend :: Margins -> Margins -> Margins
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: Margins
mempty  = Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int) -> Margins
Margins forall a. Maybe a
Nothing forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
defaultMargins :: Margins
defaultMargins :: Margins
defaultMargins = Margins
    { mLeft :: Maybe (FlexibleNum Int)
mLeft  = forall a. Maybe a
Nothing
    , mRight :: Maybe (FlexibleNum Int)
mRight = forall a. Maybe a
Nothing
    }


--------------------------------------------------------------------------------
marginsOf :: PresentationSettings -> (Int, Int)
marginsOf :: PresentationSettings -> Index
marginsOf PresentationSettings
presentationSettings =
    (Int
marginLeft, Int
marginRight)
  where
    margins :: Margins
margins    = forall a. a -> Maybe a -> a
fromMaybe Margins
defaultMargins forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Margins
psMargins PresentationSettings
presentationSettings
    marginLeft :: Int
marginLeft  = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Margins -> Maybe (FlexibleNum Int)
mLeft Margins
margins)
    marginRight :: Int
marginRight = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Margins -> Maybe (FlexibleNum Int)
mRight Margins
margins)


--------------------------------------------------------------------------------
newtype ExtensionList = ExtensionList {ExtensionList -> Extensions
unExtensionList :: Pandoc.Extensions}
    deriving (Int -> ExtensionList -> ShowS
[ExtensionList] -> ShowS
ExtensionList -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionList] -> ShowS
$cshowList :: [ExtensionList] -> ShowS
show :: ExtensionList -> FilePath
$cshow :: ExtensionList -> FilePath
showsPrec :: Int -> ExtensionList -> ShowS
$cshowsPrec :: Int -> ExtensionList -> ShowS
Show)


--------------------------------------------------------------------------------
instance A.FromJSON ExtensionList where
    parseJSON :: Value -> Parser ExtensionList
parseJSON = forall a. FilePath -> (Array -> Parser a) -> Value -> Parser a
A.withArray FilePath
"FromJSON ExtensionList" forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extensions -> ExtensionList
ExtensionList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Extensions
parseExt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
      where
        parseExt :: Value -> Parser Extensions
parseExt = forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
A.withText FilePath
"FromJSON ExtensionList" forall a b. (a -> b) -> a -> b
$ \Text
txt -> case Text
txt of
            -- Our default extensions
            Text
"patat_extensions" -> forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionList -> Extensions
unExtensionList ExtensionList
defaultExtensionList)

            -- Individuals
            Text
_ -> case forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath
"Ext_" forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
txt) of
                Just Extension
e  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Extension] -> Extensions
Pandoc.extensionsFromList [Extension
e]
                Maybe Extension
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
                    FilePath
"Unknown extension: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Text
txt forall a. [a] -> [a] -> [a]
++
                    FilePath
", known extensions are: " forall a. [a] -> [a] -> [a]
++
                    forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) [Extension]
allExts)
          where
            -- This is an approximation since we can't enumerate extensions
            -- anymore in the latest pandoc...
            allExts :: [Extension]
allExts = Extensions -> [Extension]
Pandoc.extensionsToList forall a b. (a -> b) -> a -> b
$
                Text -> Extensions
Pandoc.getAllExtensions Text
"markdown"


--------------------------------------------------------------------------------
defaultExtensionList :: ExtensionList
defaultExtensionList :: ExtensionList
defaultExtensionList = Extensions -> ExtensionList
ExtensionList forall a b. (a -> b) -> a -> b
$
    ReaderOptions -> Extensions
Pandoc.readerExtensions forall a. Default a => a
Pandoc.def forall a. Monoid a => a -> a -> a
`mappend` [Extension] -> Extensions
Pandoc.extensionsFromList
    [ Extension
Pandoc.Ext_yaml_metadata_block
    , Extension
Pandoc.Ext_table_captions
    , Extension
Pandoc.Ext_simple_tables
    , Extension
Pandoc.Ext_multiline_tables
    , Extension
Pandoc.Ext_grid_tables
    , Extension
Pandoc.Ext_pipe_tables
    , Extension
Pandoc.Ext_raw_html
    , Extension
Pandoc.Ext_tex_math_dollars
    , Extension
Pandoc.Ext_fenced_code_blocks
    , Extension
Pandoc.Ext_fenced_code_attributes
    , Extension
Pandoc.Ext_backtick_code_blocks
    , Extension
Pandoc.Ext_inline_code_attributes
    , Extension
Pandoc.Ext_fancy_lists
    , Extension
Pandoc.Ext_four_space_rule
    , Extension
Pandoc.Ext_definition_lists
    , Extension
Pandoc.Ext_compact_definition_lists
    , Extension
Pandoc.Ext_example_lists
    , Extension
Pandoc.Ext_strikeout
    , Extension
Pandoc.Ext_superscript
    , Extension
Pandoc.Ext_subscript
    ]


--------------------------------------------------------------------------------
data ImageSettings = ImageSettings
    { ImageSettings -> Text
isBackend :: !T.Text
    , ImageSettings -> Object
isParams  :: !A.Object
    } deriving (Int -> ImageSettings -> ShowS
[ImageSettings] -> ShowS
ImageSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImageSettings] -> ShowS
$cshowList :: [ImageSettings] -> ShowS
show :: ImageSettings -> FilePath
$cshow :: ImageSettings -> FilePath
showsPrec :: Int -> ImageSettings -> ShowS
$cshowsPrec :: Int -> ImageSettings -> ShowS
Show)


--------------------------------------------------------------------------------
instance A.FromJSON ImageSettings where
    parseJSON :: Value -> Parser ImageSettings
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON ImageSettings" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"backend"
        forall (m :: * -> *) a. Monad m => a -> m a
return ImageSettings {isBackend :: Text
isBackend = Text
t, isParams :: Object
isParams = Object
o}


--------------------------------------------------------------------------------
type EvalSettingsMap = HMS.HashMap T.Text EvalSettings


--------------------------------------------------------------------------------
data EvalSettings = EvalSettings
    { EvalSettings -> Text
evalCommand  :: !T.Text
    , EvalSettings -> Bool
evalReplace  :: !Bool
    , EvalSettings -> Bool
evalFragment :: !Bool
    } deriving (Int -> EvalSettings -> ShowS
[EvalSettings] -> ShowS
EvalSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EvalSettings] -> ShowS
$cshowList :: [EvalSettings] -> ShowS
show :: EvalSettings -> FilePath
$cshow :: EvalSettings -> FilePath
showsPrec :: Int -> EvalSettings -> ShowS
$cshowsPrec :: Int -> EvalSettings -> ShowS
Show)


--------------------------------------------------------------------------------
instance A.FromJSON EvalSettings where
    parseJSON :: Value -> Parser EvalSettings
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON EvalSettings" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> EvalSettings
EvalSettings
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"command"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"replace" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"fragment" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True


--------------------------------------------------------------------------------
data Slide = Slide
    { Slide -> SpeakerNotes
slideSpeakerNotes :: !SpeakerNotes.SpeakerNotes
    , Slide -> SlideContent
slideContent      :: !SlideContent
    } deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Slide] -> ShowS
$cshowList :: [Slide] -> ShowS
show :: Slide -> FilePath
$cshow :: Slide -> FilePath
showsPrec :: Int -> Slide -> ShowS
$cshowsPrec :: Int -> Slide -> ShowS
Show)


--------------------------------------------------------------------------------
data SlideContent
    = ContentSlide (Instruction.Instructions Pandoc.Block)
    | TitleSlide   Int [Pandoc.Inline]
    deriving (Int -> SlideContent -> ShowS
[SlideContent] -> ShowS
SlideContent -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SlideContent] -> ShowS
$cshowList :: [SlideContent] -> ShowS
show :: SlideContent -> FilePath
$cshow :: SlideContent -> FilePath
showsPrec :: Int -> SlideContent -> ShowS
$cshowsPrec :: Int -> SlideContent -> ShowS
Show)


--------------------------------------------------------------------------------
-- | Active slide, active fragment.
type Index = (Int, Int)


--------------------------------------------------------------------------------
getSlide :: Int -> Presentation -> Maybe Slide
getSlide :: Int -> Presentation -> Maybe Slide
getSlide Int
sidx = (forall a. Seq a -> Int -> Maybe a
`Seq.safeIndex` Int
sidx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Presentation -> Seq Slide
pSlides


--------------------------------------------------------------------------------
numFragments :: Slide -> Int
numFragments :: Slide -> Int
numFragments Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
    ContentSlide Instructions Block
instrs -> forall a. Instructions a -> Int
Instruction.numFragments Instructions Block
instrs
    TitleSlide Int
_ [Inline]
_      -> Int
1


--------------------------------------------------------------------------------
data ActiveFragment
    = ActiveContent Instruction.Fragment
    | ActiveTitle Pandoc.Block
    deriving (Int -> ActiveFragment -> ShowS
[ActiveFragment] -> ShowS
ActiveFragment -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ActiveFragment] -> ShowS
$cshowList :: [ActiveFragment] -> ShowS
show :: ActiveFragment -> FilePath
$cshow :: ActiveFragment -> FilePath
showsPrec :: Int -> ActiveFragment -> ShowS
$cshowsPrec :: Int -> ActiveFragment -> ShowS
Show)


--------------------------------------------------------------------------------
activeFragment :: Presentation -> Maybe ActiveFragment
activeFragment :: Presentation -> Maybe ActiveFragment
activeFragment Presentation
presentation = do
    let (Int
sidx, Int
fidx) = Presentation -> Index
pActiveFragment Presentation
presentation
    Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Slide -> SlideContent
slideContent Slide
slide of
        TitleSlide Int
lvl [Inline]
is -> Block -> ActiveFragment
ActiveTitle forall a b. (a -> b) -> a -> b
$
            Int -> Attr -> [Inline] -> Block
Pandoc.Header Int
lvl Attr
Pandoc.nullAttr [Inline]
is
        ContentSlide Instructions Block
instrs -> Fragment -> ActiveFragment
ActiveContent forall a b. (a -> b) -> a -> b
$
            Int -> Instructions Block -> Fragment
Instruction.renderFragment Int
fidx Instructions Block
instrs


--------------------------------------------------------------------------------
activeSpeakerNotes :: Presentation -> SpeakerNotes.SpeakerNotes
activeSpeakerNotes :: Presentation -> SpeakerNotes
activeSpeakerNotes Presentation
presentation = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ do
    let (Int
sidx, Int
_) = Presentation -> Index
pActiveFragment Presentation
presentation
    Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide


--------------------------------------------------------------------------------
$(A.deriveFromJSON A.dropPrefixOptions ''Margins)
$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)