-- | 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
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 fs :: 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 Pause = [Instruction Block
forall a. Instruction a
Pause]
    fragmentInstruction (Append []) = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append []]
    fragmentInstruction (Append xs :: [Block]
xs) = FragmentSettings -> [Block] -> [Instruction Block]
fragmentBlocks FragmentSettings
fs [Block]
xs
    fragmentInstruction Delete = [Instruction Block
forall a. Instruction a
Delete]
    fragmentInstruction (ModifyLast f :: 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 _fs :: FragmentSettings
_fs block :: Block
block@(Pandoc.Para inlines :: [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 3 (Text -> Inline
Pandoc.Str ".")

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

fragmentBlock fs :: FragmentSettings
fs (Pandoc.OrderedList attr :: ListAttributes
attr bs0 :: [[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 fs :: FragmentSettings
fs (Pandoc.BlockQuote [Pandoc.BulletList bs0 :: [[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 fs :: FragmentSettings
fs (Pandoc.BlockQuote [Pandoc.OrderedList attr :: ListAttributes
attr bs0 :: [[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 _ block :: Block
block@(Pandoc.BlockQuote _)     = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]

fragmentBlock _ block :: Block
block@(Pandoc.Header _ _ _)     = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.Plain _)          = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.CodeBlock _ _)    = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.RawBlock _ _)     = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.DefinitionList _) = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.Table _ _ _ _ _)  = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.Div _ _)          = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@Block
Pandoc.HorizontalRule     = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@Block
Pandoc.Null               = [[Block] -> Instruction Block
forall a. [a] -> Instruction a
Append [Block
block]]
fragmentBlock _ block :: Block
block@(Pandoc.LineBlock _)      = [[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 fs :: FragmentSettings
fs fragmentThisList :: Bool
fragmentThisList constructor :: [[Block]] -> Block
constructor items :: [[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 item :: [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)