-- | For background info on the spec, see the "Incremental lists" section of the
-- the pandoc manual.
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
module Patat.Presentation.Fragment
    ( FragmentSettings (..)

    , fragmentPresentation
    , fragmentBlocks
    , fragmentBlock
    ) where

import           Control.Monad.State         (State, runState, state)
import           Data.List                   (intersperse)
import           Data.Maybe                  (fromMaybe)
import qualified Data.Set                    as S
import           Patat.Presentation.Internal
import           Patat.Presentation.Syntax
import           Patat.Unique
import           Prelude

fragmentPresentation :: Presentation -> Presentation
fragmentPresentation :: Presentation -> Presentation
fragmentPresentation Presentation
presentation =
    let (Presentation
pres, UniqueGen
uniqueGen) = State UniqueGen Presentation
-> UniqueGen -> (Presentation, UniqueGen)
forall s a. State s a -> s -> (a, s)
runState State UniqueGen Presentation
work (Presentation -> UniqueGen
pUniqueGen Presentation
presentation) in
    Presentation
pres {pUniqueGen = uniqueGen}
  where
    work :: State UniqueGen Presentation
work = do
        Seq Slide
slides <- (Slide -> StateT UniqueGen Identity Slide)
-> Seq Slide -> StateT UniqueGen Identity (Seq Slide)
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) -> Seq a -> f (Seq b)
traverse Slide -> StateT UniqueGen Identity Slide
fragmentSlide (Presentation -> Seq Slide
pSlides Presentation
presentation)
        Presentation -> State UniqueGen Presentation
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Presentation
presentation {pSlides = slides}

    fragmentSlide :: Slide -> StateT UniqueGen Identity Slide
fragmentSlide Slide
slide = case Slide -> SlideContent
slideContent Slide
slide of
        TitleSlide   Int
_ [Inline]
_     -> Slide -> StateT UniqueGen Identity Slide
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide
        ContentSlide [Block]
blocks0 -> do
            [Block]
blocks1 <- FragmentSettings -> [Block] -> FragmentM [Block]
fragmentBlocks FragmentSettings
fragmentSettings [Block]
blocks0
            Slide -> StateT UniqueGen Identity Slide
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slide
slide {slideContent = ContentSlide blocks1}

    settings :: PresentationSettings
settings = Presentation -> PresentationSettings
pSettings Presentation
presentation
    fragmentSettings :: FragmentSettings
fragmentSettings = FragmentSettings
        { fsIncrementalLists :: Bool
fsIncrementalLists = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (PresentationSettings -> Maybe Bool
psIncrementalLists PresentationSettings
settings)
        }

data FragmentSettings = FragmentSettings
    { FragmentSettings -> Bool
fsIncrementalLists :: !Bool
    } deriving (Int -> FragmentSettings -> ShowS
[FragmentSettings] -> ShowS
FragmentSettings -> String
(Int -> FragmentSettings -> ShowS)
-> (FragmentSettings -> String)
-> ([FragmentSettings] -> ShowS)
-> Show FragmentSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FragmentSettings -> ShowS
showsPrec :: Int -> FragmentSettings -> ShowS
$cshow :: FragmentSettings -> String
show :: FragmentSettings -> String
$cshowList :: [FragmentSettings] -> ShowS
showList :: [FragmentSettings] -> ShowS
Show)

type FragmentM = State UniqueGen

splitOnThreeDots :: [Block] -> [[Block]]
splitOnThreeDots :: [Block] -> [[Block]]
splitOnThreeDots [Block]
blocks = case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Block -> Block -> Bool
forall a. Eq a => a -> a -> Bool
== Block
threeDots) [Block]
blocks of
    ([Block]
pre, Block
_ : [Block]
post) -> [[Block]
pre] [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block] -> [[Block]]
splitOnThreeDots [Block]
post
    ([Block]
pre, [])       -> [[Block]
pre]
  where
    threeDots :: Block
threeDots = [Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
intersperse Inline
Space ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Int -> Inline -> [Inline]
forall a. Int -> a -> [a]
replicate Int
3 (Text -> Inline
Str Text
".")

fragmentBlocks
    :: FragmentSettings -> [Block] -> FragmentM [Block]
fragmentBlocks :: FragmentSettings -> [Block] -> FragmentM [Block]
fragmentBlocks FragmentSettings
fs [Block]
blocks = (FragmentM [Block]
-> ([Block] -> FragmentM [Block]) -> FragmentM [Block]
forall a b.
StateT UniqueGen Identity a
-> (a -> StateT UniqueGen Identity b)
-> StateT UniqueGen Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Block] -> FragmentM [Block]
fragmentAgainAfterLists) (FragmentM [Block] -> FragmentM [Block])
-> FragmentM [Block] -> FragmentM [Block]
forall a b. (a -> b) -> a -> b
$
    case [Block] -> [[Block]]
splitOnThreeDots [Block]
blocks of
        [] -> [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        [[Block]
_] -> [[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Block]] -> [Block])
-> StateT UniqueGen Identity [[Block]] -> FragmentM [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> FragmentM [Block])
-> [Block] -> StateT UniqueGen Identity [[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 (FragmentSettings -> Block -> FragmentM [Block]
fragmentBlock FragmentSettings
fs) [Block]
blocks
        sections0 :: [[Block]]
sections0@([Block]
_ : [[Block]]
_) -> do
            RevealID
revealID <- Unique -> RevealID
RevealID (Unique -> RevealID)
-> StateT UniqueGen Identity Unique
-> StateT UniqueGen Identity RevealID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen Identity Unique
forall a.
(UniqueGen -> (a, UniqueGen)) -> StateT UniqueGen Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
            [[Block]]
sections1 <- ([Block] -> FragmentM [Block])
-> [[Block]] -> StateT UniqueGen Identity [[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 (FragmentSettings -> [Block] -> FragmentM [Block]
fragmentBlocks FragmentSettings
fs) [[Block]]
sections0
            let pauses :: Int
pauses = [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
sections1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                triggers :: [RevealID]
triggers = case [[Block]]
sections1 of
                    [] -> Int -> RevealID -> [RevealID]
forall a. Int -> a -> [a]
replicate Int
pauses RevealID
revealID
                    ([Block]
sh : [[Block]]
st) -> [Block] -> [RevealID]
blocksRevealOrder [Block]
sh [RevealID] -> [RevealID] -> [RevealID]
forall a. [a] -> [a] -> [a]
++
                        [RevealID
c | [Block]
s <- [[Block]]
st, RevealID
c <- RevealID
revealID RevealID -> [RevealID] -> [RevealID]
forall a. a -> [a] -> [a]
: [Block] -> [RevealID]
blocksRevealOrder [Block]
s]
            [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> FragmentM [Block]) -> [Block] -> FragmentM [Block]
forall a b. (a -> b) -> a -> b
$ 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
$ RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
ConcatWrapper (RevealSequence [Block] -> Block)
-> RevealSequence [Block] -> Block
forall a b. (a -> b) -> a -> b
$ RevealID
-> [RevealID] -> [(Set Int, [Block])] -> RevealSequence [Block]
forall a.
RevealID -> [RevealID] -> [(Set Int, a)] -> RevealSequence a
RevealSequence
                RevealID
revealID
                [RevealID]
triggers
                [([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
i .. Int
pauses], [Block]
s) | (Int
i, [Block]
s) <- [Int] -> [[Block]] -> [(Int, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [[Block]]
sections1]

fragmentBlock :: FragmentSettings -> Block -> FragmentM [Block]
fragmentBlock :: FragmentSettings -> Block -> FragmentM [Block]
fragmentBlock FragmentSettings
_fs (Para [Inline]
inlines) = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Inline] -> Block
Para [Inline]
inlines]

fragmentBlock FragmentSettings
fs (BulletList [[Block]]
bs0) =
    FragmentSettings
-> Bool -> RevealWrapper -> [[Block]] -> FragmentM [Block]
fragmentList FragmentSettings
fs (FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) RevealWrapper
BulletListWrapper [[Block]]
bs0

fragmentBlock FragmentSettings
fs (OrderedList ListAttributes
attr [[Block]]
bs0) =
    FragmentSettings
-> Bool -> RevealWrapper -> [[Block]] -> FragmentM [Block]
fragmentList FragmentSettings
fs (FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) (ListAttributes -> RevealWrapper
OrderedListWrapper ListAttributes
attr) [[Block]]
bs0

fragmentBlock FragmentSettings
fs (BlockQuote [BulletList [[Block]]
bs0]) =
    FragmentSettings
-> Bool -> RevealWrapper -> [[Block]] -> FragmentM [Block]
fragmentList FragmentSettings
fs (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) RevealWrapper
BulletListWrapper [[Block]]
bs0

fragmentBlock FragmentSettings
fs (BlockQuote [OrderedList ListAttributes
attr [[Block]]
bs0]) =
    FragmentSettings
-> Bool -> RevealWrapper -> [[Block]] -> FragmentM [Block]
fragmentList FragmentSettings
fs (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) (ListAttributes -> RevealWrapper
OrderedListWrapper ListAttributes
attr) [[Block]]
bs0

fragmentBlock FragmentSettings
_ block :: Block
block@(BlockQuote {})     = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]

fragmentBlock FragmentSettings
_ block :: Block
block@(Header {})         = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Plain {})          = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(CodeBlock {})      = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(RawBlock {})       = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(DefinitionList {}) = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Table {})          = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Div {})            = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@Block
HorizontalRule      = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(LineBlock {})      = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Figure {})         = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(VarBlock {})       = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(SpeakerNote {})    = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Config {})         = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]
fragmentBlock FragmentSettings
_ block :: Block
block@(Reveal {})         = [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block
block]  -- Should not happen

fragmentList
    :: FragmentSettings   -- ^ Global settings
    -> Bool               -- ^ Fragment THIS list?
    -> RevealWrapper      -- ^ List constructor
    -> [[Block]]          -- ^ List items
    -> FragmentM [Block]  -- ^ Resulting list
fragmentList :: FragmentSettings
-> Bool -> RevealWrapper -> [[Block]] -> FragmentM [Block]
fragmentList FragmentSettings
fs Bool
fragmentThisList RevealWrapper
rw [[Block]]
items0 = do
    [[Block]]
items1 <- ([Block] -> FragmentM [Block])
-> [[Block]] -> StateT UniqueGen Identity [[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 (FragmentSettings -> [Block] -> FragmentM [Block]
fragmentBlocks FragmentSettings
fs) [[Block]]
items0
    case Bool
fragmentThisList of
        Bool
False -> [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> FragmentM [Block]) -> [Block] -> FragmentM [Block]
forall a b. (a -> b) -> a -> b
$ RevealWrapper -> [[Block]] -> [Block]
revealWrapper RevealWrapper
rw [[Block]]
items1
        Bool
True -> do
            RevealID
revealID <- Unique -> RevealID
RevealID (Unique -> RevealID)
-> StateT UniqueGen Identity Unique
-> StateT UniqueGen Identity RevealID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen Identity Unique
forall a.
(UniqueGen -> (a, UniqueGen)) -> StateT UniqueGen Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
            let triggers :: [RevealID]
triggers = [RevealID
c | [Block]
s <- [[Block]]
items1, RevealID
c <- RevealID
revealID RevealID -> [RevealID] -> [RevealID]
forall a. a -> [a] -> [a]
: [Block] -> [RevealID]
blocksRevealOrder [Block]
s]
                pauses :: Int
pauses   = [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items1
            [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> FragmentM [Block]) -> [Block] -> FragmentM [Block]
forall a b. (a -> b) -> a -> b
$ 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
$ RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
rw (RevealSequence [Block] -> Block)
-> RevealSequence [Block] -> Block
forall a b. (a -> b) -> a -> b
$ RevealID
-> [RevealID] -> [(Set Int, [Block])] -> RevealSequence [Block]
forall a.
RevealID -> [RevealID] -> [(Set Int, a)] -> RevealSequence a
RevealSequence
                RevealID
revealID
                [RevealID]
triggers
                [ ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
i .. Int
pauses], [Block]
s)
                | (Int
i, [Block]
s) <- [Int] -> [[Block]] -> [(Int, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [[Block]]
items1
                ]

-- Insert a final pause after any incremental lists.  This needs to happen
-- on the list containing these blocks.
fragmentAgainAfterLists :: [Block] -> FragmentM [Block]
fragmentAgainAfterLists :: [Block] -> FragmentM [Block]
fragmentAgainAfterLists [Block]
blocks = case [Block] -> [Block] -> [[Block]]
splitAfterLists [] [Block]
blocks of
    [] -> [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    [[Block]
_] -> [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block]
blocks
    sections :: [[Block]]
sections@([Block]
_ : [[Block]]
_) -> do
        RevealID
revealID <- Unique -> RevealID
RevealID (Unique -> RevealID)
-> StateT UniqueGen Identity Unique
-> StateT UniqueGen Identity RevealID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UniqueGen -> (Unique, UniqueGen))
-> StateT UniqueGen Identity Unique
forall a.
(UniqueGen -> (a, UniqueGen)) -> StateT UniqueGen Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state UniqueGen -> (Unique, UniqueGen)
freshUnique
        let pauses :: Int
pauses = [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
sections Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            triggers :: [RevealID]
triggers = [RevealID] -> [RevealID]
forall a. HasCallStack => [a] -> [a]
init
                -- Use init to skip the final counter (we don't want to add
                -- a pause at the very end since everything is displayed at
                -- that point).
                [RevealID
c | [Block]
s <- [[Block]]
sections, RevealID
c <- [Block] -> [RevealID]
blocksRevealOrder [Block]
s [RevealID] -> [RevealID] -> [RevealID]
forall a. [a] -> [a] -> [a]
++ [RevealID
revealID]]
        [Block] -> FragmentM [Block]
forall a. a -> StateT UniqueGen Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> FragmentM [Block]) -> [Block] -> FragmentM [Block]
forall a b. (a -> b) -> a -> b
$ 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
$ RevealWrapper -> RevealSequence [Block] -> Block
Reveal RevealWrapper
ConcatWrapper (RevealSequence [Block] -> Block)
-> RevealSequence [Block] -> Block
forall a b. (a -> b) -> a -> b
$ RevealID
-> [RevealID] -> [(Set Int, [Block])] -> RevealSequence [Block]
forall a.
RevealID -> [RevealID] -> [(Set Int, a)] -> RevealSequence a
RevealSequence
            RevealID
revealID
            [RevealID]
triggers
            [([Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList [Int
i .. Int
pauses Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1], [Block]
s) | (Int
i, [Block]
s) <- [Int] -> [[Block]] -> [(Int, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [[Block]]
sections]
  where
    splitAfterLists :: [Block] -> [Block] -> [[Block]]
    splitAfterLists :: [Block] -> [Block] -> [[Block]]
splitAfterLists [Block]
acc [] = [[Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
acc]
    splitAfterLists [Block]
acc (b :: Block
b@(Reveal RevealWrapper
w RevealSequence [Block]
_) : [Block]
bs)
        | RevealWrapper -> Bool
isListWrapper RevealWrapper
w, Bool -> Bool
not ([Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
bs) =
            [Block] -> [Block]
forall a. [a] -> [a]
reverse (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
acc) [Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
: [Block] -> [Block] -> [[Block]]
splitAfterLists [] [Block]
bs
    splitAfterLists [Block]
acc (Block
b : [Block]
bs) = [Block] -> [Block] -> [[Block]]
splitAfterLists (Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
bs

    isListWrapper :: RevealWrapper -> Bool
isListWrapper RevealWrapper
BulletListWrapper = Bool
True
    isListWrapper (OrderedListWrapper ListAttributes
_) = Bool
True
    isListWrapper RevealWrapper
ConcatWrapper = Bool
False