--------------------------------------------------------------------------------
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Patat.Presentation.Display
    ( Display (..)
    , displayPresentation
    , displayPresentationError
    , dumpPresentation
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                        (guard)
import           Control.Monad.Identity               (runIdentity)
import           Control.Monad.Writer                 (Writer, execWriter, tell)
import qualified Data.Aeson.Extended                  as A
import           Data.Char.WCWidth.Extended           (wcstrwidth)
import           Data.Foldable                        (for_)
import qualified Data.HashMap.Strict                  as HMS
import qualified Data.List                            as L
import           Data.Maybe                           (fromMaybe, maybeToList)
import qualified Data.Sequence.Extended               as Seq
import qualified Data.Text                            as T
import           Patat.Presentation.Display.CodeBlock
import           Patat.Presentation.Display.Internal
import           Patat.Presentation.Display.Table
import           Patat.Presentation.Internal
import           Patat.Presentation.Settings
import qualified Patat.Presentation.SpeakerNotes      as SpeakerNotes
import           Patat.Presentation.Syntax
import           Patat.PrettyPrint                    ((<$$>), (<+>))
import qualified Patat.PrettyPrint                    as PP
import           Patat.Size
import           Patat.Theme                          (Theme (..))
import qualified Patat.Theme                          as Theme
import           Prelude
import qualified Text.Pandoc.Extended                 as Pandoc


--------------------------------------------------------------------------------
data Display = DisplayDoc PP.Doc | DisplayImage FilePath deriving (Int -> Display -> ShowS
[Display] -> ShowS
Display -> [Char]
(Int -> Display -> ShowS)
-> (Display -> [Char]) -> ([Display] -> ShowS) -> Show Display
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Display -> ShowS
showsPrec :: Int -> Display -> ShowS
$cshow :: Display -> [Char]
show :: Display -> [Char]
$cshowList :: [Display] -> ShowS
showList :: [Display] -> ShowS
Show)


--------------------------------------------------------------------------------
-- | Display something within the presentation borders that draw the title and
-- the active slide number and so on.
displayWithBorders
    :: Size -> Presentation -> (DisplaySettings -> PP.Doc) -> PP.Doc
displayWithBorders :: Size -> Presentation -> (DisplaySettings -> Doc) -> Doc
displayWithBorders (Size Int
rows Int
columns) pres :: Presentation
pres@Presentation {[Char]
[Inline]
Index
HashMap Var [Block]
EvalBlocks
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
UniqueGen
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pSlideSettings :: Seq PresentationSettings
pTransitionGens :: Seq (Maybe TransitionGen)
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
pEvalBlocks :: EvalBlocks
pUniqueGen :: UniqueGen
pVars :: HashMap Var [Block]
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlideSettings :: Presentation -> Seq PresentationSettings
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pEvalBlocks :: Presentation -> EvalBlocks
pUniqueGen :: Presentation -> UniqueGen
pVars :: Presentation -> HashMap Var [Block]
..} DisplaySettings -> Doc
f =
    (if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
title
        then Doc
forall a. Monoid a => a
mempty
        else
            let titleRemainder :: Int
titleRemainder = Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
titleWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
titleOffset
                wrappedTitle :: Doc
wrappedTitle = Int -> Doc
PP.spaces Int
titleOffset Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
title Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
PP.spaces Int
titleRemainder in
        Doc -> Doc
borders Doc
wrappedTitle Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    DisplaySettings -> Doc
f DisplaySettings
ds Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    Int -> Doc
PP.goToLine (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    Doc -> Doc
borders (Doc
PP.space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
author Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
middleSpaces Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
active Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.space) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    Doc
PP.hardline
  where
    -- Get terminal width/title
    settings :: PresentationSettings
settings     = Presentation -> PresentationSettings
activeSettings Presentation
pres
    (Int
sidx, Int
_)    = Index
pActiveFragment
    ds :: DisplaySettings
ds           = DisplaySettings
        { dsSize :: Size
dsSize          = Size
canvasSize
        , dsMargins :: Margins
dsMargins       = PresentationSettings -> Margins
margins PresentationSettings
settings
        , dsWrap :: Wrap
dsWrap          = Wrap -> Maybe Wrap -> Wrap
forall a. a -> Maybe a -> a
fromMaybe Wrap
NoWrap (Maybe Wrap -> Wrap) -> Maybe Wrap -> Wrap
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Wrap
psWrap PresentationSettings
settings
        , dsTabStop :: Int
dsTabStop       = Int -> (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
4 FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (Maybe (FlexibleNum Int) -> Int) -> Maybe (FlexibleNum Int) -> Int
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe (FlexibleNum Int)
psTabStop PresentationSettings
settings
        , dsTheme :: Theme
dsTheme         = Theme -> Maybe Theme -> Theme
forall a. a -> Maybe a -> a
fromMaybe Theme
Theme.defaultTheme (PresentationSettings -> Maybe Theme
psTheme PresentationSettings
settings)
        , dsSyntaxMap :: SyntaxMap
dsSyntaxMap     = SyntaxMap
pSyntaxMap
        , dsResolve :: Var -> [Block]
dsResolve       = \Var
var -> [Block] -> Maybe [Block] -> [Block]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Block] -> [Block]) -> Maybe [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Var -> HashMap Var [Block] -> Maybe [Block]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Var
var HashMap Var [Block]
pVars
        , dsRevealState :: RevealState
dsRevealState   = RevealState
revealState
        }

    revealState :: RevealState
revealState = case Presentation -> Maybe ActiveFragment
activeFragment Presentation
pres of
        Just (ActiveContent [Block]
_ HashSet Var
_ RevealState
c) -> RevealState
c
        Maybe ActiveFragment
_                          -> RevealState
forall a. Monoid a => a
mempty

    -- Compute title.
    breadcrumbs :: Breadcrumbs
breadcrumbs = Breadcrumbs -> Maybe Breadcrumbs -> Breadcrumbs
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Breadcrumbs -> Breadcrumbs)
-> Maybe Breadcrumbs -> Breadcrumbs
forall a b. (a -> b) -> a -> b
$ Seq Breadcrumbs -> Int -> Maybe Breadcrumbs
forall a. Seq a -> Int -> Maybe a
Seq.safeIndex Seq Breadcrumbs
pBreadcrumbs Int
sidx
    plainTitle :: [Char]
plainTitle  = Doc -> [Char]
PP.toString (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
pTitle
    breadTitle :: [Char]
breadTitle  = [Char] -> ShowS
forall a. Monoid a => a -> a -> a
mappend [Char]
plainTitle ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
        [ [Char]
s
        | Doc
b <- ((Int, [Inline]) -> Doc) -> Breadcrumbs -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds ([Inline] -> Doc)
-> ((Int, [Inline]) -> [Inline]) -> (Int, [Inline]) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Inline]) -> [Inline]
forall a b. (a, b) -> b
snd) Breadcrumbs
breadcrumbs
        , [Char]
s <- [[Char]
" > ", Doc -> [Char]
PP.toString Doc
b]
        ]
    title :: [Char]
title
        | Bool -> Bool
not (Bool -> Bool) -> (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Bool
psBreadcrumbs PresentationSettings
settings = [Char]
plainTitle
        | [Char] -> Int
wcstrwidth [Char]
breadTitle Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
columns               = [Char]
plainTitle
        | Bool
otherwise                                     = [Char]
breadTitle

    -- Dimensions of title.
    titleWidth :: Int
titleWidth  = [Char] -> Int
wcstrwidth [Char]
title
    titleOffset :: Int
titleOffset = (Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
titleWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    borders :: Doc -> Doc
borders     = DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBorders

    -- Room left for content
    canvasSize :: Size
canvasSize = Int -> Int -> Size
Size (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) Int
columns

    -- Compute footer.
    active :: [Char]
active
        | Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Bool
psSlideNumber PresentationSettings
settings = Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
sidx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" / " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Seq Slide -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Slide
pSlides)
        | Bool
otherwise                               = [Char]
""
    activeWidth :: Int
activeWidth  = [Char] -> Int
wcstrwidth [Char]
active
    author :: [Char]
author       = Doc -> [Char]
PP.toString (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
pAuthor)
    authorWidth :: Int
authorWidth  = [Char] -> Int
wcstrwidth [Char]
author
    middleSpaces :: Doc
middleSpaces = Int -> Doc
PP.spaces (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
activeWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
authorWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2


--------------------------------------------------------------------------------
displayPresentation :: Size -> Presentation -> Display
displayPresentation :: Size -> Presentation -> Display
displayPresentation Size
size pres :: Presentation
pres@Presentation {[Char]
[Inline]
Index
HashMap Var [Block]
EvalBlocks
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
UniqueGen
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlideSettings :: Presentation -> Seq PresentationSettings
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pEvalBlocks :: Presentation -> EvalBlocks
pUniqueGen :: Presentation -> UniqueGen
pVars :: Presentation -> HashMap Var [Block]
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pSlideSettings :: Seq PresentationSettings
pTransitionGens :: Seq (Maybe TransitionGen)
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
pEvalBlocks :: EvalBlocks
pUniqueGen :: UniqueGen
pVars :: HashMap Var [Block]
..} =
     case Presentation -> Maybe ActiveFragment
activeFragment Presentation
pres of
        Maybe ActiveFragment
Nothing -> Doc -> Display
DisplayDoc (Doc -> Display) -> Doc -> Display
forall a b. (a -> b) -> a -> b
$ Size -> Presentation -> (DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres DisplaySettings -> Doc
forall a. Monoid a => a
mempty
        Just (ActiveContent [Block]
fragment HashSet Var
_ RevealState
_)
                | Just ImageSettings
_ <- PresentationSettings -> Maybe ImageSettings
psImages PresentationSettings
pSettings
                , Just Text
image <- [Block] -> Maybe Text
onlyImage [Block]
fragment ->
            [Char] -> Display
DisplayImage ([Char] -> Display) -> [Char] -> Display
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
image
        Just (ActiveContent [Block]
fragment HashSet Var
_ RevealState
_) -> Doc -> Display
DisplayDoc (Doc -> Display) -> Doc -> Display
forall a b. (a -> b) -> a -> b
$
            Size -> Presentation -> (DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((DisplaySettings -> Doc) -> Doc)
-> (DisplaySettings -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \DisplaySettings
theme ->
                DisplaySettings -> [Block] -> Doc
prettyMargins DisplaySettings
theme [Block]
fragment
        Just (ActiveTitle Block
block) -> Doc -> Display
DisplayDoc (Doc -> Display) -> Doc -> Display
forall a b. (a -> b) -> a -> b
$
            Size -> Presentation -> (DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((DisplaySettings -> Doc) -> Doc)
-> (DisplaySettings -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \DisplaySettings
ds ->
                let auto :: Margins
auto = Margins {mTop :: AutoOr Int
mTop = AutoOr Int
forall a. AutoOr a
Auto, mRight :: AutoOr Int
mRight = AutoOr Int
forall a. AutoOr a
Auto, mLeft :: AutoOr Int
mLeft = AutoOr Int
forall a. AutoOr a
Auto} in
                DisplaySettings -> [Block] -> Doc
prettyMargins DisplaySettings
ds {dsMargins = auto} [Block
block]
  where
    -- Check if the fragment consists of "just a single image".  Discard
    -- headers.
    onlyImage :: [Block] -> Maybe Text
onlyImage (Header{} : [Block]
bs) = [Block] -> Maybe Text
onlyImage [Block]
bs
    onlyImage [Block]
bs = case [Block]
bs of
        [Figure Attr
_ [Block]
bs']                 -> [Block] -> Maybe Text
onlyImage [Block]
bs'
        [Para [Image Attr
_ [Inline]
_ (Text
target, Text
_)]] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
target
        [Block]
_                              -> Maybe Text
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- | Displays an error in the place of the presentation.  This is useful if we
-- want to display an error but keep the presentation running.
displayPresentationError :: Size -> Presentation -> String -> PP.Doc
displayPresentationError :: Size -> Presentation -> [Char] -> Doc
displayPresentationError Size
size Presentation
pres [Char]
err = Size -> Presentation -> (DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((DisplaySettings -> Doc) -> Doc)
-> (DisplaySettings -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \DisplaySettings
ds ->
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeStrong Doc
"Error occurred in the presentation:" Doc -> Doc -> Doc
<$$>
    Doc
"" Doc -> Doc -> Doc
<$$>
    ([Char] -> Doc
PP.string [Char]
err)


--------------------------------------------------------------------------------
dumpPresentation :: Presentation -> IO ()
dumpPresentation :: Presentation -> IO ()
dumpPresentation pres :: Presentation
pres@Presentation {[Char]
[Inline]
Index
HashMap Var [Block]
EvalBlocks
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
UniqueGen
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlideSettings :: Presentation -> Seq PresentationSettings
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pEvalBlocks :: Presentation -> EvalBlocks
pUniqueGen :: Presentation -> UniqueGen
pVars :: Presentation -> HashMap Var [Block]
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pSlideSettings :: Seq PresentationSettings
pTransitionGens :: Seq (Maybe TransitionGen)
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
pEvalBlocks :: EvalBlocks
pUniqueGen :: UniqueGen
pVars :: HashMap Var [Block]
..} =
    Doc -> IO ()
PP.putDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
PP.removeControls (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> [[Doc]] -> [Doc]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Doc
"{slide}"] ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$
        (Int -> [Doc]) -> [Int] -> [[Doc]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Doc]
dumpSlide [Int
0 .. Seq Slide -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Slide
pSlides Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    dumpSlide :: Int -> [PP.Doc]
    dumpSlide :: Int -> [Doc]
dumpSlide Int
i = do
        Slide
slide <- Maybe Slide -> [Slide]
forall a. Maybe a -> [a]
maybeToList (Maybe Slide -> [Slide]) -> Maybe Slide -> [Slide]
forall a b. (a -> b) -> a -> b
$ Int -> Presentation -> Maybe Slide
getSlide Int
i Presentation
pres
        Slide -> [Doc]
dumpSpeakerNotes Slide
slide [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> [Doc] -> [[Doc]] -> [Doc]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Doc
"{fragment}"]
            [ Index -> [Doc]
dumpFragment (Int
i, Int
j)
            | Int
j <- [Int
0 .. Slide -> Int
numFragments Slide
slide Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]

    dumpSpeakerNotes :: Slide -> [PP.Doc]
    dumpSpeakerNotes :: Slide -> [Doc]
dumpSpeakerNotes Slide
slide = do
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide SpeakerNotes -> SpeakerNotes -> Bool
forall a. Eq a => a -> a -> Bool
/= SpeakerNotes
forall a. Monoid a => a
mempty)
        Doc -> [Doc]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> [Doc]) -> Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ Text -> Doc
PP.text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text
"{speakerNotes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            SpeakerNotes -> Text
SpeakerNotes.toText (Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

    dumpFragment :: Index -> [PP.Doc]
    dumpFragment :: Index -> [Doc]
dumpFragment Index
idx =
        case Size -> Presentation -> Display
displayPresentation (Index -> Size
getSize Index
idx) Presentation
pres {pActiveFragment = idx} of
            DisplayDoc   Doc
doc      -> [Doc
doc]
            DisplayImage [Char]
filepath -> [[Char] -> Doc
PP.string ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"{image: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
filepath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}"]

    getSize :: Index -> Size
    getSize :: Index -> Size
getSize Index
idx =
        let settings :: PresentationSettings
settings = Presentation -> PresentationSettings
activeSettings Presentation
pres {pActiveFragment = idx}
            sRows :: Int
sRows    = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
24 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psRows PresentationSettings
settings
            sCols :: Int
sCols    = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
72 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
settings in
        Size {Int
sRows :: Int
sCols :: Int
sRows :: Int
sCols :: Int
..}


--------------------------------------------------------------------------------
-- | Renders the given blocks, adding margins based on the settings and wrapping
-- based on width.
prettyMargins :: DisplaySettings -> [Block] -> PP.Doc
prettyMargins :: DisplaySettings -> [Block] -> Doc
prettyMargins DisplaySettings
ds [Block]
blocks = [(Doc, Int)] -> Doc
vertical ([(Doc, Int)] -> Doc) -> [(Doc, Int)] -> Doc
forall a b. (a -> b) -> a -> b
$
    (Block -> (Doc, Int)) -> [Block] -> [(Doc, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Block -> (Doc, Int)
horizontal [Block]
blocks [(Doc, Int)] -> [(Doc, Int)] -> [(Doc, Int)]
forall a. [a] -> [a] -> [a]
++
    case DisplaySettings -> [Block] -> [Doc]
prettyReferences DisplaySettings
ds [Block]
blocks of
        []   -> []
        [Doc]
refs ->
            let doc0 :: Doc
doc0        = [Doc] -> Doc
PP.vcat [Doc]
refs
                size :: Index
size@(Int
r, Int
_) = Doc -> Index
PP.dimensions Doc
doc0 in
            [(Index -> Doc -> Doc
horizontalIndent Index
size (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
horizontalWrap Doc
doc0, Int
r)]
  where
    Size Int
rows Int
columns = DisplaySettings -> Size
dsSize DisplaySettings
ds
    Margins {AutoOr Int
mTop :: Margins -> AutoOr Int
mRight :: Margins -> AutoOr Int
mLeft :: Margins -> AutoOr Int
mTop :: AutoOr Int
mLeft :: AutoOr Int
mRight :: AutoOr Int
..} = DisplaySettings -> Margins
dsMargins DisplaySettings
ds

    -- For every block, calculate the size based on its last fragment.
    blockSize :: Block -> Index
blockSize Block
block =
        let revealState :: RevealState
revealState = [Block] -> RevealState
blocksRevealLastStep [Block
block] in
        Doc -> Index
PP.dimensions (Doc -> Index) -> Doc -> Index
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
deindent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
horizontalWrap (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
            DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
ds {dsRevealState = revealState} Block
block

    -- Vertically align some blocks by adding spaces in front of it.
    -- We also take in the number of rows for every block so we don't
    -- need to recompute it.
    vertical :: [(PP.Doc, Int)] -> PP.Doc
    vertical :: [(Doc, Int)] -> Doc
vertical [(Doc, Int)]
docs0 = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
top Doc
PP.hardline) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc
      where
        top :: Int
top = case AutoOr Int
mTop of
            AutoOr Int
Auto      -> (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actual) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            NotAuto Int
x -> Int
x

        docs1 :: [(Doc, Int)]
docs1  = [Int -> Doc -> (Doc, Int)
verticalPad Int
r Doc
d | (Doc
d, Int
r) <- [(Doc, Int)]
docs0]
        actual :: Int
actual = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
L.intersperse Int
1 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Doc, Int) -> Int) -> [(Doc, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Doc, Int) -> Int
forall a b. (a, b) -> b
snd [(Doc, Int)]
docs1
        doc :: Doc
doc    = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Doc, Int) -> Doc) -> [(Doc, Int)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc, Int) -> Doc
forall a b. (a, b) -> a
fst [(Doc, Int)]
docs1

    -- Vertically pad a doc by adding lines below it.
    -- Return the actual size as well as the padded doc.
    verticalPad :: Int -> PP.Doc -> (PP.Doc, Int)
    verticalPad :: Int -> Doc -> (Doc, Int)
verticalPad Int
desired Doc
doc0
        | Int
actual Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rows = (Doc
doc0, Int
actual)
        | Bool
otherwise      = (Doc
doc0 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
padding, Int
desired)
      where
        (Int
actual, Int
_) = Doc -> Index
PP.dimensions Doc
doc0
        padding :: Doc
padding     = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
desired Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
actual) Doc
PP.hardline

    -- Render and horizontally align a block.  Also returns the desired rows.
    horizontal :: Block -> (PP.Doc, Int)
    horizontal :: Block -> (Doc, Int)
horizontal b :: Block
b@(Reveal RevealWrapper
ConcatWrapper RevealSequence [Block]
reveal) =
        -- Horizontally aligning a fragment with a ConcatWrapper is a special
        -- case, as we want to horizontal align all the things inside
        -- individually.
        let ([Doc]
fblocks, [Int]
_) = [(Doc, Int)] -> ([Doc], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Doc, Int)] -> ([Doc], [Int])) -> [(Doc, Int)] -> ([Doc], [Int])
forall a b. (a -> b) -> a -> b
$ (Block -> (Doc, Int)) -> [Block] -> [(Doc, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Block -> (Doc, Int)
horizontal ([Block] -> [(Doc, Int)]) -> [Block] -> [(Doc, Int)]
forall a b. (a -> b) -> a -> b
$
                RevealState -> RevealWrapper -> RevealSequence [Block] -> [Block]
revealToBlocks (DisplaySettings -> RevealState
dsRevealState DisplaySettings
ds) RevealWrapper
ConcatWrapper RevealSequence [Block]
reveal in
        ([Doc] -> Doc
PP.vcat [Doc]
fblocks, Index -> Int
forall a b. (a, b) -> a
fst (Block -> Index
blockSize Block
b))
    horizontal Block
block =
        let size :: Index
size@(Int
r, Int
_) = Block -> Index
blockSize Block
block in
        (Index -> Doc -> Doc
horizontalIndent Index
size (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
horizontalWrap (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
ds Block
block, Int
r)

    horizontalIndent :: (Int, Int) -> PP.Doc -> PP.Doc
    horizontalIndent :: Index -> Doc -> Doc
horizontalIndent (Int
_, Int
dcols) Doc
doc0 = Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent Indentation Doc
indentation Indentation Doc
indentation Doc
doc1
      where
        doc1 :: Doc
doc1 = Doc -> Doc
deindent Doc
doc0
        left :: Int
left = case AutoOr Int
mLeft of
            NotAuto Int
x -> Int
x
            AutoOr Int
Auto      -> case AutoOr Int
mRight of
                NotAuto Int
_ -> Int
0
                AutoOr Int
Auto      -> (Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dcols) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        indentation :: Indentation Doc
indentation = Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
left Doc
forall a. Monoid a => a
mempty

    -- Strip leading spaces to horizontally align code blocks etc.
    deindent :: Doc -> Doc
deindent Doc
doc0 = case (AutoOr Int
mLeft, AutoOr Int
mRight) of
        (AutoOr Int
Auto, AutoOr Int
Auto) -> Doc -> Doc
PP.deindent Doc
doc0
        (AutoOr Int, AutoOr Int)
_            -> Doc
doc0

    -- Rearranges lines to fit into the wrap settings.
    horizontalWrap :: PP.Doc -> PP.Doc
    horizontalWrap :: Doc -> Doc
horizontalWrap Doc
doc0 = case DisplaySettings -> Wrap
dsWrap DisplaySettings
ds of
        Wrap
NoWrap     -> Doc
doc0
        Wrap
AutoWrap   -> Maybe Int -> Doc -> Doc
PP.wrapAt (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
right Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
left) Doc
doc0
        WrapAt Int
col -> Maybe Int -> Doc -> Doc
PP.wrapAt (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col) Doc
doc0
      where
        right :: Int
right = case AutoOr Int
mRight of
            AutoOr Int
Auto      -> Int
0
            NotAuto Int
x -> Int
x
        left :: Int
left = case AutoOr Int
mLeft of
            AutoOr Int
Auto      -> Int
0
            NotAuto Int
x -> Int
x


--------------------------------------------------------------------------------
prettyBlock :: DisplaySettings -> Block -> PP.Doc

prettyBlock :: DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
ds (Plain [Inline]
inlines) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines

prettyBlock DisplaySettings
ds (Para [Inline]
inlines) =
    DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline

prettyBlock DisplaySettings
ds (Header Int
i Attr
_ [Inline]
inlines) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeHeader ([Char] -> Doc
PP.string (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
i Char
'#') Doc -> Doc -> Doc
<+> DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    Doc
PP.hardline

prettyBlock DisplaySettings
ds (CodeBlock (Text
_, [Text]
classes, [(Text, Text)]
_) Text
txt) =
    DisplaySettings -> [Text] -> Text -> Doc
prettyCodeBlock DisplaySettings
ds [Text]
classes Text
txt

prettyBlock DisplaySettings
ds (BulletList [[Block]]
bss) = [Doc] -> Doc
PP.vcat
    [ Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent
        (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
2 (Doc -> Indentation Doc) -> Doc -> Indentation Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBulletList Doc
prefix)
        (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
4 Doc
forall a. Monoid a => a
mempty)
        (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds' [Block]
bs)
    | [Block]
bs <- [[Block]]
bss
    ] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline
  where
    prefix :: Doc
prefix = [Char] -> Doc
PP.string [Char
marker] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" "
    marker :: Char
marker = case Text -> [Char]
T.unpack (Text -> [Char]) -> Maybe Text -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Theme -> Maybe Text
themeBulletListMarkers Theme
theme of
        Just (Char
x : [Char]
_) -> Char
x
        Maybe [Char]
_            -> Char
'-'

    -- Cycle the markers.
    theme :: Theme
theme  = DisplaySettings -> Theme
dsTheme DisplaySettings
ds
    theme' :: Theme
theme' = Theme
theme
        { themeBulletListMarkers =
            (\Text
ls -> Int -> Text -> Text
T.drop Int
1 Text
ls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
1 Text
ls) <$> themeBulletListMarkers theme
        }
    ds' :: DisplaySettings
ds'    = DisplaySettings
ds {dsTheme = theme'}

prettyBlock DisplaySettings
ds (OrderedList ListAttributes
_ [[Block]]
bss) = [Doc] -> Doc
PP.vcat
    [ Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent
        (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
0 (Doc -> Indentation Doc) -> Doc -> Indentation Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeOrderedList (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.string [Char]
prefix)
        (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
4 Doc
forall a. Monoid a => a
mempty)
        (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
bs)
    | ([Char]
prefix, [Block]
bs) <- [[Char]] -> [[Block]] -> [([Char], [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
padded [[Block]]
bss
    ] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline
  where
    padded :: [[Char]]
padded  = [[Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
n) Char
' ' | [Char]
n <- [[Char]]
numbers]
    numbers :: [[Char]]
numbers =
        [ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
        | Int
i <- [Int
1 .. [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
bss]
        ]

prettyBlock DisplaySettings
_ds (RawBlock Format
_ Text
t) = Text -> Doc
PP.text Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline

prettyBlock DisplaySettings
_ds Block
HorizontalRule = Doc
"---"

prettyBlock DisplaySettings
ds (BlockQuote [Block]
bs) =
    let quote :: Indentation Doc
quote = Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
0 (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBlockQuote Doc
"> ") in
    Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent Indentation Doc
quote Indentation Doc
quote (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBlockQuote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
bs)

prettyBlock DisplaySettings
ds (DefinitionList [([Inline], [[Block]])]
terms) =
    [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> Doc) -> [([Inline], [[Block]])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> Doc
prettyDefinition [([Inline], [[Block]])]
terms
  where
    prettyDefinition :: ([Inline], [[Block]]) -> Doc
prettyDefinition ([Inline]
term, [[Block]]
definitions) =
        DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeDefinitionTerm (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
term) Doc -> Doc -> Doc
<$$>
        Doc
PP.hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
PP.vcat
        [ Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent
            (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
0 (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeDefinitionList Doc
":   "))
            (Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
4 Doc
forall a. Monoid a => a
mempty) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
            DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds ([Block] -> [Block]
plainToPara [Block]
definition)
        | [Block]
definition <- [[Block]]
definitions
        ]

    plainToPara :: [Block] -> [Block]
    plainToPara :: [Block] -> [Block]
plainToPara = (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Block) -> [Block] -> [Block])
-> (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ \case
        Plain [Inline]
inlines -> [Inline] -> Block
Para [Inline]
inlines
        Block
block         -> Block
block


prettyBlock DisplaySettings
ds (Table [Inline]
caption [Alignment]
aligns [[Block]]
headers [[[Block]]]
rows) =
    Maybe Int -> Doc -> Doc
PP.wrapAt Maybe Int
forall a. Maybe a
Nothing (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    DisplaySettings -> TableDisplay -> Doc
prettyTableDisplay DisplaySettings
ds TableDisplay
        { tdCaption :: Doc
tdCaption = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
caption
        , tdAligns :: [Alignment]
tdAligns  = (Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Alignment
align [Alignment]
aligns
        , tdHeaders :: [Doc]
tdHeaders = ([Block] -> Doc) -> [[Block]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds) [[Block]]
headers
        , tdRows :: [[Doc]]
tdRows    = ([[Block]] -> [Doc]) -> [[[Block]]] -> [[Doc]]
forall a b. (a -> b) -> [a] -> [b]
map (([Block] -> Doc) -> [[Block]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds)) [[[Block]]]
rows
        }
  where
    align :: Alignment -> Alignment
align Alignment
Pandoc.AlignLeft    = Alignment
PP.AlignLeft
    align Alignment
Pandoc.AlignCenter  = Alignment
PP.AlignCenter
    align Alignment
Pandoc.AlignDefault = Alignment
PP.AlignLeft
    align Alignment
Pandoc.AlignRight   = Alignment
PP.AlignRight

prettyBlock DisplaySettings
ds (Div Attr
_attrs [Block]
blocks) = DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
blocks

prettyBlock DisplaySettings
ds (LineBlock [[Inline]]
inliness) =
    let ind :: Indentation Doc
ind = Int -> Doc -> Indentation Doc
forall a. Int -> a -> Indentation a
PP.Indentation Int
0 (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLineBlock Doc
"| ") in
    Maybe Int -> Doc -> Doc
PP.wrapAt Maybe Int
forall a. Maybe a
Nothing (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent Indentation Doc
ind Indentation Doc
ind (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
    ([Inline] -> Doc) -> [[Inline]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds) [[Inline]]
inliness

prettyBlock DisplaySettings
ds (Figure Attr
_attr [Block]
blocks) = DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
blocks

prettyBlock DisplaySettings
ds (Reveal RevealWrapper
w RevealSequence [Block]
fragment) = DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds ([Block] -> Doc) -> [Block] -> Doc
forall a b. (a -> b) -> a -> b
$
    RevealState -> RevealWrapper -> RevealSequence [Block] -> [Block]
revealToBlocks (DisplaySettings -> RevealState
dsRevealState DisplaySettings
ds) RevealWrapper
w RevealSequence [Block]
fragment

prettyBlock DisplaySettings
ds (VarBlock Var
var) = DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds ([Block] -> Doc) -> [Block] -> Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> Var -> [Block]
dsResolve DisplaySettings
ds Var
var

prettyBlock DisplaySettings
_ (SpeakerNote Text
_) = Doc
forall a. Monoid a => a
mempty
prettyBlock DisplaySettings
_ (Config Either [Char] PresentationSettings
_) = Doc
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
prettyBlocks :: DisplaySettings -> [Block] -> PP.Doc
prettyBlocks :: DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> ([Block] -> [Doc]) -> [Block] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Doc) -> [Block] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
ds)


--------------------------------------------------------------------------------
prettyInline :: DisplaySettings -> Inline -> PP.Doc

prettyInline :: DisplaySettings -> Inline -> Doc
prettyInline DisplaySettings
_ds Inline
Space = Doc
PP.space

prettyInline DisplaySettings
_ds (Str Text
str) = Text -> Doc
PP.text Text
str

prettyInline DisplaySettings
ds (Emph [Inline]
inlines) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeEmph (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines

prettyInline DisplaySettings
ds (Strong [Inline]
inlines) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeStrong (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines

prettyInline DisplaySettings
ds (Underline [Inline]
inlines) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeUnderline (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines

prettyInline DisplaySettings
ds (Code Attr
_ Text
txt) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeCode (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Text -> Doc
PP.text (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")

prettyInline DisplaySettings
ds link :: Inline
link@(Link Attr
_attrs [Inline]
_text (Text
target, Text
_title))
    | Just ([Inline]
text, Text
_, Text
_) <- Inline -> Maybe Reference
toReferenceLink Inline
link =
        Doc
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLinkText (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
text) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"]"
    | Bool
otherwise =
        Doc
"<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLinkTarget (Text -> Doc
PP.text Text
target) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">"

prettyInline DisplaySettings
_ds Inline
SoftBreak = Doc
PP.softline

prettyInline DisplaySettings
_ds Inline
LineBreak = Doc
PP.hardline

prettyInline DisplaySettings
ds (Strikeout [Inline]
t) =
    Doc
"~~" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeStrikeout (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"~~"

prettyInline DisplaySettings
ds (Quoted QuoteType
Pandoc.SingleQuote [Inline]
t) =
    Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeQuoted (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'"
prettyInline DisplaySettings
ds (Quoted QuoteType
Pandoc.DoubleQuote [Inline]
t) =
    Doc
"'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeQuoted (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"'"

prettyInline DisplaySettings
ds (Math MathType
_ Text
t) =
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeMath (Text -> Doc
PP.text Text
t)

prettyInline DisplaySettings
ds (Image Attr
_attrs [Inline]
text (Text
target, Text
_title)) =
    Doc
"![" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeImageText (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
text) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"](" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeImageTarget (Text -> Doc
PP.text Text
target) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"

prettyInline DisplaySettings
_ (RawInline Format
_ Text
t) = Text -> Doc
PP.text Text
t

-- These elements aren't really supported.
prettyInline DisplaySettings
ds  (Cite      [Citation]
_ [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Span      Attr
_ [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
_   (Note        [Block]
_) = Doc
forall a. Monoid a => a
mempty  -- TODO: support notes?
prettyInline DisplaySettings
ds  (Superscript [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Subscript   [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (SmallCaps   [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
-- prettyInline unsupported = PP.ondullred $ PP.string $ show unsupported


--------------------------------------------------------------------------------
prettyInlines :: DisplaySettings -> [Inline] -> PP.Doc
prettyInlines :: DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Inline] -> [Doc]) -> [Inline] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Doc) -> [Inline] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> Inline -> Doc
prettyInline DisplaySettings
ds)


--------------------------------------------------------------------------------
type Reference = ([Inline], T.Text, T.Text)


--------------------------------------------------------------------------------
prettyReferences :: DisplaySettings -> [Block] -> [PP.Doc]
prettyReferences :: DisplaySettings -> [Block] -> [Doc]
prettyReferences DisplaySettings
ds =
    (Reference -> Doc) -> [Reference] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> Doc
prettyReference ([Reference] -> [Doc])
-> ([Block] -> [Reference]) -> [Block] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer [Reference] [Block] -> [Reference]
forall w a. Writer w a -> w
execWriter (Writer [Reference] [Block] -> [Reference])
-> ([Block] -> Writer [Reference] [Block])
-> [Block]
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Writer [Reference] [Block])
-> (Inline -> WriterT [Reference] Identity [Inline])
-> [Block]
-> Writer [Reference] [Block]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Block] -> m [Block]
dftBlocks ([Block] -> Writer [Reference] [Block]
forall a. a -> WriterT [Reference] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> Writer [Reference] [Block])
-> (Block -> [Block]) -> Block -> Writer [Reference] [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Inline -> WriterT [Reference] Identity [Inline]
tellReference
  where
    tellReference :: Inline -> Writer [Reference] [Inline]
    tellReference :: Inline -> WriterT [Reference] Identity [Inline]
tellReference Inline
inline = do
        Maybe Reference
-> (Reference -> WriterT [Reference] Identity ())
-> WriterT [Reference] Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Inline -> Maybe Reference
toReferenceLink Inline
inline) ([Reference] -> WriterT [Reference] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Reference] -> WriterT [Reference] Identity ())
-> (Reference -> [Reference])
-> Reference
-> WriterT [Reference] Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> [Reference]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        [Inline] -> WriterT [Reference] Identity [Inline]
forall a. a -> WriterT [Reference] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Inline
inline]

    prettyReference :: Reference -> PP.Doc
    prettyReference :: Reference -> Doc
prettyReference ([Inline]
text, Text
target, Text
title) =
        Doc
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLinkText
            (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds ([Inline] -> Doc) -> [Inline] -> Doc
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
newlineToSpace [Inline]
text) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Doc
"](" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLinkTarget (Text -> Doc
PP.text Text
target) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        (if Text -> Bool
T.null Text
title
            then Doc
forall a. Monoid a => a
mempty
            else Doc
PP.space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
PP.text Text
title Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\"")
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"

    newlineToSpace :: [Inline] -> [Inline]
    newlineToSpace :: [Inline] -> [Inline]
newlineToSpace = Identity [Inline] -> [Inline]
forall a. Identity a -> a
runIdentity (Identity [Inline] -> [Inline])
-> ([Inline] -> Identity [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Identity [Block])
-> (Inline -> Identity [Inline]) -> [Inline] -> Identity [Inline]
forall (m :: * -> *).
Monad m =>
(Block -> m [Block])
-> (Inline -> m [Inline]) -> [Inline] -> m [Inline]
dftInlines ([Block] -> Identity [Block]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> Identity [Block])
-> (Block -> [Block]) -> Block -> Identity [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Inline -> Identity [Inline]
forall {f :: * -> *}. Applicative f => Inline -> f [Inline]
work
      where
        work :: Inline -> f [Inline]
work Inline
x = [Inline] -> f [Inline]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> f [Inline]) -> [Inline] -> f [Inline]
forall a b. (a -> b) -> a -> b
$ case Inline
x of
            Inline
SoftBreak -> [Inline
Space]
            Inline
LineBreak -> [Inline
Space]
            Inline
_         -> [Inline
x]


--------------------------------------------------------------------------------
toReferenceLink :: Inline -> Maybe Reference
toReferenceLink :: Inline -> Maybe Reference
toReferenceLink (Link Attr
_attrs [Inline]
text (Text
target, Text
title))
    | [Text -> Inline
Str Text
target] [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Inline]
text = Reference -> Maybe Reference
forall a. a -> Maybe a
Just ([Inline]
text, Text
target, Text
title)
toReferenceLink Inline
_ = Maybe Reference
forall a. Maybe a
Nothing