{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Patat.Presentation.Settings
( PresentationSettings (..)
, defaultPresentationSettings
, MarginSettings (..)
, ExtensionList (..)
, defaultExtensionList
, ImageSettings (..)
, EvalSettingsMap
, EvalSettings (..)
, SpeakerNotesSettings (..)
, TransitionSettings (..)
) 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 qualified Data.Text as T
import qualified Patat.Theme as Theme
import Prelude
import qualified Text.Pandoc as Pandoc
import Text.Read (readMaybe)
data PresentationSettings = PresentationSettings
{ PresentationSettings -> Maybe (FlexibleNum Int)
psRows :: !(Maybe (A.FlexibleNum Int))
, PresentationSettings -> Maybe (FlexibleNum Int)
psColumns :: !(Maybe (A.FlexibleNum Int))
, PresentationSettings -> Maybe MarginSettings
psMargins :: !(Maybe MarginSettings)
, 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 SpeakerNotesSettings
psSpeakerNotes :: !(Maybe SpeakerNotesSettings)
, PresentationSettings -> Maybe TransitionSettings
psTransition :: !(Maybe TransitionSettings)
} deriving (Int -> PresentationSettings -> ShowS
[PresentationSettings] -> ShowS
PresentationSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PresentationSettings] -> ShowS
$cshowList :: [PresentationSettings] -> ShowS
show :: PresentationSettings -> FilePath
$cshow :: PresentationSettings -> FilePath
showsPrec :: Int -> PresentationSettings -> ShowS
$cshowsPrec :: Int -> PresentationSettings -> ShowS
Show)
instance Semigroup PresentationSettings where
PresentationSettings
l <> :: PresentationSettings
-> PresentationSettings -> PresentationSettings
<> PresentationSettings
r = PresentationSettings
{ psRows :: Maybe (FlexibleNum Int)
psRows = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psRows PresentationSettings
l PresentationSettings
r
, psColumns :: Maybe (FlexibleNum Int)
psColumns = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
l PresentationSettings
r
, psMargins :: Maybe MarginSettings
psMargins = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>) PresentationSettings -> Maybe MarginSettings
psMargins PresentationSettings
l PresentationSettings
r
, psWrap :: Maybe Bool
psWrap = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psWrap PresentationSettings
l PresentationSettings
r
, psTheme :: Maybe Theme
psTheme = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>) PresentationSettings -> Maybe Theme
psTheme PresentationSettings
l PresentationSettings
r
, psIncrementalLists :: Maybe Bool
psIncrementalLists = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
l PresentationSettings
r
, psAutoAdvanceDelay :: Maybe (FlexibleNum Int)
psAutoAdvanceDelay = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay PresentationSettings
l PresentationSettings
r
, psSlideLevel :: Maybe Int
psSlideLevel = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Int
psSlideLevel PresentationSettings
l PresentationSettings
r
, psPandocExtensions :: Maybe ExtensionList
psPandocExtensions = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe ExtensionList
psPandocExtensions PresentationSettings
l PresentationSettings
r
, psImages :: Maybe ImageSettings
psImages = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe ImageSettings
psImages PresentationSettings
l PresentationSettings
r
, psBreadcrumbs :: Maybe Bool
psBreadcrumbs = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psBreadcrumbs PresentationSettings
l PresentationSettings
r
, psEval :: Maybe EvalSettingsMap
psEval = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>) PresentationSettings -> Maybe EvalSettingsMap
psEval PresentationSettings
l PresentationSettings
r
, psSlideNumber :: Maybe Bool
psSlideNumber = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe Bool
psSlideNumber PresentationSettings
l PresentationSettings
r
, psSyntaxDefinitions :: Maybe [FilePath]
psSyntaxDefinitions = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Semigroup a => a -> a -> a
(<>) PresentationSettings -> Maybe [FilePath]
psSyntaxDefinitions PresentationSettings
l PresentationSettings
r
, psSpeakerNotes :: Maybe SpeakerNotesSettings
psSpeakerNotes = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe SpeakerNotesSettings
psSpeakerNotes PresentationSettings
l PresentationSettings
r
, psTransition :: Maybe TransitionSettings
psTransition = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus PresentationSettings -> Maybe TransitionSettings
psTransition PresentationSettings
l PresentationSettings
r
}
instance Monoid PresentationSettings where
mappend :: PresentationSettings
-> PresentationSettings -> PresentationSettings
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mempty :: PresentationSettings
mempty = Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int)
-> Maybe MarginSettings
-> Maybe Bool
-> Maybe Theme
-> Maybe Bool
-> Maybe (FlexibleNum Int)
-> Maybe Int
-> Maybe ExtensionList
-> Maybe ImageSettings
-> Maybe Bool
-> Maybe EvalSettingsMap
-> Maybe Bool
-> Maybe [FilePath]
-> Maybe SpeakerNotesSettings
-> Maybe TransitionSettings
-> PresentationSettings
PresentationSettings
forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall a. Maybe a
Nothing forall a. Maybe a
Nothing
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = forall a. Monoid a => a
mempty
{ psMargins :: Maybe MarginSettings
psMargins = forall a. Maybe a
Nothing
, psTheme :: Maybe Theme
psTheme = forall a. a -> Maybe a
Just Theme
Theme.defaultTheme
}
data MarginSettings = MarginSettings
{ MarginSettings -> Maybe (FlexibleNum Int)
msTop :: !(Maybe (A.FlexibleNum Int))
, MarginSettings -> Maybe (FlexibleNum Int)
msLeft :: !(Maybe (A.FlexibleNum Int))
, MarginSettings -> Maybe (FlexibleNum Int)
msRight :: !(Maybe (A.FlexibleNum Int))
} deriving (Int -> MarginSettings -> ShowS
[MarginSettings] -> ShowS
MarginSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MarginSettings] -> ShowS
$cshowList :: [MarginSettings] -> ShowS
show :: MarginSettings -> FilePath
$cshow :: MarginSettings -> FilePath
showsPrec :: Int -> MarginSettings -> ShowS
$cshowsPrec :: Int -> MarginSettings -> ShowS
Show)
instance Semigroup MarginSettings where
MarginSettings
l <> :: MarginSettings -> MarginSettings -> MarginSettings
<> MarginSettings
r = MarginSettings
{ msTop :: Maybe (FlexibleNum Int)
msTop = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus MarginSettings -> Maybe (FlexibleNum Int)
msTop MarginSettings
l MarginSettings
r
, msLeft :: Maybe (FlexibleNum Int)
msLeft = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus MarginSettings -> Maybe (FlexibleNum Int)
msLeft MarginSettings
l MarginSettings
r
, msRight :: Maybe (FlexibleNum Int)
msRight = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus MarginSettings -> Maybe (FlexibleNum Int)
msRight MarginSettings
l MarginSettings
r
}
instance Monoid MarginSettings where
mappend :: MarginSettings -> MarginSettings -> MarginSettings
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mempty :: MarginSettings
mempty = Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int)
-> Maybe (FlexibleNum Int)
-> MarginSettings
MarginSettings forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
newtype ExtensionList = ExtensionList {ExtensionList -> Extensions
unExtensionList :: Pandoc.Extensions}
deriving (Int -> ExtensionList -> ShowS
[ExtensionList] -> ShowS
ExtensionList -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionList] -> ShowS
$cshowList :: [ExtensionList] -> ShowS
show :: ExtensionList -> FilePath
$cshow :: ExtensionList -> FilePath
showsPrec :: Int -> ExtensionList -> ShowS
$cshowsPrec :: Int -> ExtensionList -> ShowS
Show)
instance A.FromJSON ExtensionList where
parseJSON :: Value -> Parser ExtensionList
parseJSON = forall a. FilePath -> (Array -> Parser a) -> Value -> Parser a
A.withArray FilePath
"FromJSON ExtensionList" forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extensions -> ExtensionList
ExtensionList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser Extensions
parseExt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
where
parseExt :: Value -> Parser Extensions
parseExt = forall a. FilePath -> (Text -> Parser a) -> Value -> Parser a
A.withText FilePath
"FromJSON ExtensionList" forall a b. (a -> b) -> a -> b
$ \Text
txt -> case Text
txt of
Text
"patat_extensions" -> forall (m :: * -> *) a. Monad m => a -> m a
return (ExtensionList -> Extensions
unExtensionList ExtensionList
defaultExtensionList)
Text
_ -> case forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath
"Ext_" forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
txt) of
Just Extension
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Extension] -> Extensions
Pandoc.extensionsFromList [Extension
e]
Maybe Extension
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
FilePath
"Unknown extension: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Text
txt forall a. [a] -> [a] -> [a]
++
FilePath
", known extensions are: " forall a. [a] -> [a] -> [a]
++
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) [Extension]
allExts)
where
allExts :: [Extension]
allExts = Extensions -> [Extension]
Pandoc.extensionsToList forall a b. (a -> b) -> a -> b
$
Text -> Extensions
Pandoc.getAllExtensions Text
"markdown"
defaultExtensionList :: ExtensionList
defaultExtensionList :: ExtensionList
defaultExtensionList = Extensions -> ExtensionList
ExtensionList forall a b. (a -> b) -> a -> b
$
ReaderOptions -> Extensions
Pandoc.readerExtensions forall a. Default a => a
Pandoc.def forall a. Monoid a => a -> a -> a
`mappend` [Extension] -> Extensions
Pandoc.extensionsFromList
[ Extension
Pandoc.Ext_yaml_metadata_block
, Extension
Pandoc.Ext_table_captions
, Extension
Pandoc.Ext_simple_tables
, Extension
Pandoc.Ext_multiline_tables
, Extension
Pandoc.Ext_grid_tables
, Extension
Pandoc.Ext_pipe_tables
, Extension
Pandoc.Ext_raw_html
, Extension
Pandoc.Ext_tex_math_dollars
, Extension
Pandoc.Ext_fenced_code_blocks
, Extension
Pandoc.Ext_fenced_code_attributes
, Extension
Pandoc.Ext_backtick_code_blocks
, Extension
Pandoc.Ext_inline_code_attributes
, Extension
Pandoc.Ext_fancy_lists
, Extension
Pandoc.Ext_four_space_rule
, Extension
Pandoc.Ext_definition_lists
, Extension
Pandoc.Ext_compact_definition_lists
, Extension
Pandoc.Ext_example_lists
, Extension
Pandoc.Ext_strikeout
, Extension
Pandoc.Ext_superscript
, Extension
Pandoc.Ext_subscript
]
data ImageSettings = ImageSettings
{ ImageSettings -> Text
isBackend :: !T.Text
, ImageSettings -> Object
isParams :: !A.Object
} deriving (Int -> ImageSettings -> ShowS
[ImageSettings] -> ShowS
ImageSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImageSettings] -> ShowS
$cshowList :: [ImageSettings] -> ShowS
show :: ImageSettings -> FilePath
$cshow :: ImageSettings -> FilePath
showsPrec :: Int -> ImageSettings -> ShowS
$cshowsPrec :: Int -> ImageSettings -> ShowS
Show)
instance A.FromJSON ImageSettings where
parseJSON :: Value -> Parser ImageSettings
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON ImageSettings" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
t <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"backend"
forall (m :: * -> *) a. Monad m => a -> m a
return ImageSettings {isBackend :: Text
isBackend = Text
t, isParams :: Object
isParams = Object
o}
type EvalSettingsMap = HMS.HashMap T.Text EvalSettings
data EvalSettings = EvalSettings
{ EvalSettings -> Text
evalCommand :: !T.Text
, EvalSettings -> Bool
evalReplace :: !Bool
, EvalSettings -> Bool
evalFragment :: !Bool
} deriving (Int -> EvalSettings -> ShowS
[EvalSettings] -> ShowS
EvalSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EvalSettings] -> ShowS
$cshowList :: [EvalSettings] -> ShowS
show :: EvalSettings -> FilePath
$cshow :: EvalSettings -> FilePath
showsPrec :: Int -> EvalSettings -> ShowS
$cshowsPrec :: Int -> EvalSettings -> ShowS
Show)
instance A.FromJSON EvalSettings where
parseJSON :: Value -> Parser EvalSettings
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON EvalSettings" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> EvalSettings
EvalSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"command"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"replace" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
False
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"fragment" forall a. Parser (Maybe a) -> a -> Parser a
A..!= Bool
True
data SpeakerNotesSettings = SpeakerNotesSettings
{ SpeakerNotesSettings -> FilePath
snsFile :: !FilePath
} deriving (Int -> SpeakerNotesSettings -> ShowS
[SpeakerNotesSettings] -> ShowS
SpeakerNotesSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SpeakerNotesSettings] -> ShowS
$cshowList :: [SpeakerNotesSettings] -> ShowS
show :: SpeakerNotesSettings -> FilePath
$cshow :: SpeakerNotesSettings -> FilePath
showsPrec :: Int -> SpeakerNotesSettings -> ShowS
$cshowsPrec :: Int -> SpeakerNotesSettings -> ShowS
Show)
data TransitionSettings = TransitionSettings
{ TransitionSettings -> Text
tsType :: !T.Text
, TransitionSettings -> Object
tsParams :: !A.Object
} deriving (Int -> TransitionSettings -> ShowS
[TransitionSettings] -> ShowS
TransitionSettings -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TransitionSettings] -> ShowS
$cshowList :: [TransitionSettings] -> ShowS
show :: TransitionSettings -> FilePath
$cshow :: TransitionSettings -> FilePath
showsPrec :: Int -> TransitionSettings -> ShowS
$cshowsPrec :: Int -> TransitionSettings -> ShowS
Show)
instance A.FromJSON TransitionSettings where
parseJSON :: Value -> Parser TransitionSettings
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON TransitionSettings" forall a b. (a -> b) -> a -> b
$ \Object
o ->
Text -> Object -> TransitionSettings
TransitionSettings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"type" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
o
$(A.deriveFromJSON A.dropPrefixOptions ''MarginSettings)
$(A.deriveFromJSON A.dropPrefixOptions ''SpeakerNotesSettings)
$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)