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

fragmentInstructions
    :: FragmentSettings
    -> Instructions Pandoc.Block -> Instructions Pandoc.Block
fragmentInstructions :: FragmentSettings -> Instructions Block -> Instructions Block
fragmentInstructions FragmentSettings
fs = [Instruction Block] -> Instructions Block
forall a. [Instruction a] -> Instructions a
fromList ([Instruction Block] -> Instructions Block)
-> (Instructions Block -> [Instruction Block])
-> Instructions Block
-> Instructions Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Instruction Block -> [Instruction Block])
-> [Instruction Block] -> [Instruction Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Instruction Block -> [Instruction Block]
fragmentInstruction ([Instruction Block] -> [Instruction Block])
-> (Instructions Block -> [Instruction Block])
-> Instructions Block
-> [Instruction Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instructions Block -> [Instruction Block]
forall a. Instructions a -> [Instruction a]
toList
  where
    fragmentInstruction :: Instruction Block -> [Instruction Block]
fragmentInstruction Instruction Block
Pause = [Instruction Block
forall a. Instruction a
Pause]
    fragmentInstruction (Append []) = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append []]
    fragmentInstruction (Append [Block]
xs) = FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks FragmentSettings
fs [Block]
xs
    fragmentInstruction Instruction Block
Delete = [Instruction Block
forall a. Instruction a
Delete]
    fragmentInstruction (ModifyLast Instruction Block
f) = (Instruction Block -> Instruction Block)
-> [Instruction Block] -> [Instruction Block]
forall a b. (a -> b) -> [a] -> [b]
map Instruction Block -> Instruction Block
forall a. Instruction a -> Instruction a
ModifyLast ([Instruction Block] -> [Instruction Block])
-> [Instruction Block] -> [Instruction Block]
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 = (Block -> [Instruction Block]) -> [Block] -> [Instruction Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Block -> [Instruction Block]) -> [Block] -> [Instruction Block])
-> (FragmentSettings -> Block -> [Instruction Block])
-> FragmentSettings
-> [Block]
-> [Instruction Block]
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 [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Inline]
threeDots = [Instruction Block
forall a. Instruction a
Pause]
    | Bool
otherwise            = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
  where
    threeDots :: [Inline]
threeDots = Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
intersperse Inline
Pandoc.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
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 (Bool -> Bool) -> Bool -> Bool
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 (Bool -> Bool) -> Bool -> Bool
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 {})     = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]

fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Header {})         = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Plain {})          = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.CodeBlock {})      = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.RawBlock {})       = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.DefinitionList {}) = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Table {})          = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Div {})            = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@Block
Pandoc.HorizontalRule      = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.LineBlock {})      = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock FragmentSettings
_ block :: Block
block@(Pandoc.Figure {})         = [[Block] -> Instruction Block
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 [Instruction Block
forall a. Instruction a
Pause] else []) [Instruction Block] -> [Instruction Block] -> [Instruction Block]
forall a. [a] -> [a] -> [a]
++
    [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [[[Block]] -> Block
constructor []]] [Instruction Block] -> [Instruction Block] -> [Instruction Block]
forall a. [a] -> [a] -> [a]
++
    ((Instruction Block -> Instruction Block)
-> [Instruction Block] -> [Instruction Block]
forall a b. (a -> b) -> [a] -> [b]
map Instruction Block -> Instruction Block
forall a. Instruction a -> Instruction a
ModifyLast ([Instruction Block] -> [Instruction Block])
-> [Instruction Block] -> [Instruction Block]
forall a b. (a -> b) -> a -> b
$
        (if Bool
fragmentThisList then [Instruction Block] -> [[Instruction Block]] -> [Instruction Block]
forall a. [a] -> [[a]] -> [a]
intercalate [Instruction Block
forall a. Instruction a
Pause] else [[Instruction Block]] -> [Instruction Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[Instruction Block]] -> [Instruction Block])
-> [[Instruction Block]] -> [Instruction Block]
forall a b. (a -> b) -> a -> b
$
        ([Block] -> [Instruction Block])
-> [[Block]] -> [[Instruction Block]]
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.
        [Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [] Instruction Block -> [Instruction Block] -> [Instruction Block]
forall a. a -> [a] -> [a]
:
        -- Modify this new item to add the content.
        (Instruction Block -> Instruction Block)
-> [Instruction Block] -> [Instruction Block]
forall a b. (a -> b) -> [a] -> [b]
map Instruction Block -> Instruction Block
forall a. Instruction a -> Instruction a
ModifyLast (FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks FragmentSettings
fs [Block]
item)