--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Patat.Presentation.Display
    ( Size
    , getDisplaySize

    , Display (..)
    , displayPresentation
    , displayPresentationError
    , dumpPresentation
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                        (guard, mplus)
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           Patat.Presentation.Display.CodeBlock
import           Patat.Presentation.Display.Internal
import           Patat.Presentation.Display.Table
import           Patat.Presentation.Internal
import qualified Patat.Presentation.SpeakerNotes      as SpeakerNotes
import           Patat.PrettyPrint                    ((<$$>), (<+>))
import qualified Patat.PrettyPrint                    as PP
import           Patat.Theme                          (Theme (..))
import qualified Patat.Theme                          as Theme
import           Prelude
import qualified System.Console.Terminal.Size         as Terminal
import qualified Text.Pandoc.Extended                 as Pandoc
import qualified Text.Pandoc.Writers.Shared           as Pandoc


--------------------------------------------------------------------------------
data Size = Size {Size -> Int
sRows :: Int, Size -> Int
sCols :: Int} deriving (Int -> Size -> ShowS
[Size] -> ShowS
Size -> [Char]
(Int -> Size -> ShowS)
-> (Size -> [Char]) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> [Char]
show :: Size -> [Char]
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show)


--------------------------------------------------------------------------------
getDisplaySize :: Presentation -> IO Size
getDisplaySize :: Presentation -> IO Size
getDisplaySize Presentation {[Char]
[Inline]
Index
SyntaxMap
Seq Breadcrumbs
Seq Slide
EncodingFallback
PresentationSettings
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
..} = do
    Maybe (Window Int)
mbWindow <- IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
Terminal.size
    let 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
pSettings) Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
            (Window Int -> Int
forall a. Window a -> a
Terminal.height (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow)
        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
pSettings) Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
            (Window Int -> Int
forall a. Window a -> a
Terminal.width  (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow)
    Size -> IO Size
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Size -> IO Size) -> Size -> IO Size
forall a b. (a -> b) -> a -> b
$ Size {Int
sRows :: Int
sCols :: Int
sRows :: Int
sCols :: Int
..}


--------------------------------------------------------------------------------
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 -> (Size -> DisplaySettings -> PP.Doc) -> PP.Doc
displayWithBorders :: Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders (Size Int
rows Int
columns) Presentation {[Char]
[Inline]
Index
SyntaxMap
Seq Breadcrumbs
Seq Slide
EncodingFallback
PresentationSettings
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
..} Size -> 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
<> Doc
PP.hardline) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
    PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
settings (Size -> DisplaySettings -> Doc
f Size
canvasSize 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    = PresentationSettings
pSettings {psColumns :: Maybe (FlexibleNum Int)
psColumns = FlexibleNum Int -> Maybe (FlexibleNum Int)
forall a. a -> Maybe a
Just (FlexibleNum Int -> Maybe (FlexibleNum Int))
-> FlexibleNum Int -> Maybe (FlexibleNum Int)
forall a b. (a -> b) -> a -> b
$ Int -> FlexibleNum Int
forall a. a -> FlexibleNum a
A.FlexibleNum Int
columns}
    ds :: DisplaySettings
ds          = DisplaySettings
        { 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
2) 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
SyntaxMap
Seq Breadcrumbs
Seq Slide
EncodingFallback
PresentationSettings
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
..} =
     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 -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres Size -> 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 -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((Size -> DisplaySettings -> Doc) -> Doc)
-> (Size -> DisplaySettings -> Doc) -> Doc
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 (Doc -> Display) -> Doc -> Display
forall a b. (a -> b) -> a -> b
$
            Size -> Presentation -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((Size -> DisplaySettings -> Doc) -> Doc)
-> (Size -> DisplaySettings -> Doc) -> Doc
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
                (Int
mLeft, Int
mRight) = PresentationSettings -> Index
marginsOf PresentationSettings
pSettings
                offsetRow :: Int
offsetRow       = (Size -> Int
sRows Size
canvasSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
prows Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                offsetCol :: Int
offsetCol       = ((Size -> Int
sCols Size
canvasSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mRight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
pcols Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                spaces :: Trimmable Doc
spaces          = Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable (Doc -> Trimmable Doc) -> Doc -> Trimmable Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
PP.spaces Int
offsetCol in
            [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
offsetRow Int -> Int -> Int
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
_)]] -> 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 -> (Size -> DisplaySettings -> Doc) -> Doc
displayWithBorders Size
size Presentation
pres ((Size -> DisplaySettings -> Doc) -> Doc)
-> (Size -> DisplaySettings -> Doc) -> Doc
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 Slide
EncodingFallback
PresentationSettings
pFilePath :: Presentation -> [Char]
pEncodingFallback :: Presentation -> EncodingFallback
pTitle :: Presentation -> [Inline]
pAuthor :: Presentation -> [Inline]
pSettings :: Presentation -> PresentationSettings
pSlides :: Presentation -> Seq Slide
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pActiveFragment :: Presentation -> Index
pSyntaxMap :: Presentation -> SyntaxMap
pFilePath :: [Char]
pEncodingFallback :: EncodingFallback
pTitle :: [Inline]
pAuthor :: [Inline]
pSettings :: PresentationSettings
pSlides :: Seq Slide
pBreadcrumbs :: Seq Breadcrumbs
pActiveFragment :: Index
pSyntaxMap :: SyntaxMap
..} =
    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
$ PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
pSettings (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 (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ 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 Size
size Presentation
pres {pActiveFragment :: Index
pActiveFragment = Index
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]
"}"]

    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
pSettings
    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
pSettings
    size :: Size
size  = Size {Int
sRows :: Int
sCols :: Int
sRows :: Int
sCols :: Int
..}


--------------------------------------------------------------------------------
formatWith :: PresentationSettings -> PP.Doc -> PP.Doc
formatWith :: PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
ps = Doc -> Doc
wrap (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
indent
  where
    (Int
marginLeft, Int
marginRight) = PresentationSettings -> Index
marginsOf 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
marginRight)
        (Maybe Bool, Maybe (FlexibleNum Int))
_                                      -> Doc -> Doc
forall a. a -> a
id
    spaces :: Trimmable Doc
spaces = Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable (Doc -> Trimmable Doc) -> Doc -> Trimmable Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
PP.spaces Int
marginLeft
    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 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]
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 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
    [ Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent
        (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable (Doc -> Trimmable Doc) -> Doc -> Trimmable Doc
forall a b. (a -> b) -> a -> b
$ DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeBulletList Doc
prefix)
        (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.Trimmable Doc
"    ")
        (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 = Doc
"  " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [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 :: Maybe Text
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) (Text -> Text) -> Maybe Text -> Maybe Text
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
        (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable (Doc -> Trimmable Doc) -> Doc -> Trimmable 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)
        (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.Trimmable Doc
"    ")
        (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 :: Trimmable Doc
quote = Doc -> Trimmable Doc
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 (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
        [ Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent
            (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.NotTrimmable (DisplaySettings -> (Theme -> Maybe Style) -> Doc -> Doc
themed DisplaySettings
ds Theme -> Maybe Style
themeDefinitionList Doc
":   "))
            (Doc -> Trimmable Doc
forall a. a -> Trimmable a
PP.Trimmable Doc
"    ") (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 :: Trimmable Doc
ind = Doc -> Trimmable Doc
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 Maybe Int
forall a. Maybe a
Nothing (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Trimmable Doc -> Trimmable Doc -> Doc -> Doc
PP.indent Trimmable Doc
ind Trimmable 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
")"

-- 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 = [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