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


--------------------------------------------------------------------------------
import           Control.Monad                        (guard)
import qualified Data.Aeson.Extended                  as A
import           Data.Char.WCWidth.Extended           (wcstrwidth)
import           Data.Data.Extended                   (grecQ)
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 qualified Patat.Presentation.Comments          as Comments
import           Patat.Presentation.Display.CodeBlock
import           Patat.Presentation.Display.Internal
import           Patat.Presentation.Display.Table
import           Patat.Presentation.Internal
import           Patat.Presentation.Settings
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
import qualified Text.Pandoc.Writers.Shared           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
VarGen
PresentationSettings
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
pVarGen :: VarGen
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
pVarGen :: Presentation -> VarGen
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
    (Int
sidx, Int
_) = Index
pActiveFragment
    settings :: PresentationSettings
settings  = Presentation -> PresentationSettings
activeSettings Presentation
pres
    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
        }

    -- 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
VarGen
PresentationSettings
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
pVarGen :: Presentation -> VarGen
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
pVarGen :: VarGen
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 Fragment
fragment)
                | Just ImageSettings
_ <- PresentationSettings -> Maybe ImageSettings
psImages PresentationSettings
pSettings
                , Just Text
image <- Fragment -> Maybe Text
onlyImage Fragment
fragment ->
            [Char] -> Display
DisplayImage ([Char] -> Display) -> [Char] -> Display
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
image
        Just (ActiveContent Fragment
fragment) -> 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 -> Fragment -> Doc
prettyFragment DisplaySettings
theme Fragment
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 -> Fragment -> Doc
prettyFragment DisplaySettings
ds {dsMargins = auto} (Fragment -> Doc) -> Fragment -> Doc
forall a b. (a -> b) -> a -> b
$ [Block] -> Fragment
Fragment [Block
block]

  where
    -- Check if the fragment consists of "just a single image".  Discard
    -- headers.
    onlyImage :: Fragment -> Maybe Text
onlyImage (Fragment (Pandoc.Header{} : [Block]
bs)) = Fragment -> Maybe Text
onlyImage ([Block] -> Fragment
Fragment [Block]
bs)
    onlyImage (Fragment [Block]
bs) = case [Block]
bs of
        [Pandoc.Figure Attr
_ Caption
_ [Block]
bs']                      -> Fragment -> Maybe Text
onlyImage ([Block] -> Fragment
Fragment [Block]
bs')
        [Pandoc.Para [Pandoc.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
VarGen
PresentationSettings
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
pVarGen :: Presentation -> VarGen
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
pVarGen :: VarGen
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]
dumpComment 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]
            ]

    dumpComment :: Slide -> [PP.Doc]
    dumpComment :: Slide -> [Doc]
dumpComment Slide
slide = do
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Comment -> SpeakerNotes
Comments.cSpeakerNotes Comment
comment 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
Comments.speakerNotesToText (Comment -> SpeakerNotes
Comments.cSpeakerNotes Comment
comment) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
      where
        comment :: Comment
comment = Slide -> Comment
slideComment Slide
slide

    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
..}


--------------------------------------------------------------------------------
prettyFragment :: DisplaySettings -> Fragment -> PP.Doc
prettyFragment :: DisplaySettings -> Fragment -> Doc
prettyFragment DisplaySettings
ds (Fragment [Block]
blocks) = Doc -> Doc
vertical (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
PP.vcat ((Block -> Doc) -> [Block] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
horizontal (Doc -> Doc) -> (Block -> Doc) -> Block -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
ds) [Block]
blocks) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    case DisplaySettings -> [Block] -> [Doc]
prettyReferences DisplaySettings
ds [Block]
blocks of
        []   -> Doc
forall a. Monoid a => a
mempty
        [Doc]
refs -> Doc
PP.hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
PP.vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
horizontal [Doc]
refs)
  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

    vertical :: Doc -> Doc
vertical Doc
doc0 =
        [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
doc0
      where
        top :: Int
top = case AutoOr Int
mTop of
            AutoOr Int
Auto      -> let (Int
r, Int
_) = Doc -> Index
PP.dimensions Doc
doc0 in (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            NotAuto Int
x -> Int
x

    horizontal :: Doc -> Doc
horizontal = Doc -> Doc
horizontalIndent (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
horizontalWrap

    horizontalIndent :: Doc -> Doc
horizontalIndent Doc
doc0 = Indentation Doc -> Indentation Doc -> Doc -> Doc
PP.indent Indentation Doc
indentation Indentation Doc
indentation Doc
doc1
      where
        doc1 :: Doc
doc1 = 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
        (Int
_, Int
dcols) = Doc -> Index
PP.dimensions Doc
doc1
        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

    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 -> Pandoc.Block -> PP.Doc

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

prettyBlock DisplaySettings
ds (Pandoc.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 (Pandoc.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 (Pandoc.CodeBlock (Text
_, [Text]
classes, [(Text, Text)]
_) Text
txt) =
    DisplaySettings -> [Text] -> Text -> Doc
prettyCodeBlock DisplaySettings
ds [Text]
classes Text
txt

prettyBlock DisplaySettings
ds (Pandoc.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 (Pandoc.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 (Pandoc.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
Pandoc.HorizontalRule = Doc
"---"

prettyBlock DisplaySettings
ds (Pandoc.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 (Pandoc.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]
Pandoc.plainToPara [Block]
definition)
        | [Block]
definition <- [[Block]]
definitions
        ]

prettyBlock DisplaySettings
ds (Pandoc.Table Attr
_ Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) =
    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 -> Table -> Doc
prettyTable DisplaySettings
ds Table
        { tCaption :: Doc
tCaption = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
caption'
        , tAligns :: [Alignment]
tAligns  = (Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Alignment
align [Alignment]
aligns
        , tHeaders :: [Doc]
tHeaders = ([Block] -> Doc) -> [[Block]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds) [[Block]]
headers
        , tRows :: [[Doc]]
tRows    = ([[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
    ([Inline]
caption', [Alignment]
aligns, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
Pandoc.toLegacyTable
        Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot

    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 (Pandoc.Div Attr
_attrs [Block]
blocks) = DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
blocks

prettyBlock DisplaySettings
ds (Pandoc.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 (Pandoc.Figure Attr
_attr Caption
_caption [Block]
blocks) =
    DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
blocks


--------------------------------------------------------------------------------
prettyBlocks :: DisplaySettings -> [Pandoc.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 -> Pandoc.Inline -> PP.Doc

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

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

prettyInline DisplaySettings
ds (Pandoc.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 (Pandoc.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 (Pandoc.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 (Pandoc.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@(Pandoc.Link Attr
_attrs [Inline]
text (Text
target, Text
_title))
    | Inline -> Bool
isReferenceLink 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
Pandoc.SoftBreak = Doc
PP.softline

prettyInline DisplaySettings
_ds Inline
Pandoc.LineBreak = Doc
PP.hardline

prettyInline DisplaySettings
ds (Pandoc.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 (Pandoc.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 (Pandoc.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 (Pandoc.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 (Pandoc.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
_ (Pandoc.RawInline Format
_ Text
t) = Text -> Doc
PP.text Text
t

-- These elements aren't really supported.
prettyInline DisplaySettings
ds  (Pandoc.Cite      [Citation]
_ [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Pandoc.Span      Attr
_ [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Pandoc.Note        [Block]
t) = DisplaySettings -> [Block] -> Doc
prettyBlocks  DisplaySettings
ds [Block]
t
prettyInline DisplaySettings
ds  (Pandoc.Superscript [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Pandoc.Subscript   [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
prettyInline DisplaySettings
ds  (Pandoc.SmallCaps   [Inline]
t) = DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
t
-- prettyInline unsupported = PP.ondullred $ PP.string $ show unsupported


--------------------------------------------------------------------------------
prettyInlines :: DisplaySettings -> [Pandoc.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)


--------------------------------------------------------------------------------
prettyReferences :: DisplaySettings -> [Pandoc.Block] -> [PP.Doc]
prettyReferences :: DisplaySettings -> [Block] -> [Doc]
prettyReferences DisplaySettings
ds =
    (Inline -> Doc) -> [Inline] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Doc
prettyReference ([Inline] -> [Doc]) -> ([Block] -> [Inline]) -> [Block] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
getReferences
  where
    getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
    getReferences :: [Block] -> [Inline]
getReferences = (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
isReferenceLink ([Inline] -> [Inline])
-> ([Block] -> [Inline]) -> [Block] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
forall a b. (Data a, Data b) => a -> [b]
grecQ

    prettyReference :: Pandoc.Inline -> PP.Doc
    prettyReference :: Inline -> Doc
prettyReference (Pandoc.Link 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
themeLinkText
            (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds ([Inline] -> Doc) -> [Inline] -> Doc
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
Pandoc.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
")"
    prettyReference Inline
_ = Doc
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
isReferenceLink :: Pandoc.Inline -> Bool
isReferenceLink :: Inline -> Bool
isReferenceLink (Pandoc.Link Attr
_attrs [Inline]
text (Text
target, Text
_)) =
    [Text -> Inline
Pandoc.Str Text
target] [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Inline]
text
isReferenceLink Inline
_ = Bool
False