--------------------------------------------------------------------------------
{-# 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
(Int -> Presentation -> ShowS)
-> (Presentation -> FilePath)
-> ([Presentation] -> ShowS)
-> Show Presentation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presentation -> ShowS
showsPrec :: Int -> Presentation -> ShowS
$cshow :: Presentation -> FilePath
show :: Presentation -> FilePath
$cshowList :: [Presentation] -> ShowS
showList :: [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
(Int -> PresentationSettings -> ShowS)
-> (PresentationSettings -> FilePath)
-> ([PresentationSettings] -> ShowS)
-> Show PresentationSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PresentationSettings -> ShowS
showsPrec :: Int -> PresentationSettings -> ShowS
$cshow :: PresentationSettings -> FilePath
show :: PresentationSettings -> FilePath
$cshowList :: [PresentationSettings] -> ShowS
showList :: [PresentationSettings] -> ShowS
Show)


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


--------------------------------------------------------------------------------
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = PresentationSettings
forall a. Monoid a => a
mempty
    { psMargins :: Maybe Margins
psMargins          = Margins -> Maybe Margins
forall a. a -> Maybe a
Just Margins
defaultMargins
    , psTheme :: Maybe Theme
psTheme            = Theme -> Maybe Theme
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
(Int -> Margins -> ShowS)
-> (Margins -> FilePath) -> ([Margins] -> ShowS) -> Show Margins
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Margins -> ShowS
showsPrec :: Int -> Margins -> ShowS
$cshow :: Margins -> FilePath
show :: Margins -> FilePath
$cshowList :: [Margins] -> ShowS
showList :: [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 Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int) -> Maybe (FlexibleNum Int)
forall a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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
    { 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
$cshowsPrec :: Int -> ExtensionList -> ShowS
showsPrec :: Int -> ExtensionList -> ShowS
$cshow :: ExtensionList -> FilePath
show :: ExtensionList -> FilePath
$cshowList :: [ExtensionList] -> ShowS
showList :: [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 a b. (a -> b) -> Parser a -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. Vector a -> [a]
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 a. a -> Parser a
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 a. a -> Parser a
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 a. FilePath -> Parser a
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
", " ((Extension -> FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 ShowS -> (Extension -> FilePath) -> Extension -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
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 (Extensions -> [Extension]) -> Extensions -> [Extension]
forall a b. (a -> b) -> a -> b
$
                Text -> Extensions
Pandoc.getAllExtensions Text
"markdown"


--------------------------------------------------------------------------------
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
$cshowsPrec :: Int -> ImageSettings -> ShowS
showsPrec :: Int -> ImageSettings -> ShowS
$cshow :: ImageSettings -> FilePath
show :: ImageSettings -> FilePath
$cshowList :: [ImageSettings] -> ShowS
showList :: [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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"backend"
        ImageSettings -> Parser ImageSettings
forall a. a -> Parser a
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
(Int -> EvalSettings -> ShowS)
-> (EvalSettings -> FilePath)
-> ([EvalSettings] -> ShowS)
-> Show EvalSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalSettings -> ShowS
showsPrec :: Int -> EvalSettings -> ShowS
$cshow :: EvalSettings -> FilePath
show :: EvalSettings -> FilePath
$cshowList :: [EvalSettings] -> ShowS
showList :: [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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"command"
        Parser (Bool -> Bool -> EvalSettings)
-> Parser Bool -> Parser (Bool -> EvalSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"fragment" Parser (Maybe Bool) -> Bool -> Parser Bool
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
(Int -> Slide -> ShowS)
-> (Slide -> FilePath) -> ([Slide] -> ShowS) -> Show Slide
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slide -> ShowS
showsPrec :: Int -> Slide -> ShowS
$cshow :: Slide -> FilePath
show :: Slide -> FilePath
$cshowList :: [Slide] -> ShowS
showList :: [Slide] -> ShowS
Show)


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


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


--------------------------------------------------------------------------------
getSlide :: Int -> Presentation -> Maybe Slide
getSlide :: Int -> Presentation -> Maybe Slide
getSlide Int
sidx = (Seq Slide -> Int -> Maybe Slide
forall a. Seq a -> Int -> Maybe a
`Seq.safeIndex` Int
sidx) (Seq Slide -> Maybe Slide)
-> (Presentation -> Seq Slide) -> Presentation -> Maybe Slide
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 -> Instructions Block -> Int
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
(Int -> ActiveFragment -> ShowS)
-> (ActiveFragment -> FilePath)
-> ([ActiveFragment] -> ShowS)
-> Show ActiveFragment
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActiveFragment -> ShowS
showsPrec :: Int -> ActiveFragment -> ShowS
$cshow :: ActiveFragment -> FilePath
show :: ActiveFragment -> FilePath
$cshowList :: [ActiveFragment] -> ShowS
showList :: [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
    ActiveFragment -> Maybe ActiveFragment
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveFragment -> Maybe ActiveFragment)
-> ActiveFragment -> Maybe ActiveFragment
forall a b. (a -> b) -> a -> b
$ case Slide -> SlideContent
slideContent 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


--------------------------------------------------------------------------------
activeSpeakerNotes :: Presentation -> SpeakerNotes.SpeakerNotes
activeSpeakerNotes :: Presentation -> SpeakerNotes
activeSpeakerNotes Presentation
presentation = SpeakerNotes -> Maybe SpeakerNotes -> SpeakerNotes
forall a. a -> Maybe a -> a
fromMaybe SpeakerNotes
forall a. Monoid a => a
mempty (Maybe SpeakerNotes -> SpeakerNotes)
-> Maybe SpeakerNotes -> SpeakerNotes
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
    SpeakerNotes -> Maybe SpeakerNotes
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpeakerNotes -> Maybe SpeakerNotes)
-> SpeakerNotes -> Maybe SpeakerNotes
forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide


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