-- | 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 (..)

    , fragmentInstructions
    , fragmentBlocks
    , fragmentBlock
    ) where

import           Data.List                      (intersperse, intercalate)
import           Patat.Presentation.Instruction
import           Prelude
import qualified Text.Pandoc                    as Pandoc

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

fragmentInstructions
    :: FragmentSettings
    -> Instructions Pandoc.Block -> Instructions Pandoc.Block
fragmentInstructions :: FragmentSettings -> Instructions Block -> Instructions Block
fragmentInstructions FragmentSettings
fs = forall a. [Instruction a] -> Instructions a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Instruction Block -> [Instruction Block]
fragmentInstruction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Instructions a -> [Instruction a]
toList
  where
    fragmentInstruction :: Instruction Block -> [Instruction Block]
fragmentInstruction Instruction Block
Pause = [forall a. Instruction a
Pause]
    fragmentInstruction (Append []) = [forall a. [a] -> Instruction a
Append []]
    fragmentInstruction (Append [Block]
xs) = FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks FragmentSettings
fs [Block]
xs
    fragmentInstruction Instruction Block
Delete = [forall a. Instruction a
Delete]
    fragmentInstruction (ModifyLast Instruction Block
f) = forall a b. (a -> b) -> [a] -> [b]
map forall a. Instruction a -> Instruction a
ModifyLast forall a b. (a -> b) -> a -> b
$ Instruction Block -> [Instruction Block]
fragmentInstruction Instruction Block
f

fragmentBlocks
    :: FragmentSettings -> [Pandoc.Block] -> [Instruction Pandoc.Block]
fragmentBlocks :: FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragmentSettings -> Block -> [Instruction Block]
fragmentBlock

fragmentBlock :: FragmentSettings -> Pandoc.Block -> [Instruction Pandoc.Block]
fragmentBlock :: FragmentSettings -> Block -> [Instruction Block]
fragmentBlock FragmentSettings
_fs block :: Block
block@(Pandoc.Para [Inline]
inlines)
    | [Inline]
inlines forall a. Eq a => a -> a -> Bool
== [Inline]
threeDots = [forall a. Instruction a
Pause]
    | Bool
otherwise            = [forall a. [a] -> Instruction a
Append [Block
block]]
  where
    threeDots :: [Inline]
threeDots = forall a. a -> [a] -> [a]
intersperse Inline
Pandoc.Space forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
3 (Text -> Inline
Pandoc.Str Text
".")

fragmentBlock FragmentSettings
fs (Pandoc.BulletList [[Block]]
bs0) =
    FragmentSettings
-> Bool -> ([[Block]] -> Block) -> [[Block]] -> [Instruction Block]
fragmentList FragmentSettings
fs (FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) [[Block]] -> Block
Pandoc.BulletList [[Block]]
bs0

fragmentBlock FragmentSettings
fs (Pandoc.OrderedList ListAttributes
attr [[Block]]
bs0) =
    FragmentSettings
-> Bool -> ([[Block]] -> Block) -> [[Block]] -> [Instruction Block]
fragmentList FragmentSettings
fs (FragmentSettings -> Bool
fsIncrementalLists FragmentSettings
fs) (ListAttributes -> [[Block]] -> Block
Pandoc.OrderedList ListAttributes
attr) [[Block]]
bs0

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

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

fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.BlockQuote {})     = [forall a. [a] -> Instruction a
Append [Block
block]]

fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Header {})         = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Plain {})          = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.CodeBlock {})      = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.RawBlock {})       = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.DefinitionList {}) = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Table {})          = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Div {})            = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@Block
Pandoc.HorizontalRule      = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.LineBlock {})      = [forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Figure {})         = [forall a. [a] -> Instruction a
Append [Block
block]]

fragmentList
    :: FragmentSettings                    -- ^ Global settings
    -> Bool                                -- ^ Fragment THIS list?
    -> ([[Pandoc.Block]] -> Pandoc.Block)  -- ^ List constructor
    -> [[Pandoc.Block]]                    -- ^ List items
    -> [Instruction Pandoc.Block]          -- ^ Resulting list
fragmentList :: FragmentSettings
-> Bool -> ([[Block]] -> Block) -> [[Block]] -> [Instruction Block]
fragmentList FragmentSettings
fs Bool
fragmentThisList [[Block]] -> Block
constructor [[Block]]
items =
    -- Insert the new list, initially empty.
    (if Bool
fragmentThisList then [forall a. Instruction a
Pause] else []) forall a. [a] -> [a] -> [a]
++
    [forall a. [a] -> Instruction a
Append [[[Block]] -> Block
constructor []]] forall a. [a] -> [a] -> [a]
++
    (forall a b. (a -> b) -> [a] -> [b]
map forall a. Instruction a -> Instruction a
ModifyLast forall a b. (a -> b) -> a -> b
$
        (if Bool
fragmentThisList then forall a. [a] -> [[a]] -> [a]
intercalate [forall a. Instruction a
Pause] else forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map [Block] -> [Instruction Block]
fragmentItem [[Block]]
items)
  where
    -- The fragmented list per list item.
    fragmentItem :: [Pandoc.Block] -> [Instruction Pandoc.Block]
    fragmentItem :: [Block] -> [Instruction Block]
fragmentItem [Block]
item =
        -- Append a new item to the list so we can start adding
        -- content there.
        forall a. [a] -> Instruction a
Append [] forall a. a -> [a] -> [a]
:
        -- Modify this new item to add the content.
        forall a b. (a -> b) -> [a] -> [b]
map forall a. Instruction a -> Instruction a
ModifyLast (FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks FragmentSettings
fs [Block]
item)