--------------------------------------------------------------------------------
{-# 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
    , 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 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)            -- 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 -> VarGen
pVarGen           :: !Instruction.VarGen
    , Presentation -> HashMap Var [Block]
pVars             :: !(HMS.HashMap Instruction.Var [Pandoc.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 -> Comment
slideComment :: !Comments.Comment
    , 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
$
            (Var -> [Block]) -> Instructions Block -> Fragment
Instruction.renderFragment Var -> [Block]
resolve (Instructions Block -> Fragment) -> Instructions Block -> Fragment
forall a b. (a -> b) -> a -> b
$
            Int -> Instructions Block -> Instructions Block
forall a. Int -> Instructions a -> Instructions a
Instruction.beforePause Int
fidx Instructions Block
instrs
  where
    resolve :: Var -> [Block]
resolve Var
var = [Block] -> Maybe [Block] -> [Block]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Block] -> [Block]) -> Maybe [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Var -> HashMap Var [Block] -> Maybe [Block]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Var
var (Presentation -> HashMap Var [Block]
pVars Presentation
presentation)


--------------------------------------------------------------------------------
activeSpeakerNotes :: Presentation -> Comments.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)
-> (Comment -> SpeakerNotes) -> Comment -> Maybe SpeakerNotes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment -> SpeakerNotes
Comments.cSpeakerNotes (Comment -> Maybe SpeakerNotes) -> Comment -> Maybe SpeakerNotes
forall a b. (a -> b) -> a -> b
$ Slide -> Comment
slideComment Slide
slide


--------------------------------------------------------------------------------
activeVars :: Presentation -> HS.HashSet Instruction.Var
activeVars :: Presentation -> HashSet Var
activeVars Presentation
presentation = HashSet Var -> Maybe (HashSet Var) -> HashSet Var
forall a. a -> Maybe a -> a
fromMaybe HashSet Var
forall a. HashSet a
HS.empty (Maybe (HashSet Var) -> HashSet Var)
-> Maybe (HashSet Var) -> HashSet Var
forall a b. (a -> b) -> a -> b
$ do
    let (Int
sidx, Int
fidx) = Presentation -> Index
pActiveFragment Presentation
presentation
    Slide
slide <- Int -> Presentation -> Maybe Slide
getSlide Int
sidx Presentation
presentation
    case Slide -> SlideContent
slideContent Slide
slide of
        TitleSlide Int
_ [Inline]
_ -> Maybe (HashSet Var)
forall a. Maybe a
Nothing
        ContentSlide Instructions Block
instrs -> HashSet Var -> Maybe (HashSet Var)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashSet Var -> Maybe (HashSet Var))
-> HashSet Var -> Maybe (HashSet Var)
forall a b. (a -> b) -> a -> b
$ Instructions Block -> HashSet Var
forall a. Instructions a -> HashSet Var
Instruction.variables (Instructions Block -> HashSet Var)
-> Instructions Block -> HashSet Var
forall a b. (a -> b) -> a -> b
$
            Int -> Instructions Block -> Instructions Block
forall a. Int -> Instructions a -> Instructions a
Instruction.beforePause Int
fidx Instructions Block
instrs


--------------------------------------------------------------------------------
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 :: Instruction.Var -> [Pandoc.Block] -> Presentation -> Presentation
updateVar :: Var -> [Block] -> Presentation -> Presentation
updateVar Var
var [Block]
blocks Presentation
pres = Presentation
pres {pVars = HMS.insert var blocks $ pVars pres}