{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
module Patat.Presentation.Syntax
    ( Block (..)
    , Inline (..)

    , dftBlocks
    , dftInlines

    , fromPandocBlocks
    , fromPandocInlines

    , isHorizontalRule
    , isComment

    , Var (..)
    , variables

    , RevealID (..)
    , blocksRevealSteps
    , blocksRevealStep
    , blocksRevealLastStep
    , blocksRevealOrder
    , blocksReveal
    , RevealState
    , revealToBlocks

    , RevealWrapper (..)
    , revealWrapper
    , RevealSequence (..)
    ) where

import           Control.Monad.Identity      (runIdentity)
import           Control.Monad.State         (State, execState, modify)
import           Control.Monad.Writer        (Writer, execWriter, tell)
import           Data.CaseInsensitive        (CI)
import qualified Data.CaseInsensitive        as CI
import           Data.Hashable               (Hashable)
import qualified Data.HashSet                as HS
import           Data.List                   (foldl')
import qualified Data.Map                    as M
import           Data.Maybe                  (fromMaybe)
import qualified Data.Set                    as S
import qualified Data.Text                   as T
import qualified Data.Text.Encoding          as T
import           Data.Traversable            (for)
import qualified Data.Yaml                   as Yaml
import           Patat.Presentation.Settings (PresentationSettings,
                                              parseSlideSettings)
import           Patat.Unique
import qualified Text.Pandoc                 as Pandoc
import qualified Text.Pandoc.Writers.Shared  as Pandoc

-- | This is similar to 'Pandoc.Block'.  Having our own datatype has some
-- advantages:
--
-- * We can extend it with slide-specific data (eval, reveals)
-- * We can remove stuff we don't care about
-- * We can parse attributes and move them to haskell datatypes
-- * This conversion can happen in a single parsing phase
-- * We can catch backwards-incompatible pandoc changes in this module
--
-- We try to follow the naming conventions from Pandoc as much as possible.
data Block
    = Plain ![Inline]
    | Para ![Inline]
    | LineBlock ![[Inline]]
    | CodeBlock ![CI T.Text] !T.Text
    | RawBlock !Pandoc.Format !T.Text
    | BlockQuote ![Block]
    | OrderedList !Pandoc.ListAttributes ![[Block]]
    | BulletList ![[Block]]
    | DefinitionList ![([Inline], [[Block]])]
    | Header Int !Pandoc.Attr ![Inline]
    | HorizontalRule
    | Table ![Inline] ![Pandoc.Alignment] ![[Block]] ![[[Block]]]
    | Figure !Pandoc.Attr ![Block]
    | Div !Pandoc.Attr ![Block]
    -- Our own extensions:
    | Reveal !RevealWrapper !(RevealSequence [Block])
    | VarBlock !Var
    | SpeakerNote !T.Text
    | Config !(Either String PresentationSettings)
    deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show)

-- | See comment on 'Block'.
data Inline
    = Str !T.Text
    | Emph ![Inline]
    | Underline ![Inline]
    | Strong ![Inline]
    | Strikeout ![Inline]
    | Superscript ![Inline]
    | Subscript ![Inline]
    | SmallCaps ![Inline]
    | Quoted !Pandoc.QuoteType ![Inline]
    | Cite ![Pandoc.Citation] ![Inline]
    | Code !Pandoc.Attr !T.Text
    | Space
    | SoftBreak
    | LineBreak
    | Math !Pandoc.MathType !T.Text
    | RawInline !Pandoc.Format !T.Text
    | Link !Pandoc.Attr ![Inline] !Pandoc.Target
    | Image !Pandoc.Attr ![Inline] !Pandoc.Target
    | Note ![Block]
    | Span !Pandoc.Attr ![Inline]
    deriving (Inline -> Inline -> Bool
(Inline -> Inline -> Bool)
-> (Inline -> Inline -> Bool) -> Eq Inline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inline -> Inline -> Bool
== :: Inline -> Inline -> Bool
$c/= :: Inline -> Inline -> Bool
/= :: Inline -> Inline -> Bool
Eq, Int -> Inline -> ShowS
[Inline] -> ShowS
Inline -> String
(Int -> Inline -> ShowS)
-> (Inline -> String) -> ([Inline] -> ShowS) -> Show Inline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inline -> ShowS
showsPrec :: Int -> Inline -> ShowS
$cshow :: Inline -> String
show :: Inline -> String
$cshowList :: [Inline] -> ShowS
showList :: [Inline] -> ShowS
Show)

-- | Depth-First Traversal of blocks (and inlines).
dftBlocks
    :: forall m. Monad m
    => (Block -> m [Block])
    -> (Inline -> m [Inline])
    -> [Block] -> m [Block]
dftBlocks :: forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks Block -> m [Block]
fb Inline -> m [Inline]
fi = [Block] -> m [Block]
blocks
  where
    blocks :: [Block] -> m [Block]
    blocks :: [Block] -> m [Block]
blocks = ([[Block]] -> [Block]) -> m [[Block]] -> m [Block]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[Block]] -> m [Block])
-> ([Block] -> m [[Block]]) -> [Block] -> m [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> m [Block]) -> [Block] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Block -> m [Block]
block

    inlines :: [Inline] -> m [Inline]
    inlines :: [Inline] -> m [Inline]
inlines = (Block -> m [Block])
-> (Inline -> m [Inline]) -> [Inline] -> m [Inline]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Inline] -> m [Inline]
dftInlines Block -> m [Block]
fb Inline -> m [Inline]
fi

    block :: Block -> m [Block]
    block :: Block -> m [Block]
block = (m Block -> (Block -> m [Block]) -> m [Block]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Block -> m [Block]
fb) (m Block -> m [Block]) -> (Block -> m Block) -> Block -> m [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Plain [Inline]
xs -> [Inline] -> Block
Plain ([Inline] -> Block) -> m [Inline] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Para [Inline]
xs -> [Inline] -> Block
Para ([Inline] -> Block) -> m [Inline] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        LineBlock [[Inline]]
xss -> [[Inline]] -> Block
LineBlock ([[Inline]] -> Block) -> m [[Inline]] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> m [Inline]) -> [[Inline]] -> m [[Inline]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Inline] -> m [Inline]
inlines [[Inline]]
xss
        b :: Block
b@(CodeBlock [CI Text]
_attr Text
_txt) -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
        b :: Block
b@(RawBlock Format
_fmt Text
_txt) -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
        BlockQuote [Block]
xs -> [Block] -> Block
BlockQuote ([Block] -> Block) -> m [Block] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m [Block]
blocks [Block]
xs
        OrderedList ListAttributes
attr [[Block]]
xss -> ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr ([[Block]] -> Block) -> m [[Block]] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m [Block]) -> [[Block]] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> m [Block]
blocks [[Block]]
xss
        BulletList [[Block]]
xss ->[[Block]] -> Block
BulletList ([[Block]] -> Block) -> m [[Block]] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m [Block]) -> [[Block]] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> m [Block]
blocks [[Block]]
xss
        DefinitionList [([Inline], [[Block]])]
xss -> [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> m [([Inline], [[Block]])] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Inline], [[Block]])]
-> (([Inline], [[Block]]) -> m ([Inline], [[Block]]))
-> m [([Inline], [[Block]])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [([Inline], [[Block]])]
xss
            (\([Inline]
term, [[Block]]
definition) -> (,)
                ([Inline] -> [[Block]] -> ([Inline], [[Block]]))
-> m [Inline] -> m ([[Block]] -> ([Inline], [[Block]]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
term
                m ([[Block]] -> ([Inline], [[Block]]))
-> m [[Block]] -> m ([Inline], [[Block]])
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Block] -> m [Block]) -> [[Block]] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> m [Block]
blocks [[Block]]
definition)
        Header Int
lvl Attr
attr [Inline]
xs -> Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attr ([Inline] -> Block) -> m [Inline] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        b :: Block
b@Block
HorizontalRule -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
        Table [Inline]
cptn [Alignment]
aligns [[Block]]
thead [[[Block]]]
trows -> [Inline] -> [Alignment] -> [[Block]] -> [[[Block]]] -> Block
Table
            ([Inline] -> [Alignment] -> [[Block]] -> [[[Block]]] -> Block)
-> m [Inline]
-> m ([Alignment] -> [[Block]] -> [[[Block]]] -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
cptn
            m ([Alignment] -> [[Block]] -> [[[Block]]] -> Block)
-> m [Alignment] -> m ([[Block]] -> [[[Block]]] -> Block)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Alignment] -> m [Alignment]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Alignment]
aligns
            m ([[Block]] -> [[[Block]]] -> Block)
-> m [[Block]] -> m ([[[Block]]] -> Block)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Block] -> m [Block]) -> [[Block]] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> m [Block]
blocks [[Block]]
thead
            m ([[[Block]]] -> Block) -> m [[[Block]]] -> m Block
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([[Block]] -> m [[Block]]) -> [[[Block]]] -> m [[[Block]]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([Block] -> m [Block]) -> [[Block]] -> m [[Block]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> m [Block]
blocks) [[[Block]]]
trows
        Figure Attr
attr [Block]
xs -> Attr -> [Block] -> Block
Figure Attr
attr ([Block] -> Block) -> m [Block] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m [Block]
blocks [Block]
xs
        Div Attr
attr [Block]
xs -> Attr -> [Block] -> Block
Div Attr
attr ([Block] -> Block) -> m [Block] -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m [Block]
blocks [Block]
xs
        Reveal RevealWrapper
w RevealSequence [Block]
revealer-> RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
w (RevealSequence [Block] -> Block)
-> m (RevealSequence [Block]) -> m Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m [Block])
-> RevealSequence [Block] -> m (RevealSequence [Block])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RevealSequence a -> f (RevealSequence b)
traverse [Block] -> m [Block]
blocks RevealSequence [Block]
revealer
        b :: Block
b@(VarBlock Var
_var) -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
        b :: Block
b@(SpeakerNote Text
_txt) -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
        b :: Block
b@(Config Either String PresentationSettings
_cfg) -> Block -> m Block
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b

-- | Depth-First Traversal of inlines (and blocks).
dftInlines
    :: forall m. Monad m
    => (Block -> m [Block])
    -> (Inline -> m [Inline])
    -> [Inline] -> m [Inline]
dftInlines :: forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Inline] -> m [Inline]
dftInlines Block -> m [Block]
fb Inline -> m [Inline]
fi = [Inline] -> m [Inline]
inlines
  where
    inlines :: [Inline] -> m [Inline]
    inlines :: [Inline] -> m [Inline]
inlines = ([[Inline]] -> [Inline]) -> m [[Inline]] -> m [Inline]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[Inline]] -> m [Inline])
-> ([Inline] -> m [[Inline]]) -> [Inline] -> m [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> m [Inline]) -> [Inline] -> m [[Inline]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Inline -> m [Inline]
inline

    inline :: Inline -> m [Inline]
    inline :: Inline -> m [Inline]
inline = (m Inline -> (Inline -> m [Inline]) -> m [Inline]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inline -> m [Inline]
fi) (m Inline -> m [Inline])
-> (Inline -> m Inline) -> Inline -> m [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        i :: Inline
i@(Str Text
_txt) -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        Emph        [Inline]
xs -> [Inline] -> Inline
Emph        ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Underline   [Inline]
xs -> [Inline] -> Inline
Underline   ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Strong      [Inline]
xs -> [Inline] -> Inline
Strong      ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Strikeout   [Inline]
xs -> [Inline] -> Inline
Strikeout   ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Superscript [Inline]
xs -> [Inline] -> Inline
Superscript ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Subscript   [Inline]
xs -> [Inline] -> Inline
Subscript   ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        SmallCaps   [Inline]
xs -> [Inline] -> Inline
SmallCaps   ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Quoted QuoteType
ty   [Inline]
xs -> QuoteType -> [Inline] -> Inline
Quoted QuoteType
ty   ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        Cite [Citation]
c      [Inline]
xs -> [Citation] -> [Inline] -> Inline
Cite [Citation]
c      ([Inline] -> Inline) -> m [Inline] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs
        i :: Inline
i@(Code Attr
_attr Text
_txt)     -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        i :: Inline
i@Inline
Space                 -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        i :: Inline
i@Inline
SoftBreak             -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        i :: Inline
i@Inline
LineBreak             -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        i :: Inline
i@(Math MathType
_ty Text
_txt)       -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        i :: Inline
i@(RawInline Format
_fmt Text
_txt) -> Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
i
        Link  Attr
attr [Inline]
xs (Text, Text)
tgt -> Attr -> [Inline] -> (Text, Text) -> Inline
Link  Attr
attr ([Inline] -> (Text, Text) -> Inline)
-> m [Inline] -> m ((Text, Text) -> Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs m ((Text, Text) -> Inline) -> m (Text, Text) -> m Inline
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text, Text)
tgt
        Image Attr
attr [Inline]
xs (Text, Text)
tgt -> Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr ([Inline] -> (Text, Text) -> Inline)
-> m [Inline] -> m ((Text, Text) -> Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m [Inline]
inlines [Inline]
xs m ((Text, Text) -> Inline) -> m (Text, Text) -> m Inline
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text, Text)
tgt
        Note [Block]
blocks -> [Block] -> Inline
Note ([Block] -> Inline) -> m [Block] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks Block -> m [Block]
fb Inline -> m [Inline]
fi [Block]
blocks
        Span Attr
attr [Inline]
xs -> Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> Inline)
-> ([[Inline]] -> [Inline]) -> [[Inline]] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Inline]] -> Inline) -> m [[Inline]] -> m Inline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> m [Inline]) -> [Inline] -> m [[Inline]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Inline -> m [Inline]
inline [Inline]
xs

fromPandocBlocks :: [Pandoc.Block] -> [Block]
fromPandocBlocks :: [Block] -> [Block]
fromPandocBlocks = (Block -> [Block]) -> [Block] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Block]
fromPandocBlock

fromPandocBlock :: Pandoc.Block -> [Block]
fromPandocBlock :: Block -> [Block]
fromPandocBlock (Pandoc.Plain [Inline]
xs) = [[Inline] -> Block
Plain ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)]
fromPandocBlock (Pandoc.Para [Inline]
xs) = [[Inline] -> Block
Para ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)]
fromPandocBlock (Pandoc.LineBlock [[Inline]]
xs) =
    [[[Inline]] -> Block
LineBlock (([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [Inline]
fromPandocInlines [[Inline]]
xs)]
fromPandocBlock (Pandoc.CodeBlock (Text
_, [Text]
classes, [(Text, Text)]
_) Text
body) =
    [[CI Text] -> Text -> Block
CodeBlock ((Text -> CI Text) -> [Text] -> [CI Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk [Text]
classes) Text
body]
fromPandocBlock (Pandoc.RawBlock Format
fmt Text
body)
    -- Parse config blocks.
    | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html"
    , Just Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"<!--config:" Text
body
    , Just Text
t2 <- Text -> Text -> Maybe Text
T.stripSuffix Text
"-->" Text
t1 = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ Either String PresentationSettings -> Block
Config (Either String PresentationSettings -> Block)
-> Either String PresentationSettings -> Block
forall a b. (a -> b) -> a -> b
$
        case ByteString -> Either ParseException PresentationSettings
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (Text -> ByteString
T.encodeUtf8 Text
t2) of
            Left ParseException
err  -> String -> Either String PresentationSettings
forall a b. a -> Either a b
Left (ParseException -> String
forall a. Show a => a -> String
show ParseException
err)
            Right PresentationSettings
obj -> PresentationSettings -> Either String PresentationSettings
parseSlideSettings PresentationSettings
obj
    -- Parse other comments.
    | Just Text
t1 <- Text -> Text -> Maybe Text
T.stripPrefix Text
"<!--" Text
body
    , Just Text
t2 <- Text -> Text -> Maybe Text
T.stripSuffix Text
"-->" Text
t1 = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ Text -> Block
SpeakerNote (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t2
    -- Other raw blocks, leave as-is.
    | Bool
otherwise = [Format -> Text -> Block
RawBlock Format
fmt Text
body]
fromPandocBlock (Pandoc.BlockQuote [Block]
blocks) =
    [[Block] -> Block
BlockQuote ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
fromPandocBlocks [Block]
blocks]
fromPandocBlock (Pandoc.OrderedList ListAttributes
attrs [[Block]]
items) =
    [ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attrs ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Block]
fromPandocBlocks [[Block]]
items]
fromPandocBlock (Pandoc.BulletList [[Block]]
items) =
    [[[Block]] -> Block
BulletList ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Block]
fromPandocBlocks [[Block]]
items]
fromPandocBlock (Pandoc.DefinitionList [([Inline], [[Block]])]
items) = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Block
DefinitionList ([([Inline], [[Block]])] -> Block)
-> [([Inline], [[Block]])] -> Block
forall a b. (a -> b) -> a -> b
$ do
    (inlines, blockss) <- [([Inline], [[Block]])]
items
    pure (fromPandocInlines inlines, map (fromPandocBlocks) blockss)
fromPandocBlock (Pandoc.Header Int
lvl Attr
attrs [Inline]
inlines) =
    [Int -> Attr -> [Inline] -> Block
Header Int
lvl Attr
attrs ([Inline] -> [Inline]
fromPandocInlines [Inline]
inlines)]
fromPandocBlock Block
Pandoc.HorizontalRule = [Block
HorizontalRule]
fromPandocBlock (Pandoc.Table Attr
_ Caption
cptn [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Alignment] -> [[Block]] -> [[[Block]]] -> Block
Table
    ([Inline] -> [Inline]
fromPandocInlines [Inline]
cptn')
    [Alignment]
aligns
    (([Block] -> [Block]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ([Block] -> [Block]
fromPandocBlocks) [[Block]]
headers)
    (([[Block]] -> [[Block]]) -> [[[Block]]] -> [[[Block]]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> [Block]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Block]
fromPandocBlocks) [[[Block]]]
rows)
  where
    ([Inline]
cptn', [Alignment]
aligns, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
Pandoc.toLegacyTable
        Caption
cptn [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot

fromPandocBlock (Pandoc.Figure Attr
attrs Caption
_caption [Block]
blocks) =
    [Attr -> [Block] -> Block
Figure Attr
attrs ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
fromPandocBlocks [Block]
blocks]
fromPandocBlock (Pandoc.Div Attr
attrs [Block]
blocks) =
    [Attr -> [Block] -> Block
Div Attr
attrs ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
fromPandocBlocks [Block]
blocks]

fromPandocInlines :: [Pandoc.Inline] -> [Inline]
fromPandocInlines :: [Inline] -> [Inline]
fromPandocInlines = (Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
fromPandocInline

fromPandocInline :: Pandoc.Inline -> [Inline]
fromPandocInline :: Inline -> [Inline]
fromPandocInline Inline
inline = case Inline
inline of
    Pandoc.Str Text
txt           -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inline
Str Text
txt
    Pandoc.Emph        [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Emph        ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Underline   [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Underline   ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Strong      [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strong      ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Strikeout   [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strikeout   ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Superscript [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Superscript ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Subscript   [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Subscript   ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.SmallCaps   [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
SmallCaps   ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Quoted QuoteType
ty   [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ QuoteType -> [Inline] -> Inline
Quoted QuoteType
ty   ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Cite [Citation]
c      [Inline]
xs    -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
Cite [Citation]
c      ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)
    Pandoc.Code Attr
attr Text
txt     -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inline
Code Attr
attr Text
txt
    Inline
Pandoc.Space             -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
Space
    Inline
Pandoc.SoftBreak         -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
SoftBreak
    Inline
Pandoc.LineBreak         -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Inline
LineBreak
    Pandoc.Math MathType
ty Text
txt       -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ MathType -> Text -> Inline
Math MathType
ty Text
txt
    Pandoc.RawInline Format
fmt Text
txt -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Inline
RawInline Format
fmt Text
txt
    Pandoc.Link  Attr
attr [Inline]
xs (Text, Text)
tgt -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Link  Attr
attr ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs) (Text, Text)
tgt
    Pandoc.Image Attr
attr [Inline]
xs (Text, Text)
tgt -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs) (Text, Text)
tgt
    Pandoc.Note [Block]
xs           -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ [Block] -> Inline
Note ([Block] -> [Block]
fromPandocBlocks [Block]
xs)
    Pandoc.Span Attr
attr [Inline]
xs      -> Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> [Inline]) -> Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span Attr
attr ([Inline] -> [Inline]
fromPandocInlines [Inline]
xs)

isHorizontalRule :: Block -> Bool
isHorizontalRule :: Block -> Bool
isHorizontalRule Block
HorizontalRule = Bool
True
isHorizontalRule Block
_              = Bool
False

isComment :: Block -> Bool
isComment :: Block -> Bool
isComment (SpeakerNote Text
_) = Bool
True
isComment (Config Either String PresentationSettings
_)      = Bool
True
isComment Block
_               = Bool
False

-- | A variable is like a placeholder in the instructions, something we don't
-- know yet, dynamic content.  Currently this is only used for code evaluation.
newtype Var = Var Unique deriving (Eq Var
Eq Var => (Int -> Var -> Int) -> (Var -> Int) -> Hashable Var
Int -> Var -> Int
Var -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Var -> Int
hashWithSalt :: Int -> Var -> Int
$chash :: Var -> Int
hash :: Var -> Int
Hashable, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
/= :: Var -> Var -> Bool
Eq, Eq Var
Eq Var =>
(Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Var -> Var -> Ordering
compare :: Var -> Var -> Ordering
$c< :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
>= :: Var -> Var -> Bool
$cmax :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
min :: Var -> Var -> Var
Ord, Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var -> ShowS
showsPrec :: Int -> Var -> ShowS
$cshow :: Var -> String
show :: Var -> String
$cshowList :: [Var] -> ShowS
showList :: [Var] -> ShowS
Show)

-- | Finds all variables that appear in some content.
variables :: [Block] -> HS.HashSet Var
variables :: [Block] -> HashSet Var
variables = Writer (HashSet Var) [Block] -> HashSet Var
forall w a. Writer w a -> w
execWriter (Writer (HashSet Var) [Block] -> HashSet Var)
-> ([Block] -> Writer (HashSet Var) [Block])
-> [Block]
-> HashSet Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Writer (HashSet Var) [Block])
-> (Inline -> WriterT (HashSet Var) Identity [Inline])
-> [Block]
-> Writer (HashSet Var) [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks Block -> Writer (HashSet Var) [Block]
visit ([Inline] -> WriterT (HashSet Var) Identity [Inline]
forall a. a -> WriterT (HashSet Var) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> WriterT (HashSet Var) Identity [Inline])
-> (Inline -> [Inline])
-> Inline
-> WriterT (HashSet Var) Identity [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  where
    visit :: Block -> Writer (HS.HashSet Var) [Block]
    visit :: Block -> Writer (HashSet Var) [Block]
visit Block
b = do
        case Block
b of
            VarBlock Var
var -> HashSet Var -> WriterT (HashSet Var) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (HashSet Var -> WriterT (HashSet Var) Identity ())
-> HashSet Var -> WriterT (HashSet Var) Identity ()
forall a b. (a -> b) -> a -> b
$ Var -> HashSet Var
forall a. Hashable a => a -> HashSet a
HS.singleton Var
var
            Block
_            -> () -> WriterT (HashSet Var) Identity ()
forall a. a -> WriterT (HashSet Var) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        [Block] -> Writer (HashSet Var) [Block]
forall a. a -> WriterT (HashSet Var) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
b]

-- | A counter is used to change state in a slide.  As counters increment,
-- content may deterministically show or hide.
newtype RevealID = RevealID Unique deriving (RevealID -> RevealID -> Bool
(RevealID -> RevealID -> Bool)
-> (RevealID -> RevealID -> Bool) -> Eq RevealID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevealID -> RevealID -> Bool
== :: RevealID -> RevealID -> Bool
$c/= :: RevealID -> RevealID -> Bool
/= :: RevealID -> RevealID -> Bool
Eq, Eq RevealID
Eq RevealID =>
(RevealID -> RevealID -> Ordering)
-> (RevealID -> RevealID -> Bool)
-> (RevealID -> RevealID -> Bool)
-> (RevealID -> RevealID -> Bool)
-> (RevealID -> RevealID -> Bool)
-> (RevealID -> RevealID -> RevealID)
-> (RevealID -> RevealID -> RevealID)
-> Ord RevealID
RevealID -> RevealID -> Bool
RevealID -> RevealID -> Ordering
RevealID -> RevealID -> RevealID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RevealID -> RevealID -> Ordering
compare :: RevealID -> RevealID -> Ordering
$c< :: RevealID -> RevealID -> Bool
< :: RevealID -> RevealID -> Bool
$c<= :: RevealID -> RevealID -> Bool
<= :: RevealID -> RevealID -> Bool
$c> :: RevealID -> RevealID -> Bool
> :: RevealID -> RevealID -> Bool
$c>= :: RevealID -> RevealID -> Bool
>= :: RevealID -> RevealID -> Bool
$cmax :: RevealID -> RevealID -> RevealID
max :: RevealID -> RevealID -> RevealID
$cmin :: RevealID -> RevealID -> RevealID
min :: RevealID -> RevealID -> RevealID
Ord, Int -> RevealID -> ShowS
[RevealID] -> ShowS
RevealID -> String
(Int -> RevealID -> ShowS)
-> (RevealID -> String) -> ([RevealID] -> ShowS) -> Show RevealID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevealID -> ShowS
showsPrec :: Int -> RevealID -> ShowS
$cshow :: RevealID -> String
show :: RevealID -> String
$cshowList :: [RevealID] -> ShowS
showList :: [RevealID] -> ShowS
Show)

-- | A reveal sequence stores content which can be hidden or shown depending on
-- a counter state.
--
-- The easiest example to think about is a bullet list which appears
-- incrmentally on a slide.  Initially, the counter state is 0.  As it is
-- incremented (the user goes to the next fragment in the slide), more list
-- items become visible.
data RevealSequence a = RevealSequence
    { -- The ID used for this sequence.
      forall a. RevealSequence a -> RevealID
rsID      :: RevealID
    , -- These reveals should be advanced in this order.
      -- Reveal IDs will be included multiple times if needed.
      --
      -- This should (only) contain the ID of this counter, and IDs of counters
      -- nested inside the children fields.
      forall a. RevealSequence a -> [RevealID]
rsOrder   :: [RevealID]
    , -- For each piece of content in this sequence, we store a set of ints.
      -- When the current counter state is included in this set, the item is
      -- visible.
      forall a. RevealSequence a -> [(Set Int, a)]
rsVisible :: [(S.Set Int, a)]
    } deriving ((forall m. Monoid m => RevealSequence m -> m)
-> (forall m a. Monoid m => (a -> m) -> RevealSequence a -> m)
-> (forall m a. Monoid m => (a -> m) -> RevealSequence a -> m)
-> (forall a b. (a -> b -> b) -> b -> RevealSequence a -> b)
-> (forall a b. (a -> b -> b) -> b -> RevealSequence a -> b)
-> (forall b a. (b -> a -> b) -> b -> RevealSequence a -> b)
-> (forall b a. (b -> a -> b) -> b -> RevealSequence a -> b)
-> (forall a. (a -> a -> a) -> RevealSequence a -> a)
-> (forall a. (a -> a -> a) -> RevealSequence a -> a)
-> (forall a. RevealSequence a -> [a])
-> (forall a. RevealSequence a -> Bool)
-> (forall a. RevealSequence a -> Int)
-> (forall a. Eq a => a -> RevealSequence a -> Bool)
-> (forall a. Ord a => RevealSequence a -> a)
-> (forall a. Ord a => RevealSequence a -> a)
-> (forall a. Num a => RevealSequence a -> a)
-> (forall a. Num a => RevealSequence a -> a)
-> Foldable RevealSequence
forall a. Eq a => a -> RevealSequence a -> Bool
forall a. Num a => RevealSequence a -> a
forall a. Ord a => RevealSequence a -> a
forall m. Monoid m => RevealSequence m -> m
forall a. RevealSequence a -> Bool
forall a. RevealSequence a -> Int
forall a. RevealSequence a -> [a]
forall a. (a -> a -> a) -> RevealSequence a -> a
forall m a. Monoid m => (a -> m) -> RevealSequence a -> m
forall b a. (b -> a -> b) -> b -> RevealSequence a -> b
forall a b. (a -> b -> b) -> b -> RevealSequence a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RevealSequence m -> m
fold :: forall m. Monoid m => RevealSequence m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RevealSequence a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RevealSequence a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RevealSequence a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RevealSequence a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RevealSequence a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RevealSequence a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RevealSequence a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RevealSequence a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RevealSequence a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RevealSequence a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RevealSequence a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RevealSequence a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RevealSequence a -> a
foldr1 :: forall a. (a -> a -> a) -> RevealSequence a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RevealSequence a -> a
foldl1 :: forall a. (a -> a -> a) -> RevealSequence a -> a
$ctoList :: forall a. RevealSequence a -> [a]
toList :: forall a. RevealSequence a -> [a]
$cnull :: forall a. RevealSequence a -> Bool
null :: forall a. RevealSequence a -> Bool
$clength :: forall a. RevealSequence a -> Int
length :: forall a. RevealSequence a -> Int
$celem :: forall a. Eq a => a -> RevealSequence a -> Bool
elem :: forall a. Eq a => a -> RevealSequence a -> Bool
$cmaximum :: forall a. Ord a => RevealSequence a -> a
maximum :: forall a. Ord a => RevealSequence a -> a
$cminimum :: forall a. Ord a => RevealSequence a -> a
minimum :: forall a. Ord a => RevealSequence a -> a
$csum :: forall a. Num a => RevealSequence a -> a
sum :: forall a. Num a => RevealSequence a -> a
$cproduct :: forall a. Num a => RevealSequence a -> a
product :: forall a. Num a => RevealSequence a -> a
Foldable, (forall a b. (a -> b) -> RevealSequence a -> RevealSequence b)
-> (forall a b. a -> RevealSequence b -> RevealSequence a)
-> Functor RevealSequence
forall a b. a -> RevealSequence b -> RevealSequence a
forall a b. (a -> b) -> RevealSequence a -> RevealSequence b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RevealSequence a -> RevealSequence b
fmap :: forall a b. (a -> b) -> RevealSequence a -> RevealSequence b
$c<$ :: forall a b. a -> RevealSequence b -> RevealSequence a
<$ :: forall a b. a -> RevealSequence b -> RevealSequence a
Functor, RevealSequence a -> RevealSequence a -> Bool
(RevealSequence a -> RevealSequence a -> Bool)
-> (RevealSequence a -> RevealSequence a -> Bool)
-> Eq (RevealSequence a)
forall a. Eq a => RevealSequence a -> RevealSequence a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => RevealSequence a -> RevealSequence a -> Bool
== :: RevealSequence a -> RevealSequence a -> Bool
$c/= :: forall a. Eq a => RevealSequence a -> RevealSequence a -> Bool
/= :: RevealSequence a -> RevealSequence a -> Bool
Eq, Int -> RevealSequence a -> ShowS
[RevealSequence a] -> ShowS
RevealSequence a -> String
(Int -> RevealSequence a -> ShowS)
-> (RevealSequence a -> String)
-> ([RevealSequence a] -> ShowS)
-> Show (RevealSequence a)
forall a. Show a => Int -> RevealSequence a -> ShowS
forall a. Show a => [RevealSequence a] -> ShowS
forall a. Show a => RevealSequence a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RevealSequence a -> ShowS
showsPrec :: Int -> RevealSequence a -> ShowS
$cshow :: forall a. Show a => RevealSequence a -> String
show :: RevealSequence a -> String
$cshowList :: forall a. Show a => [RevealSequence a] -> ShowS
showList :: [RevealSequence a] -> ShowS
Show, Functor RevealSequence
Foldable RevealSequence
(Functor RevealSequence, Foldable RevealSequence) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> RevealSequence a -> f (RevealSequence b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RevealSequence (f a) -> f (RevealSequence a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RevealSequence a -> m (RevealSequence b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RevealSequence (m a) -> m (RevealSequence a))
-> Traversable RevealSequence
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RevealSequence (m a) -> m (RevealSequence a)
forall (f :: * -> *) a.
Applicative f =>
RevealSequence (f a) -> f (RevealSequence a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RevealSequence a -> m (RevealSequence b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RevealSequence a -> f (RevealSequence b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RevealSequence a -> f (RevealSequence b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RevealSequence a -> f (RevealSequence b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RevealSequence (f a) -> f (RevealSequence a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RevealSequence (f a) -> f (RevealSequence a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RevealSequence a -> m (RevealSequence b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RevealSequence a -> m (RevealSequence b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
RevealSequence (m a) -> m (RevealSequence a)
sequence :: forall (m :: * -> *) a.
Monad m =>
RevealSequence (m a) -> m (RevealSequence a)
Traversable)

-- | This determines how we construct content based on the visible items.
-- This could also be represented as `[[Block]] -> [Block]` but then we lose
-- the convenient Eq and Show instances.
data RevealWrapper
    = ConcatWrapper
    | BulletListWrapper
    | OrderedListWrapper Pandoc.ListAttributes
    deriving (RevealWrapper -> RevealWrapper -> Bool
(RevealWrapper -> RevealWrapper -> Bool)
-> (RevealWrapper -> RevealWrapper -> Bool) -> Eq RevealWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevealWrapper -> RevealWrapper -> Bool
== :: RevealWrapper -> RevealWrapper -> Bool
$c/= :: RevealWrapper -> RevealWrapper -> Bool
/= :: RevealWrapper -> RevealWrapper -> Bool
Eq, Int -> RevealWrapper -> ShowS
[RevealWrapper] -> ShowS
RevealWrapper -> String
(Int -> RevealWrapper -> ShowS)
-> (RevealWrapper -> String)
-> ([RevealWrapper] -> ShowS)
-> Show RevealWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevealWrapper -> ShowS
showsPrec :: Int -> RevealWrapper -> ShowS
$cshow :: RevealWrapper -> String
show :: RevealWrapper -> String
$cshowList :: [RevealWrapper] -> ShowS
showList :: [RevealWrapper] -> ShowS
Show)

revealWrapper :: RevealWrapper -> [[Block]] -> [Block]
revealWrapper :: RevealWrapper -> [[Block]] -> [Block]
revealWrapper RevealWrapper
ConcatWrapper             = [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
revealWrapper RevealWrapper
BulletListWrapper         = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> ([[Block]] -> Block) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> Block
BulletList
revealWrapper (OrderedListWrapper ListAttributes
attr) = Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> [Block]) -> ([[Block]] -> Block) -> [[Block]] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr

-- | Number of reveal steps in some blocks.
blocksRevealSteps :: [Block] -> Int
blocksRevealSteps :: [Block] -> Int
blocksRevealSteps = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> ([Block] -> Int) -> [Block] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RevealID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RevealID] -> Int) -> ([Block] -> [RevealID]) -> [Block] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [RevealID]
blocksRevealOrder

-- | Construct the reveal state for a specific step.
blocksRevealStep :: Int -> [Block] -> RevealState
blocksRevealStep :: Int -> [Block] -> RevealState
blocksRevealStep Int
fidx = [RevealID] -> RevealState
makeRevealState ([RevealID] -> RevealState)
-> ([Block] -> [RevealID]) -> [Block] -> RevealState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [RevealID] -> [RevealID]
forall a. Int -> [a] -> [a]
take Int
fidx ([RevealID] -> [RevealID])
-> ([Block] -> [RevealID]) -> [Block] -> [RevealID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [RevealID]
blocksRevealOrder

-- | Construct the final reveal state.
blocksRevealLastStep :: [Block] -> RevealState
blocksRevealLastStep :: [Block] -> RevealState
blocksRevealLastStep = [RevealID] -> RevealState
makeRevealState ([RevealID] -> RevealState)
-> ([Block] -> [RevealID]) -> [Block] -> RevealState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [RevealID]
blocksRevealOrder

-- | This does a deep traversal of some blocks, and returns all reveals that
-- should be advanced in-order.
blocksRevealOrder :: [Block] -> [RevealID]
blocksRevealOrder :: [Block] -> [RevealID]
blocksRevealOrder [Block]
blocks = [[RevealID]] -> [RevealID]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RevealID]] -> [RevealID]) -> [[RevealID]] -> [RevealID]
forall a b. (a -> b) -> a -> b
$
    State [[RevealID]] [Block] -> [[RevealID]] -> [[RevealID]]
forall s a. State s a -> s -> s
execState ((Block -> State [[RevealID]] [Block])
-> (Inline -> StateT [[RevealID]] Identity [Inline])
-> [Block]
-> State [[RevealID]] [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks Block -> State [[RevealID]] [Block]
visit ([Inline] -> StateT [[RevealID]] Identity [Inline]
forall a. a -> StateT [[RevealID]] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> StateT [[RevealID]] Identity [Inline])
-> (Inline -> [Inline])
-> Inline
-> StateT [[RevealID]] Identity [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Block]
blocks) []
  where
    -- We store a [[RevealID]] state, where each list represents the triggers
    -- necessary for a single reveal block.
    visit :: Block -> State [[RevealID]] [Block]
    visit :: Block -> State [[RevealID]] [Block]
visit (Reveal RevealWrapper
w RevealSequence [Block]
rs) = do
        ([[RevealID]] -> [[RevealID]]) -> StateT [[RevealID]] Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([[RevealID]] -> [[RevealID]]) -> StateT [[RevealID]] Identity ())
-> ([[RevealID]] -> [[RevealID]])
-> StateT [[RevealID]] Identity ()
forall a b. (a -> b) -> a -> b
$ RevealSequence [Block] -> [[RevealID]] -> [[RevealID]]
merge RevealSequence [Block]
rs
        [Block] -> State [[RevealID]] [Block]
forall a. a -> StateT [[RevealID]] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
w RevealSequence [Block]
rs]
    visit Block
block = [Block] -> State [[RevealID]] [Block]
forall a. a -> StateT [[RevealID]] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]

    -- When we encounter a new reveal, we want to merge this into our
    -- [[RevealID]] state.  However, we need to ensure to remove any children
    -- of that reveal block that were already in this list.
    merge :: RevealSequence [Block] -> [[RevealID]] -> [[RevealID]]
    merge :: RevealSequence [Block] -> [[RevealID]] -> [[RevealID]]
merge (RevealSequence RevealID
fid [RevealID]
triggers [(Set Int, [Block])]
_) [[RevealID]]
known
        | ([RevealID] -> Bool) -> [[RevealID]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RevealID
fid RevealID -> [RevealID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [[RevealID]]
known = [[RevealID]]
known
        | Bool
otherwise              =
            ([RevealID] -> Bool) -> [[RevealID]] -> [[RevealID]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([RevealID] -> Bool) -> [RevealID] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RevealID -> Bool) -> [RevealID] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RevealID -> [RevealID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RevealID]
triggers)) [[RevealID]]
known [[RevealID]] -> [[RevealID]] -> [[RevealID]]
forall a. [a] -> [a] -> [a]
++ [[RevealID]
triggers]

-- | Stores the state of several counters.
type RevealState = M.Map RevealID Int

-- | Convert a list of counters that need to be triggered to the final state.
makeRevealState :: [RevealID] -> RevealState
makeRevealState :: [RevealID] -> RevealState
makeRevealState = (RevealState -> RevealID -> RevealState)
-> RevealState -> [RevealID] -> RevealState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\RevealState
acc RevealID
x -> (Int -> Int -> Int)
-> RevealID -> Int -> RevealState -> RevealState
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) RevealID
x Int
1 RevealState
acc) RevealState
forall k a. Map k a
M.empty

-- | Render a reveal by applying its constructor to what is visible.
revealToBlocks
    :: RevealState -> RevealWrapper -> RevealSequence [Block] -> [Block]
revealToBlocks :: RevealState -> RevealWrapper -> RevealSequence [Block] -> [Block]
revealToBlocks RevealState
revealState RevealWrapper
rw (RevealSequence RevealID
cid [RevealID]
_ [(Set Int, [Block])]
sections) = RevealWrapper -> [[Block]] -> [Block]
revealWrapper RevealWrapper
rw
    [[Block]
s | (Set Int
activation, [Block]
s) <- [(Set Int, [Block])]
sections, Int
counter Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
activation]
  where
    counter :: Int
counter = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ RevealID -> RevealState -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RevealID
cid RevealState
revealState

-- | Apply `revealToBlocks` recursively at each position, removing reveals
-- in favor of their currently visible content.
blocksReveal :: RevealState -> [Block] -> [Block]
blocksReveal :: RevealState -> [Block] -> [Block]
blocksReveal RevealState
revealState = Identity [Block] -> [Block]
forall a. Identity a -> a
runIdentity (Identity [Block] -> [Block])
-> ([Block] -> Identity [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Identity [Block])
-> (Inline -> Identity [Inline]) -> [Block] -> Identity [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks Block -> Identity [Block]
forall {f :: * -> *}. Applicative f => Block -> f [Block]
visit ([Inline] -> Identity [Inline]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> Identity [Inline])
-> (Inline -> [Inline]) -> Inline -> Identity [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> [Inline]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  where
    visit :: Block -> f [Block]
visit (Reveal RevealWrapper
w RevealSequence [Block]
rs) = [Block] -> f [Block]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> f [Block]) -> [Block] -> f [Block]
forall a b. (a -> b) -> a -> b
$ RevealState -> RevealWrapper -> RevealSequence [Block] -> [Block]
revealToBlocks RevealState
revealState RevealWrapper
w RevealSequence [Block]
rs
    visit Block
block         = [Block] -> f [Block]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]