{-# 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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> [Char]
$cshow :: Size -> [Char]
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show)
getDisplaySize :: Presentation -> IO Size
getDisplaySize :: Presentation -> IO Size
getDisplaySize Presentation {[Char]
[Inline]
Index
SyntaxMap
Seq Breadcrumbs
Seq Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
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
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
..} = do
Maybe (Window Int)
mbWindow <- forall n. Integral n => IO (Maybe (Window n))
Terminal.size
let 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
pSettings) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(forall a. Window a -> a
Terminal.height forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow)
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
pSettings) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(forall a. Window a -> a
Terminal.width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Window Int)
mbWindow)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Size {Int
sCols :: Int
sRows :: Int
sCols :: Int
sRows :: Int
..}
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)
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
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
pBreadcrumbs :: Presentation -> Seq Breadcrumbs
pSlides :: Presentation -> Seq Slide
pSettings :: Presentation -> PresentationSettings
pAuthor :: Presentation -> [Inline]
pTitle :: Presentation -> [Inline]
pEncodingFallback :: Presentation -> EncodingFallback
pFilePath :: Presentation -> [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
<> 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
(Int
sidx, Int
_) = Index
pActiveFragment
settings :: PresentationSettings
settings = PresentationSettings
pSettings {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
}
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
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
canvasSize :: Size
canvasSize = Int -> Int -> Size
Size (Int
rows forall a. Num a => a -> a -> a
- Int
2) Int
columns
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 Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
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
(Int
mLeft, Int
mRight) = PresentationSettings -> Index
marginsOf PresentationSettings
pSettings
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
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
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 Slide
EncodingFallback
PresentationSettings
pSyntaxMap :: SyntaxMap
pActiveFragment :: Index
pBreadcrumbs :: Seq Breadcrumbs
pSlides :: Seq Slide
pSettings :: PresentationSettings
pAuthor :: [Inline]
pTitle :: [Inline]
pEncodingFallback :: EncodingFallback
pFilePath :: [Char]
pSyntaxMap :: Presentation -> SyntaxMap
pActiveFragment :: Presentation -> Index
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
$ PresentationSettings -> Doc -> Doc
formatWith PresentationSettings
pSettings 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
Slide -> [Doc]
dumpSpeakerNotes 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]
]
dumpSpeakerNotes :: Slide -> [PP.Doc]
dumpSpeakerNotes :: Slide -> [Doc]
dumpSpeakerNotes Slide
slide = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide 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
SpeakerNotes.toText (Slide -> SpeakerNotes
slideSpeakerNotes Slide
slide) 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 forall a b. (a -> b) -> a -> b
$ [Char]
"{image: " forall a. [a] -> [a] -> [a]
++ [Char]
filepath forall a. [a] -> [a] -> [a]
++ [Char]
"}"]
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
pSettings
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
pSettings
size :: Size
size = 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
(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 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
col forall a. Num a => a -> a -> a
- Int
marginRight)
(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
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 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
'-'
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
")"
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
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