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


--------------------------------------------------------------------------------
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
    { Slide -> Comment
slideComment :: !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)


--------------------------------------------------------------------------------
-- | Active slide, active fragment.
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