--------------------------------------------------------------------------------
{-# 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.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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Display] -> ShowS
$cshowList :: [Display] -> ShowS
show :: Display -> [Char]
$cshow :: Display -> [Char]
showsPrec :: Int -> Display -> ShowS
$cshowsPrec :: Int -> Display -> ShowS
Show)


--------------------------------------------------------------------------------
-- | Display something within the presentation borders that draw the title and
-- the active slide number and so on.
displayWithBorders
    :: Size -> Presentation -> (Size -> DisplaySettings -> PP.Doc) -> PP.Doc
displayWithBorders :: Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders (Size Int
rows Int
columns) pres :: Presentation
pres@Presentation {[Char]
[Inline]
Index
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pSlideSettings :: Presentation -> Seq PresentationSettings
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlides :: Presentation -> Seq Slide
pSettings :: Presentation -> PresentationSettings
pAuthor :: Presentation -> [Inline]
pTitle :: Presentation -> [Inline]
pEncodingFallback :: Presentation -> EncodingFallback
pFilePath :: Presentation -> [Char]
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pTransitionGens :: Seq (Maybe TransitionGen)
pSlideSettings :: Seq PresentationSettings
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
..} Size -> DisplaySettings -> Doc
f =
    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
title
        then forall a. Monoid a => a
mempty
        else
            let titleRemainder :: Int
titleRemainder = Int
columns forall a. Num a => a -> a -> a
- Int
titleWidth forall a. Num a => a -> a -> a
- Int
titleOffset
                wrappedTitle :: Doc
wrappedTitle = Int -> Doc
PP.spaces Int
titleOffset forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
title forall a. Semigroup a => a -> a -> a
<> Int -> Doc
PP.spaces Int
titleRemainder in
        Doc -> Doc
borders Doc
wrappedTitle forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline) forall a. Semigroup a => a -> a -> a
<>
    forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
topMargin Doc
PP.hardline) forall a. Semigroup a => a -> a -> a
<>
    PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
settings (Size -> DisplaySettings -> Doc
f Size
canvasSize DisplaySettings
ds) forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline forall a. Semigroup a => a -> a -> a
<>
    Int -> Doc
PP.goToLine (Int
rows forall a. Num a => a -> a -> a
- Int
2) forall a. Semigroup a => a -> a -> a
<>
    Doc -> Doc
borders (Doc
PP.space forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
author forall a. Semigroup a => a -> a -> a
<> Doc
middleSpaces forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char]
active forall a. Semigroup a => a -> a -> a
<> Doc
PP.space) 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) {psColumns :: Maybe (FlexibleNum Int)
psColumns = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> FlexibleNum a
A.FlexibleNum Int
columns}
    ds :: DisplaySettings
ds          = DisplaySettings
        { dsTheme :: Theme
dsTheme     = 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 = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> Maybe a
Seq.safeIndex Seq Breadcrumbs
pBreadcrumbs Int
sidx
    plainTitle :: [Char]
plainTitle  = Doc -> [Char]
PP.toString forall a b. (a -> b) -> a -> b
$ DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
pTitle
    breadTitle :: [Char]
breadTitle  = forall a. Monoid a => a -> a -> a
mappend [Char]
plainTitle forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ [Char]
s
        | Doc
b <- forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Breadcrumbs
breadcrumbs
        , [Char]
s <- [[Char]
" > ", Doc -> [Char]
PP.toString Doc
b]
        ]
    title :: [Char]
title
        | Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Bool
psBreadcrumbs PresentationSettings
settings = [Char]
plainTitle
        | [Char] -> Int
wcstrwidth [Char]
breadTitle 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 forall a. Num a => a -> a -> a
- Int
titleWidth) 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
    topMargin :: Int
topMargin  = Margins -> Int
mTop forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Margins
margins PresentationSettings
settings
    canvasSize :: Size
canvasSize = Int -> Int -> Size
Size (Int
rows forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
- Int
topMargin) Int
columns

    -- Compute footer.
    active :: [Char]
active
        | forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe Bool
psSlideNumber PresentationSettings
settings = forall a. Show a => a -> [Char]
show (Int
sidx forall a. Num a => a -> a -> a
+ Int
1) forall a. [a] -> [a] -> [a]
++ [Char]
" / " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (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 forall a b. (a -> b) -> a -> b
$ Int
columns forall a. Num a => a -> a -> a
- Int
activeWidth forall a. Num a => a -> a -> a
- Int
authorWidth 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
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pTransitionGens :: Seq (Maybe TransitionGen)
pSlideSettings :: Seq PresentationSettings
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pSlideSettings :: Presentation -> Seq PresentationSettings
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlides :: Presentation -> Seq Slide
pSettings :: Presentation -> PresentationSettings
pAuthor :: Presentation -> [Inline]
pTitle :: Presentation -> [Inline]
pEncodingFallback :: Presentation -> EncodingFallback
pFilePath :: Presentation -> [Char]
..} =
     case Presentation -> Maybe ActiveFragment
activeFragment Presentation
pres of
        Maybe ActiveFragment
Nothing -> Doc -> Display
DisplayDoc forall a b. (a -> b) -> a -> b
$ Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres 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 forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
image
        Just (ActiveContent Fragment
fragment) -> Doc -> Display
DisplayDoc forall a b. (a -> b) -> a -> b
$
            Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres forall a b. (a -> b) -> a -> b
$ \Size
_canvasSize DisplaySettings
theme ->
                DisplaySettings -> Fragment -> Doc
prettyFragment DisplaySettings
theme Fragment
fragment
        Just (ActiveTitle Block
block) -> Doc -> Display
DisplayDoc forall a b. (a -> b) -> a -> b
$
            Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres forall a b. (a -> b) -> a -> b
$ \Size
canvasSize DisplaySettings
theme ->
            let pblock :: Doc
pblock         = DisplaySettings -> Block -> Doc
prettyBlock DisplaySettings
theme Block
block
                (Int
prows, Int
pcols) = Doc -> Index
PP.dimensions Doc
pblock
                Margins {Int
mRight :: Margins -> Int
mLeft :: Margins -> Int
mRight :: Int
mLeft :: Int
mTop :: Int
mTop :: Margins -> Int
..}   = PresentationSettings -> Margins
margins (Presentation -> PresentationSettings
activeSettings Presentation
pres)
                offsetRow :: Int
offsetRow      = (Size -> Int
sRows Size
canvasSize forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
- (Int
prows forall a. Integral a => a -> a -> a
`div` Int
2)
                offsetCol :: Int
offsetCol      = ((Size -> Int
sCols Size
canvasSize forall a. Num a => a -> a -> a
- Int
mLeft forall a. Num a => a -> a -> a
- Int
mRight) forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
- (Int
pcols forall a. Integral a => a -> a -> a
`div` Int
2)
                spaces :: Trimmable Doc
spaces         = forall a. a -> Trimmable a
PP.NotTrimmable forall a b. (a -> b) -> a -> b
$ Int -> Doc
PP.spaces Int
offsetCol in
            forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate (Int
offsetRow forall a. Num a => a -> a -> a
- Int
3) Doc
PP.hardline) Doc -> Doc -> Doc
<$$>
            Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
spaces Trimmable Doc
spaces Doc
pblock

  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
_)]] -> forall a. a -> Maybe a
Just Text
target
        [Block]
_                                            -> 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 -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres forall a b. (a -> b) -> a -> b
$ \Size
_ 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
SyntaxMap
Seq Breadcrumbs
Seq (Maybe TransitionGen)
Seq PresentationSettings
Seq Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pTransitionGens :: Seq (Maybe TransitionGen)
pSlideSettings :: Seq PresentationSettings
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
pTransitionGens :: Presentation -> Seq (Maybe TransitionGen)
pSlideSettings :: Presentation -> Seq PresentationSettings
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlides :: Presentation -> Seq Slide
pSettings :: Presentation -> PresentationSettings
pAuthor :: Presentation -> [Inline]
pTitle :: Presentation -> [Inline]
pEncodingFallback :: Presentation -> EncodingFallback
pFilePath :: Presentation -> [Char]
..} =
    Doc -> IO ()
PP.putDoc forall a b. (a -> b) -> a -> b
$ Doc -> Doc
PP.removeControls forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate [Doc
"{slide}"] forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map Int -> [Doc]
dumpSlide [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Slide
pSlides forall a. Num a => a -> a -> a
- Int
1]
  where
    dumpSlide :: Int -> [PP.Doc]
    dumpSlide :: Int -> [Doc]
dumpSlide Int
i = do
        Slide
slide <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Int -> Presentation -> Maybe Slide
getSlide Int
i Presentation
pres
        forall a b. (a -> b) -> [a] -> [b]
map (PresentationSettings -> Doc -> Doc
formatWith (Int -> Presentation -> PresentationSettings
getSettings Int
i Presentation
pres)) forall a b. (a -> b) -> a -> b
$
            Slide -> [Doc]
dumpComment Slide
slide forall a. Semigroup a => a -> a -> a
<> 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 forall a. Num a => a -> a -> a
- Int
1]
                ]

    dumpComment :: Slide -> [PP.Doc]
    dumpComment :: Slide -> [Doc]
dumpComment Slide
slide = do
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Comment -> SpeakerNotes
Comments.cSpeakerNotes Comment
comment forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Doc
PP.text forall a b. (a -> b) -> a -> b
$ Text
"{speakerNotes: " forall a. Semigroup a => a -> a -> a
<>
            SpeakerNotes -> Text
Comments.speakerNotesToText (Comment -> SpeakerNotes
Comments.cSpeakerNotes Comment
comment) 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 :: Index
pActiveFragment = Index
idx} of
            DisplayDoc Doc
doc        -> [Doc
doc]
            DisplayImage [Char]
filepath -> [[Char] -> Doc
PP.string forall a b. (a -> b) -> a -> b
$ [Char]
"{image: " forall a. [a] -> [a] -> [a]
++ [Char]
filepath 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 :: Index
pActiveFragment = Index
idx}
            sRows :: Int
sRows    = forall a. a -> Maybe a -> a
fromMaybe Int
24 forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psRows PresentationSettings
settings
            sCols :: Int
sCols    = forall a. a -> Maybe a -> a
fromMaybe Int
72 forall a b. (a -> b) -> a -> b
$ forall a. FlexibleNum a -> a
A.unFlexibleNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
settings in
        Size {Int
sCols :: Int
sRows :: Int
sCols :: Int
sRows :: Int
..}


--------------------------------------------------------------------------------
formatWith :: PresentationSettings -> PP.Doc -> PP.Doc
formatWith :: PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
ps = Doc -> Doc
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
indent
  where
    Margins {Int
mRight :: Int
mLeft :: Int
mTop :: Int
mRight :: Margins -> Int
mLeft :: Margins -> Int
mTop :: Margins -> Int
..} = PresentationSettings -> Margins
margins PresentationSettings
ps
    wrap :: Doc -> Doc
wrap = case (PresentationSettings -> Maybe Bool
psWrap PresentationSettings
ps, PresentationSettings -> Maybe (FlexibleNum Int)
psColumns PresentationSettings
ps) of
        (Just Bool
True,  Just (A.FlexibleNum Int
col)) -> Maybe Int -> Doc -> Doc
PP.wrapAt (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
col forall a. Num a => a -> a -> a
- Int
mRight)
        (Maybe Bool, Maybe (FlexibleNum Int))
_                                      -> forall a. a -> a
id
    spaces :: Trimmable Doc
spaces = forall a. a -> Trimmable a
PP.NotTrimmable forall a b. (a -> b) -> a -> b
$ Int -> Doc
PP.spaces Int
mLeft
    indent :: Doc -> Doc
indent = Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
spaces Trimmable Doc
spaces


--------------------------------------------------------------------------------
prettyFragment :: DisplaySettings -> Fragment -> PP.Doc
prettyFragment :: DisplaySettings -> Fragment -> Doc
prettyFragment DisplaySettings
ds (Fragment [Block]
blocks) =
    DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
blocks forall a. Semigroup a => a -> a -> a
<>
    case DisplaySettings -> [Block] -> [Doc]
prettyReferences DisplaySettings
ds [Block]
blocks of
        []   -> forall a. Monoid a => a
mempty
        [Doc]
refs -> Doc
PP.hardline forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
PP.vcat [Doc]
refs


--------------------------------------------------------------------------------
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 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 (forall a. Int -> a -> [a]
replicate Int
i Char
'#') Doc -> Doc -> Doc
<+> DisplaySettings -> [Inline] -> Doc
prettyInlines DisplaySettings
ds [Inline]
inlines) 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
    [ Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent
        (forall a. a -> Trimmable a
PP.NotTrimmable forall a b. (a -> b) -> a -> b
$ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBulletList Doc
prefix)
        (forall a. a -> Trimmable a
PP.Trimmable Doc
"    ")
        (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds' [Block]
bs)
    | [Block]
bs <- [[Block]]
bss
    ] forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline
  where
    prefix :: Doc
prefix = Doc
"  " forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
PP.string [Char
marker] forall a. Semigroup a => a -> a -> a
<> Doc
" "
    marker :: Char
marker = case Text -> [Char]
T.unpack 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 :: Maybe Text
themeBulletListMarkers =
            (\Text
ls -> Int -> Text -> Text
T.drop Int
1 Text
ls forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
1 Text
ls) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Theme -> Maybe Text
themeBulletListMarkers Theme
theme
        }
    ds' :: DisplaySettings
ds'    = DisplaySettings
ds {dsTheme :: Theme
dsTheme = Theme
theme'}

prettyBlock DisplaySettings
ds (Pandoc.OrderedList ListAttributes
_ [[Block]]
bss) = [Doc] -> Doc
PP.vcat
    [ Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent
        (forall a. a -> Trimmable a
PP.NotTrimmable forall a b. (a -> b) -> a -> b
$ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeOrderedList forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
PP.string [Char]
prefix)
        (forall a. a -> Trimmable a
PP.Trimmable Doc
"    ")
        (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds [Block]
bs)
    | ([Char]
prefix, [Block]
bs) <- forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
padded [[Block]]
bss
    ] forall a. Semigroup a => a -> a -> a
<> Doc
PP.hardline
  where
    padded :: [[Char]]
padded  = [[Char]
n forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
4 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
n) Char
' ' | [Char]
n <- [[Char]]
numbers]
    numbers :: [[Char]]
numbers =
        [ forall a. Show a => a -> [Char]
show Int
i forall a. [a] -> [a] -> [a]
++ [Char]
"."
        | Int
i <- [Int
1 .. 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 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 :: Trimmable Doc
quote = forall a. a -> Trimmable a
PP.NotTrimmable (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBlockQuote Doc
"> ") in
    Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
quote Trimmable Doc
quote (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBlockQuote 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 forall a b. (a -> b) -> a -> b
$ 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 forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
PP.vcat
        [ Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent
            (forall a. a -> Trimmable a
PP.NotTrimmable (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeDefinitionList Doc
":   "))
            (forall a. a -> Trimmable a
PP.Trimmable 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 forall a. Maybe a
Nothing 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  = forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Alignment
align [Alignment]
aligns
        , tHeaders :: [Doc]
tHeaders = forall a b. (a -> b) -> [a] -> [b]
map (DisplaySettings -> [Block] -> Doc
prettyBlocks DisplaySettings
ds) [[Block]]
headers
        , tRows :: [[Doc]]
tRows    = forall a b. (a -> b) -> [a] -> [b]
map (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 :: Trimmable Doc
ind = forall a. a -> Trimmable a
PP.NotTrimmable (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeLineBlock Doc
"| ") in
    Maybe Int -> Doc -> Doc
PP.wrapAt forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
    Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
ind Trimmable Doc
ind forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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 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 forall a b. (a -> b) -> a -> b
$
    Text -> Doc
PP.text (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
txt 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
"[" 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) forall a. Semigroup a => a -> a -> a
<> Doc
"]"
    | Bool
otherwise =
        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) 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
"~~" 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) forall a. Semigroup a => a -> a -> a
<> Doc
"~~"

prettyInline DisplaySettings
ds (Pandoc.Quoted QuoteType
Pandoc.SingleQuote [Inline]
t) =
    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) forall a. Semigroup a => a -> a -> a
<> Doc
"'"
prettyInline DisplaySettings
ds (Pandoc.Quoted QuoteType
Pandoc.DoubleQuote [Inline]
t) =
    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) 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
"![" 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) forall a. Semigroup a => a -> a -> a
<> 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) forall a. Semigroup a => a -> a -> a
<> Doc
")"

-- 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.RawInline Format
_ Text
t) = Text -> Doc
PP.text Text
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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall a b. (a -> b) -> [a] -> [b]
map Inline -> Doc
prettyReference forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
getReferences
  where
    getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
    getReferences :: [Block] -> [Inline]
getReferences = forall a. (a -> Bool) -> [a] -> [a]
filter Inline -> Bool
isReferenceLink forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
"[" 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 forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
Pandoc.newlineToSpace [Inline]
text) forall a. Semigroup a => a -> a -> a
<>
        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) forall a. Semigroup a => a -> a -> a
<>
        (if Text -> Bool
T.null Text
title
            then forall a. Monoid a => a
mempty
            else Doc
PP.space forall a. Semigroup a => a -> a -> a
<> Doc
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> Doc
PP.text Text
title forall a. Semigroup a => a -> a -> a
<> Doc
"\"")
        forall a. Semigroup a => a -> a -> a
<> Doc
")"
    prettyReference Inline
_ = 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] forall a. Eq a => a -> a -> Bool
/= [Inline]
text
isReferenceLink Inline
_ = Bool
False