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

    , MarginSettings (..)
    , Margins (..)
    , margins

    , ExtensionList (..)
    , defaultExtensionList

    , ImageSettings (..)

    , EvalSettingsMap
    , EvalSettings (..)

    , Slide (..)
    , SlideContent (..)
    , Index

    , getSlide
    , numFragments

    , ActiveFragment (..)
    , activeFragment
    , activeSpeakerNotes
    , activeVars

    , getSettings
    , activeSettings

    , Size
    , getPresentationSize

    , updateVar
    ) where


--------------------------------------------------------------------------------
import qualified Data.Aeson.Extended             as A
import qualified Data.HashMap.Strict             as HMS
import qualified Data.HashSet                    as HS
import           Data.Maybe                      (fromMaybe)
import           Data.Sequence.Extended          (Seq)
import qualified Data.Sequence.Extended          as Seq
import           Patat.EncodingFallback          (EncodingFallback)
import qualified Patat.Eval.Internal             as Eval
import           Patat.Presentation.Settings
import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes
import           Patat.Presentation.Syntax
import           Patat.Size
import           Patat.Transition                (TransitionGen)
import           Patat.Unique
import           Prelude
import qualified Skylighting                     as Skylighting
import qualified Text.Pandoc                     as Pandoc


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


--------------------------------------------------------------------------------
data Presentation = Presentation
    { Presentation -> FilePath
pFilePath         :: !FilePath
    , Presentation -> EncodingFallback
pEncodingFallback :: !EncodingFallback
    , Presentation -> [Inline]
pTitle            :: ![Inline]
    , Presentation -> [Inline]
pAuthor           :: ![Inline]
    , Presentation -> PresentationSettings
pSettings         :: !PresentationSettings
    , Presentation -> Seq Slide
pSlides           :: !(Seq Slide)
    , Presentation -> Seq Breadcrumbs
pBreadcrumbs      :: !(Seq Breadcrumbs)            -- One for each slide.
    , Presentation -> Seq PresentationSettings
pSlideSettings    :: !(Seq PresentationSettings)   -- One for each slide.
    , Presentation -> Seq (Maybe TransitionGen)
pTransitionGens   :: !(Seq (Maybe TransitionGen))  -- One for each slide.
    , Presentation -> Index
pActiveFragment   :: !Index
    , Presentation -> SyntaxMap
pSyntaxMap        :: !Skylighting.SyntaxMap
    , Presentation -> EvalBlocks
pEvalBlocks       :: !Eval.EvalBlocks
    , Presentation -> UniqueGen
pUniqueGen        :: !UniqueGen
    , Presentation -> HashMap Var [Block]
pVars             :: !(HMS.HashMap Var [Block])
    }


--------------------------------------------------------------------------------
data Margins = Margins
    { Margins -> AutoOr Int
mTop   :: AutoOr Int
    , Margins -> AutoOr Int
mLeft  :: AutoOr Int
    , Margins -> AutoOr Int
mRight :: AutoOr 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)


--------------------------------------------------------------------------------
margins :: PresentationSettings -> Margins
margins :: PresentationSettings -> Margins
margins PresentationSettings
ps = Margins
    { mLeft :: AutoOr Int
mLeft  = Int
-> (MarginSettings -> Maybe (AutoOr (FlexibleNum Int)))
-> AutoOr Int
forall {a}.
a -> (MarginSettings -> Maybe (AutoOr (FlexibleNum a))) -> AutoOr a
get Int
0 MarginSettings -> Maybe (AutoOr (FlexibleNum Int))
msLeft
    , mRight :: AutoOr Int
mRight = Int
-> (MarginSettings -> Maybe (AutoOr (FlexibleNum Int)))
-> AutoOr Int
forall {a}.
a -> (MarginSettings -> Maybe (AutoOr (FlexibleNum a))) -> AutoOr a
get Int
0 MarginSettings -> Maybe (AutoOr (FlexibleNum Int))
msRight
    , mTop :: AutoOr Int
mTop   = Int
-> (MarginSettings -> Maybe (AutoOr (FlexibleNum Int)))
-> AutoOr Int
forall {a}.
a -> (MarginSettings -> Maybe (AutoOr (FlexibleNum a))) -> AutoOr a
get Int
1 MarginSettings -> Maybe (AutoOr (FlexibleNum Int))
msTop
    }
  where
    get :: a -> (MarginSettings -> Maybe (AutoOr (FlexibleNum a))) -> AutoOr a
get a
def MarginSettings -> Maybe (AutoOr (FlexibleNum a))
f = case PresentationSettings -> Maybe MarginSettings
psMargins PresentationSettings
ps Maybe MarginSettings
-> (MarginSettings -> Maybe (AutoOr (FlexibleNum a)))
-> Maybe (AutoOr (FlexibleNum a))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MarginSettings -> Maybe (AutoOr (FlexibleNum a))
f of
        Just AutoOr (FlexibleNum a)
Auto         -> AutoOr a
forall a. AutoOr a
Auto
        Maybe (AutoOr (FlexibleNum a))
Nothing           -> a -> AutoOr a
forall a. a -> AutoOr a
NotAuto a
def
        Just (NotAuto FlexibleNum a
fn) -> a -> AutoOr a
forall a. a -> AutoOr a
NotAuto (a -> AutoOr a) -> a -> AutoOr a
forall a b. (a -> b) -> a -> b
$ FlexibleNum a -> a
forall a. FlexibleNum a -> a
A.unFlexibleNum FlexibleNum a
fn

--------------------------------------------------------------------------------
data Slide = Slide
    { Slide -> SpeakerNotes
slideSpeakerNotes :: !SpeakerNotes.SpeakerNotes
    , Slide -> Either FilePath PresentationSettings
slideSettings     :: !(Either String PresentationSettings)
    , 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 [Block]
    | TitleSlide   Int [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 [Block]
blocks -> [Block] -> Int
blocksRevealSteps [Block]
blocks
    TitleSlide Int
_ [Inline]
_      -> Int
1


--------------------------------------------------------------------------------
data ActiveFragment
    = ActiveContent
        [Block]
        (HS.HashSet Var)
        RevealState
    | ActiveTitle 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
Header Int
lvl Attr
Pandoc.nullAttr [Inline]
is
        ContentSlide [Block]
blocks ->
            let vars :: HashSet Var
vars = [Block] -> HashSet Var
variables ([Block] -> HashSet Var) -> [Block] -> HashSet Var
forall a b. (a -> b) -> a -> b
$ RevealState -> [Block] -> [Block]
blocksReveal RevealState
revealState [Block]
blocks
                revealState :: RevealState
revealState = Int -> [Block] -> RevealState
blocksRevealStep Int
fidx [Block]
blocks in
            [Block] -> HashSet Var -> RevealState -> ActiveFragment
ActiveContent [Block]
blocks HashSet Var
vars RevealState
revealState


--------------------------------------------------------------------------------
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


--------------------------------------------------------------------------------
activeVars :: Presentation -> HS.HashSet Var
activeVars :: Presentation -> HashSet Var
activeVars Presentation
presentation = case Presentation -> Maybe ActiveFragment
activeFragment Presentation
presentation of
    Just (ActiveContent [Block]
_ HashSet Var
vars RevealState
_) -> HashSet Var
vars
    Maybe ActiveFragment
_                             -> HashSet Var
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
getSettings :: Int -> Presentation -> PresentationSettings
getSettings :: Int -> Presentation -> PresentationSettings
getSettings Int
sidx Presentation
pres =
    PresentationSettings
-> Maybe PresentationSettings -> PresentationSettings
forall a. a -> Maybe a -> a
fromMaybe PresentationSettings
forall a. Monoid a => a
mempty (Seq PresentationSettings -> Int -> Maybe PresentationSettings
forall a. Seq a -> Int -> Maybe a
Seq.safeIndex (Presentation -> Seq PresentationSettings
pSlideSettings Presentation
pres) Int
sidx) PresentationSettings
-> PresentationSettings -> PresentationSettings
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Size -> Int
sRows Size
term) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ 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
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psRows PresentationSettings
settings
        cols :: Int
cols = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Size -> Int
sCols Size
term) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ 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
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
settings
    Size -> IO Size
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> IO Size) -> Size -> IO Size
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


--------------------------------------------------------------------------------
updateVar :: Var -> [Block] -> Presentation -> Presentation
updateVar :: Var -> [Block] -> Presentation -> Presentation
updateVar Var
var [Block]
blocks Presentation
pres = Presentation
pres {pVars = HMS.insert var blocks $ pVars pres}