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

    , Margins (..)
    , marginsOf

    , ExtensionList (..)
    , defaultExtensionList

    , ImageSettings (..)

    , EvalSettingsMap
    , EvalSettings (..)

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

    , getSlide
    , numFragments

    , ActiveFragment (..)
    , getActiveFragment
    ) 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 qualified Data.HashMap.Strict            as HMS
import           Data.List                      (intercalate)
import           Data.Maybe                     (fromMaybe, listToMaybe)
import qualified Data.Text                      as T
import qualified Patat.Presentation.Instruction as Instruction
import qualified Patat.Theme                    as Theme
import           Prelude
import qualified Text.Pandoc                    as Pandoc
import           Text.Read                      (readMaybe)


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


--------------------------------------------------------------------------------
data Presentation = Presentation
    { Presentation -> FilePath
pFilePath       :: !FilePath
    , Presentation -> [Inline]
pTitle          :: ![Pandoc.Inline]
    , Presentation -> [Inline]
pAuthor         :: ![Pandoc.Inline]
    , Presentation -> PresentationSettings
pSettings       :: !PresentationSettings
    , Presentation -> [Slide]
pSlides         :: [Slide]
    , Presentation -> [Breadcrumbs]
pBreadcrumbs    :: [Breadcrumbs]  -- One for each slide.
    , Presentation -> Index
pActiveFragment :: !Index
    } deriving (Int -> Presentation -> ShowS
[Presentation] -> ShowS
Presentation -> FilePath
(Int -> Presentation -> ShowS)
-> (Presentation -> FilePath)
-> ([Presentation] -> ShowS)
-> Show Presentation
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)
    } deriving (Int -> PresentationSettings -> ShowS
[PresentationSettings] -> ShowS
PresentationSettings -> FilePath
(Int -> PresentationSettings -> ShowS)
-> (PresentationSettings -> FilePath)
-> ([PresentationSettings] -> ShowS)
-> Show PresentationSettings
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 :: 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
-> PresentationSettings
PresentationSettings
        { psRows :: Maybe (FlexibleNum Int)
psRows             = PresentationSettings -> Maybe (FlexibleNum Int)
psRows             PresentationSettings
l Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe (FlexibleNum Int)
psRows             PresentationSettings
r
        , psColumns :: Maybe (FlexibleNum Int)
psColumns          = PresentationSettings -> Maybe (FlexibleNum Int)
psColumns          PresentationSettings
l Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe (FlexibleNum Int)
psColumns          PresentationSettings
r
        , psMargins :: Maybe Margins
psMargins          = PresentationSettings -> Maybe Margins
psMargins          PresentationSettings
l Maybe Margins -> Maybe Margins -> Maybe Margins
forall a. Semigroup a => a -> a -> a
<>      PresentationSettings -> Maybe Margins
psMargins          PresentationSettings
r
        , psWrap :: Maybe Bool
psWrap             = PresentationSettings -> Maybe Bool
psWrap             PresentationSettings
l Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe Bool
psWrap             PresentationSettings
r
        , psTheme :: Maybe Theme
psTheme            = PresentationSettings -> Maybe Theme
psTheme            PresentationSettings
l Maybe Theme -> Maybe Theme -> Maybe Theme
forall a. Semigroup a => a -> a -> a
<>      PresentationSettings -> Maybe Theme
psTheme            PresentationSettings
r
        , psIncrementalLists :: Maybe Bool
psIncrementalLists = PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
l Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
r
        , psAutoAdvanceDelay :: Maybe (FlexibleNum Int)
psAutoAdvanceDelay = PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay PresentationSettings
l Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay PresentationSettings
r
        , psSlideLevel :: Maybe Int
psSlideLevel       = PresentationSettings -> Maybe Int
psSlideLevel       PresentationSettings
l Maybe Int -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe Int
psSlideLevel       PresentationSettings
r
        , psPandocExtensions :: Maybe ExtensionList
psPandocExtensions = PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
l Maybe ExtensionList -> Maybe ExtensionList -> Maybe ExtensionList
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
r
        , psImages :: Maybe ImageSettings
psImages           = PresentationSettings -> Maybe ImageSettings
psImages           PresentationSettings
l Maybe ImageSettings -> Maybe ImageSettings -> Maybe ImageSettings
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe ImageSettings
psImages           PresentationSettings
r
        , psBreadcrumbs :: Maybe Bool
psBreadcrumbs      = PresentationSettings -> Maybe Bool
psBreadcrumbs      PresentationSettings
l Maybe Bool -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PresentationSettings -> Maybe Bool
psBreadcrumbs      PresentationSettings
r
        , psEval :: Maybe EvalSettingsMap
psEval             = PresentationSettings -> Maybe EvalSettingsMap
psEval             PresentationSettings
l Maybe EvalSettingsMap
-> Maybe EvalSettingsMap -> Maybe EvalSettingsMap
forall a. Semigroup a => a -> a -> a
<>      PresentationSettings -> Maybe EvalSettingsMap
psEval             PresentationSettings
r
        }


--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
    mappend :: PresentationSettings
-> PresentationSettings -> PresentationSettings
mappend = PresentationSettings
-> PresentationSettings -> PresentationSettings
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
-> PresentationSettings
PresentationSettings
                    Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing Maybe Margins
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Theme
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing
                    Maybe Int
forall a. Maybe a
Nothing Maybe ExtensionList
forall a. Maybe a
Nothing Maybe ImageSettings
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe EvalSettingsMap
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = PresentationSettings :: 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
-> PresentationSettings
PresentationSettings
    { psRows :: Maybe (FlexibleNum Int)
psRows             = Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing
    , psColumns :: Maybe (FlexibleNum Int)
psColumns          = Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing
    , psMargins :: Maybe Margins
psMargins          = Margins -> Maybe Margins
forall a. a -> Maybe a
Just Margins
defaultMargins
    , psWrap :: Maybe Bool
psWrap             = Maybe Bool
forall a. Maybe a
Nothing
    , psTheme :: Maybe Theme
psTheme            = Theme -> Maybe Theme
forall a. a -> Maybe a
Just Theme
Theme.defaultTheme
    , psIncrementalLists :: Maybe Bool
psIncrementalLists = Maybe Bool
forall a. Maybe a
Nothing
    , psAutoAdvanceDelay :: Maybe (FlexibleNum Int)
psAutoAdvanceDelay = Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing
    , psSlideLevel :: Maybe Int
psSlideLevel       = Maybe Int
forall a. Maybe a
Nothing
    , psPandocExtensions :: Maybe ExtensionList
psPandocExtensions = Maybe ExtensionList
forall a. Maybe a
Nothing
    , psImages :: Maybe ImageSettings
psImages           = Maybe ImageSettings
forall a. Maybe a
Nothing
    , psBreadcrumbs :: Maybe Bool
psBreadcrumbs      = Maybe Bool
forall a. Maybe a
Nothing
    , psEval :: Maybe EvalSettingsMap
psEval             = Maybe EvalSettingsMap
forall a. Maybe a
Nothing
    }


--------------------------------------------------------------------------------
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
(Int -> Margins -> ShowS)
-> (Margins -> FilePath) -> ([Margins] -> ShowS) -> Show Margins
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 :: Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int) -> Margins
Margins
        { mLeft :: Maybe (FlexibleNum Int)
mLeft  = Margins -> Maybe (FlexibleNum Int)
mLeft  Margins
l Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
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 Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
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 = Margins -> Margins -> Margins
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: Margins
mempty  = Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int) -> Margins
Margins Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing Maybe (FlexibleNum Int)
forall a. Maybe a
Nothing


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


--------------------------------------------------------------------------------
marginsOf :: PresentationSettings -> (Int, Int)
marginsOf :: PresentationSettings -> Index
marginsOf PresentationSettings
presentationSettings =
    (Int
marginLeft, Int
marginRight)
  where
    margins :: Margins
margins    = Margins -> Maybe Margins -> Margins
forall a. a -> Maybe a -> a
fromMaybe Margins
defaultMargins (Maybe Margins -> Margins) -> Maybe Margins -> Margins
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Margins
psMargins PresentationSettings
presentationSettings
    marginLeft :: Int
marginLeft  = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Margins -> Maybe (FlexibleNum Int)
mLeft Margins
margins)
    marginRight :: Int
marginRight = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
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
(Int -> ExtensionList -> ShowS)
-> (ExtensionList -> FilePath)
-> ([ExtensionList] -> ShowS)
-> Show ExtensionList
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 = FilePath
-> (Array -> Parser ExtensionList) -> Value -> Parser ExtensionList
forall a. FilePath -> (Array -> Parser a) -> Value -> Parser a
A.withArray FilePath
"FromJSON ExtensionList" ((Array -> Parser ExtensionList) -> Value -> Parser ExtensionList)
-> (Array -> Parser ExtensionList) -> Value -> Parser ExtensionList
forall a b. (a -> b) -> a -> b
$
        ([Extensions] -> ExtensionList)
-> Parser [Extensions] -> Parser ExtensionList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extensions -> ExtensionList
ExtensionList (Extensions -> ExtensionList)
-> ([Extensions] -> Extensions) -> [Extensions] -> ExtensionList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extensions] -> Extensions
forall a. Monoid a => [a] -> a
mconcat) (Parser [Extensions] -> Parser ExtensionList)
-> (Array -> Parser [Extensions]) -> Array -> Parser ExtensionList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser Extensions) -> [Value] -> Parser [Extensions]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Extensions
parseExt ([Value] -> Parser [Extensions])
-> (Array -> [Value]) -> Array -> Parser [Extensions]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
      where
        parseExt :: Value -> Parser Extensions
parseExt = FilePath
-> (Text -> Parser Extensions) -> Value -> Parser Extensions
forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
A.withText FilePath
"FromJSON ExtensionList" ((Text -> Parser Extensions) -> Value -> Parser Extensions)
-> (Text -> Parser Extensions) -> Value -> Parser Extensions
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case Text
txt of
            -- Our default extensions
            Text
"patat_extensions" -> Extensions -> Parser Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionList -> Extensions
unExtensionList ExtensionList
defaultExtensionList)

            -- Individuals
            Text
_ -> case FilePath -> Maybe Extension
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath
"Ext_" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
txt) of
                Just Extension
e  -> Extensions -> Parser Extensions
forall (m :: * -> *) a. Monad m => a -> m a
return (Extensions -> Parser Extensions)
-> Extensions -> Parser Extensions
forall a b. (a -> b) -> a -> b
$ [Extension] -> Extensions
Pandoc.extensionsFromList [Extension
e]
                Maybe Extension
Nothing -> FilePath -> Parser Extensions
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser Extensions) -> FilePath -> Parser Extensions
forall a b. (a -> b) -> a -> b
$
                    FilePath
"Unknown extension: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
txt FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                    FilePath
", known extensions are: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                    FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", "
                        [ ShowS
forall a. Show a => a -> FilePath
show (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 (Extension -> FilePath
forall a. Show a => a -> FilePath
show Extension
e))
                        | Extension
e <- [Extension
forall a. Bounded a => a
minBound .. Extension
forall a. Bounded a => a
maxBound] :: [Pandoc.Extension]
                        ]


--------------------------------------------------------------------------------
defaultExtensionList :: ExtensionList
defaultExtensionList :: ExtensionList
defaultExtensionList = Extensions -> ExtensionList
ExtensionList (Extensions -> ExtensionList) -> Extensions -> ExtensionList
forall a b. (a -> b) -> a -> b
$
    ReaderOptions -> Extensions
Pandoc.readerExtensions ReaderOptions
forall a. Default a => a
Pandoc.def Extensions -> Extensions -> Extensions
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
(Int -> ImageSettings -> ShowS)
-> (ImageSettings -> FilePath)
-> ([ImageSettings] -> ShowS)
-> Show ImageSettings
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 = FilePath
-> (Object -> Parser ImageSettings)
-> Value
-> Parser ImageSettings
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON ImageSettings" ((Object -> Parser ImageSettings) -> Value -> Parser ImageSettings)
-> (Object -> Parser ImageSettings)
-> Value
-> Parser ImageSettings
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"backend"
        ImageSettings -> Parser ImageSettings
forall (m :: * -> *) a. Monad m => a -> m a
return ImageSettings :: Text -> Object -> ImageSettings
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
(Int -> EvalSettings -> ShowS)
-> (EvalSettings -> FilePath)
-> ([EvalSettings] -> ShowS)
-> Show EvalSettings
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 = FilePath
-> (Object -> Parser EvalSettings) -> Value -> Parser EvalSettings
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON EvalSettings" ((Object -> Parser EvalSettings) -> Value -> Parser EvalSettings)
-> (Object -> Parser EvalSettings) -> Value -> Parser EvalSettings
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> EvalSettings
EvalSettings
        (Text -> Bool -> Bool -> EvalSettings)
-> Parser Text -> Parser (Bool -> Bool -> EvalSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"command"
        Parser (Bool -> Bool -> EvalSettings)
-> Parser Bool -> Parser (Bool -> EvalSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"replace" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False
        Parser (Bool -> EvalSettings) -> Parser Bool -> Parser EvalSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"fragment" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True


--------------------------------------------------------------------------------
data Slide
    = ContentSlide (Instruction.Instructions Pandoc.Block)
    | TitleSlide   Int [Pandoc.Inline]
    deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> FilePath
(Int -> Slide -> ShowS)
-> (Slide -> FilePath) -> ([Slide] -> ShowS) -> Show Slide
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)


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


--------------------------------------------------------------------------------
getSlide :: Int -> Presentation -> Maybe Slide
getSlide :: Int -> Presentation -> Maybe Slide
getSlide Int
sidx = [Slide] -> Maybe Slide
forall a. [a] -> Maybe a
listToMaybe ([Slide] -> Maybe Slide)
-> (Presentation -> [Slide]) -> Presentation -> Maybe Slide
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Slide] -> [Slide]
forall a. Int -> [a] -> [a]
drop Int
sidx ([Slide] -> [Slide])
-> (Presentation -> [Slide]) -> Presentation -> [Slide]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Presentation -> [Slide]
pSlides


--------------------------------------------------------------------------------
numFragments :: Slide -> Int
numFragments :: Slide -> Int
numFragments (ContentSlide Instructions Block
instrs) = Instructions Block -> Int
forall a. Instructions a -> Int
Instruction.numFragments Instructions Block
instrs
numFragments (TitleSlide Int
_ [Inline]
_)      = Int
1


--------------------------------------------------------------------------------
data ActiveFragment
    = ActiveContent Instruction.Fragment
    | ActiveTitle Pandoc.Block
    deriving (Int -> ActiveFragment -> ShowS
[ActiveFragment] -> ShowS
ActiveFragment -> FilePath
(Int -> ActiveFragment -> ShowS)
-> (ActiveFragment -> FilePath)
-> ([ActiveFragment] -> ShowS)
-> Show ActiveFragment
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)


--------------------------------------------------------------------------------
getActiveFragment :: Presentation -> Maybe ActiveFragment
getActiveFragment :: Presentation -> Maybe ActiveFragment
getActiveFragment Presentation
presentation = do
    let (Int
sidx, Int
fidx) = Presentation -> Index
pActiveFragment Presentation
presentation
    Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
    ActiveFragment -> Maybe ActiveFragment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveFragment -> Maybe ActiveFragment)
-> ActiveFragment -> Maybe ActiveFragment
forall a b. (a -> b) -> a -> b
$ case Slide
slide of
        TitleSlide Int
lvl [Inline]
is -> Block -> ActiveFragment
ActiveTitle (Block -> ActiveFragment) -> Block -> ActiveFragment
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 (Fragment -> ActiveFragment) -> Fragment -> ActiveFragment
forall a b. (a -> b) -> a -> b
$
            Int -> Instructions Block -> Fragment
Instruction.renderFragment Int
fidx Instructions Block
instrs


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