{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Patat.Presentation.Internal
( Breadcrumbs
, Presentation (..)
, PresentationSettings (..)
, defaultPresentationSettings
, MarginSettings (..)
, Margins (..)
, margins
, ExtensionList (..)
, defaultExtensionList
, ImageSettings (..)
, EvalSettingsMap
, EvalSettings (..)
, Slide (..)
, SlideContent (..)
, Instruction.Fragment (..)
, Index
, getSlide
, numFragments
, ActiveFragment (..)
, activeFragment
, activeSpeakerNotes
, getSettings
, activeSettings
, Size
, getPresentationSize
) where
import qualified Data.Aeson.Extended as A
import Data.Maybe (fromMaybe)
import Data.Sequence.Extended (Seq)
import qualified Data.Sequence.Extended as Seq
import Patat.EncodingFallback (EncodingFallback)
import qualified Patat.Presentation.Comments as Comments
import qualified Patat.Presentation.Instruction as Instruction
import Patat.Presentation.Settings
import Patat.Size
import Patat.Transition (TransitionGen)
import Prelude
import qualified Skylighting as Skylighting
import qualified Text.Pandoc as Pandoc
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 -> Seq PresentationSettings
pSlideSettings :: !(Seq PresentationSettings)
, Presentation -> Seq (Maybe TransitionGen)
pTransitionGens :: !(Seq (Maybe TransitionGen))
, Presentation -> Index
pActiveFragment :: !Index
, Presentation -> SyntaxMap
pSyntaxMap :: !Skylighting.SyntaxMap
}
data Margins = Margins
{ Margins -> Int
mTop :: Int
, Margins -> Int
mLeft :: Int
, Margins -> Int
mRight :: Int
} deriving (Int -> Margins -> ShowS
[Margins] -> ShowS
Margins -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Margins] -> ShowS
$cshowList :: [Margins] -> ShowS
show :: Margins -> FilePath
$cshow :: Margins -> FilePath
showsPrec :: Int -> Margins -> ShowS
$cshowsPrec :: Int -> Margins -> ShowS
Show)
margins :: PresentationSettings -> Margins
margins :: PresentationSettings -> Margins
margins PresentationSettings
ps = Margins
{ mLeft :: Int
mLeft = forall {c}. c -> (MarginSettings -> Maybe (FlexibleNum c)) -> c
get Int
0 MarginSettings -> Maybe (FlexibleNum Int)
msLeft
, mRight :: Int
mRight = forall {c}. c -> (MarginSettings -> Maybe (FlexibleNum c)) -> c
get Int
0 MarginSettings -> Maybe (FlexibleNum Int)
msRight
, mTop :: Int
mTop = forall {c}. c -> (MarginSettings -> Maybe (FlexibleNum c)) -> c
get Int
1 MarginSettings -> Maybe (FlexibleNum Int)
msTop
}
where
get :: c -> (MarginSettings -> Maybe (FlexibleNum c)) -> c
get c
def MarginSettings -> Maybe (FlexibleNum c)
f = forall a. a -> Maybe a -> a
fromMaybe c
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. FlexibleNum a -> a
A.unFlexibleNum forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe MarginSettings
psMargins PresentationSettings
ps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarginSettings -> Maybe (FlexibleNum c)
f
data Slide = Slide
{ :: !Comments.Comment
, Slide -> SlideContent
slideContent :: !SlideContent
} deriving (Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Slide] -> ShowS
$cshowList :: [Slide] -> ShowS
show :: Slide -> FilePath
$cshow :: Slide -> FilePath
showsPrec :: Int -> Slide -> ShowS
$cshowsPrec :: Int -> Slide -> ShowS
Show)
data SlideContent
= ContentSlide (Instruction.Instructions Pandoc.Block)
| TitleSlide Int [Pandoc.Inline]
deriving (Int -> SlideContent -> ShowS
[SlideContent] -> ShowS
SlideContent -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SlideContent] -> ShowS
$cshowList :: [SlideContent] -> ShowS
show :: SlideContent -> FilePath
$cshow :: SlideContent -> FilePath
showsPrec :: Int -> SlideContent -> ShowS
$cshowsPrec :: Int -> SlideContent -> ShowS
Show)
type Index = (Int, Int)
getSlide :: Int -> Presentation -> Maybe Slide
getSlide :: Int -> Presentation -> Maybe Slide
getSlide Int
sidx = (forall a. Seq a -> Int -> Maybe a
`Seq.safeIndex` Int
sidx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Presentation -> Seq Slide
pSlides
numFragments :: Slide -> Int
numFragments :: Slide -> Int
numFragments Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
ContentSlide Instructions Block
instrs -> forall a. Instructions a -> Int
Instruction.numFragments Instructions Block
instrs
TitleSlide Int
_ [Inline]
_ -> Int
1
data ActiveFragment
= ActiveContent Instruction.Fragment
| ActiveTitle Pandoc.Block
deriving (Int -> ActiveFragment -> ShowS
[ActiveFragment] -> ShowS
ActiveFragment -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ActiveFragment] -> ShowS
$cshowList :: [ActiveFragment] -> ShowS
show :: ActiveFragment -> FilePath
$cshow :: ActiveFragment -> FilePath
showsPrec :: Int -> ActiveFragment -> ShowS
$cshowsPrec :: Int -> ActiveFragment -> ShowS
Show)
activeFragment :: Presentation -> Maybe ActiveFragment
activeFragment :: Presentation -> Maybe ActiveFragment
activeFragment Presentation
presentation = do
let (Int
sidx, Int
fidx) = Presentation -> Index
pActiveFragment Presentation
presentation
Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Slide -> SlideContent
slideContent Slide
slide of
TitleSlide Int
lvl [Inline]
is -> Block -> ActiveFragment
ActiveTitle forall a b. (a -> b) -> a -> b
$
Int -> Attr -> [Inline] -> Block
Pandoc.Header Int
lvl Attr
Pandoc.nullAttr [Inline]
is
ContentSlide Instructions Block
instrs -> Fragment -> ActiveFragment
ActiveContent forall a b. (a -> b) -> a -> b
$
Int -> Instructions Block -> Fragment
Instruction.renderFragment Int
fidx Instructions Block
instrs
activeSpeakerNotes :: Presentation -> Comments.SpeakerNotes
activeSpeakerNotes :: Presentation -> SpeakerNotes
activeSpeakerNotes Presentation
presentation = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ do
let (Int
sidx, Int
_) = Presentation -> Index
pActiveFragment Presentation
presentation
Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SpeakerNotes
Comments.cSpeakerNotes forall a b. (a -> b) -> a -> b
$ Slide -> Comment
slideComment Slide
slide
getSettings :: Int -> Presentation -> PresentationSettings
getSettings :: Int -> Presentation -> PresentationSettings
getSettings Int
sidx Presentation
pres =
forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (forall a. Seq a -> Int -> Maybe a
Seq.safeIndex (Presentation -> Seq PresentationSettings
pSlideSettings Presentation
pres) Int
sidx) forall a. Semigroup a => a -> a -> a
<>
Presentation -> PresentationSettings
pSettings Presentation
pres
activeSettings :: Presentation -> PresentationSettings
activeSettings :: Presentation -> PresentationSettings
activeSettings Presentation
pres =
let (Int
sidx, Int
_) = Presentation -> Index
pActiveFragment Presentation
pres in Int -> Presentation -> PresentationSettings
getSettings Int
sidx Presentation
pres
getPresentationSize :: Presentation -> IO Size
getPresentationSize :: Presentation -> IO Size
getPresentationSize Presentation
pres = do
Size
term <- IO Size
getTerminalSize
let rows :: Int
rows = forall a. a -> Maybe a -> a
fromMaybe (Size -> Int
sRows Size
term) forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psRows PresentationSettings
settings
cols :: Int
cols = forall a. a -> Maybe a -> a
fromMaybe (Size -> Int
sCols Size
term) forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Size {sRows :: Int
sRows = Int
rows, sCols :: Int
sCols = Int
cols}
where
settings :: PresentationSettings
settings = Presentation -> PresentationSettings
activeSettings Presentation
pres