{-# 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)
, 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)
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
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)
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
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)
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)