{-# 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.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)
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 !Pandoc.Attr !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 Attr
_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 Attr
attrs Text
body) = [Attr -> Text -> Block
CodeBlock Attr
attrs 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
forall a b. b -> Either a b
Right 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
    ([Inline]
inlines, [[Block]]
blockss) <- [([Inline], [[Block]])]
items
    ([Inline], [[Block]]) -> [([Inline], [[Block]])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> [Inline]
fromPandocInlines [Inline]
inlines, ([Block] -> [Block]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ([Block] -> [Block]
fromPandocBlocks) [[Block]]
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]