{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.Shared (
metaToContext
, metaToContext'
, addVariablesToContext
, getField
, setField
, resetField
, defField
, getLang
, tagWithAttrs
, isDisplayMath
, fixDisplayMath
, unsmartify
, gridTable
, lookupMetaBool
, lookupMetaBlocks
, lookupMetaInlines
, lookupMetaString
, stripLeadingTrailingSpace
, toSubscript
, toSuperscript
, toTableOfContents
, endsWithPlain
, toLegacyTable
, splitSentences
)
where
import Safe (lastMay)
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromMaybe, isNothing)
import Control.Monad (zipWithM)
import Data.Aeson (ToJSON (..), encode)
import Data.Char (chr, ord, isSpace)
import Data.List (groupBy, intersperse, transpose, foldl')
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import Data.Text.Conversions (FromText(..))
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink, blocksToInlines)
import Text.Pandoc.Walk (walk)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (escapeStringForXML)
import Text.DocTemplates (Context(..), Val(..), TemplateTarget,
ToContext(..), FromContext(..))
metaToContext :: (Monad m, TemplateTarget a)
=> WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext :: WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter Meta
meta =
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Context a -> m (Context a)
forall (m :: * -> *) a. Monad m => a -> m a
return Context a
forall a. Monoid a => a
mempty
Just Template Text
_ -> WriterOptions -> Context a -> Context a
forall a.
TemplateTarget a =>
WriterOptions -> Context a -> Context a
addVariablesToContext WriterOptions
opts (Context a -> Context a) -> m (Context a) -> m (Context a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
metaToContext' [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter Meta
meta
metaToContext' :: (Monad m, TemplateTarget a)
=> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext' :: ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> Meta -> m (Context a)
metaToContext' [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter (Meta Map Text MetaValue
metamap) =
Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Context a)
-> m (Map Text (Val a)) -> m (Context a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MetaValue -> m (Val a))
-> Map Text MetaValue -> m (Map Text (Val a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter) Map Text MetaValue
metamap
addVariablesToContext :: TemplateTarget a
=> WriterOptions -> Context a -> Context a
addVariablesToContext :: WriterOptions -> Context a -> Context a
addVariablesToContext WriterOptions
opts Context a
c1 =
Context a
c2 Context a -> Context a -> Context a
forall a. Semigroup a => a -> a -> a
<> (Text -> a
forall a. FromText a => Text -> a
fromText (Text -> a) -> Context Text -> Context a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Context Text
writerVariables WriterOptions
opts) Context a -> Context a -> Context a
forall a. Semigroup a => a -> a -> a
<> Context a
c1
where
c2 :: Context a
c2 = Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Context a) -> Map Text (Val a) -> Context a
forall a b. (a -> b) -> a -> b
$
Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"meta-json" (Doc a -> Val a
forall a. Doc a -> Val a
SimpleVal (Doc a -> Val a) -> Doc a -> Val a
forall a b. (a -> b) -> a -> b
$ a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a -> Doc a) -> a -> Doc a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. FromText a => Text -> a
fromText Text
jsonrep)
Map Text (Val a)
forall a. Monoid a => a
mempty
jsonrep :: Text
jsonrep = ByteString -> Text
UTF8.toText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Context a -> Value
forall a. ToJSON a => a -> Value
toJSON Context a
c1
metaValueToVal :: (Monad m, TemplateTarget a)
=> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> MetaValue
-> m (Val a)
metaValueToVal :: ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter (MetaMap Map Text MetaValue
metamap) =
Context a -> Val a
forall a. Context a -> Val a
MapVal (Context a -> Val a)
-> (Map Text (Val a) -> Context a) -> Map Text (Val a) -> Val a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Val a) -> m (Map Text (Val a)) -> m (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MetaValue -> m (Val a))
-> Map Text MetaValue -> m (Map Text (Val a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter) Map Text MetaValue
metamap
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter (MetaList [MetaValue]
xs) = [Val a] -> Val a
forall a. [Val a] -> Val a
ListVal ([Val a] -> Val a) -> m [Val a] -> m (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(MetaValue -> m (Val a)) -> [MetaValue] -> m [Val a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a)) -> MetaValue -> m (Val a)
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
inlineWriter) [MetaValue]
xs
metaValueToVal [Block] -> m (Doc a)
_ [Inline] -> m (Doc a)
_ (MetaBool Bool
b) = Val a -> m (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> m (Val a)) -> Val a -> m (Val a)
forall a b. (a -> b) -> a -> b
$ Bool -> Val a
forall a. Bool -> Val a
BoolVal Bool
b
metaValueToVal [Block] -> m (Doc a)
_ [Inline] -> m (Doc a)
inlineWriter (MetaString Text
s) =
Doc a -> Val a
forall a. Doc a -> Val a
SimpleVal (Doc a -> Val a) -> m (Doc a) -> m (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Doc a)
inlineWriter (Many Inline -> [Inline]
forall a. Many a -> [a]
Builder.toList (Text -> Many Inline
Builder.text Text
s))
metaValueToVal [Block] -> m (Doc a)
blockWriter [Inline] -> m (Doc a)
_ (MetaBlocks [Block]
bs) = Doc a -> Val a
forall a. Doc a -> Val a
SimpleVal (Doc a -> Val a) -> m (Doc a) -> m (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Doc a)
blockWriter [Block]
bs
metaValueToVal [Block] -> m (Doc a)
_ [Inline] -> m (Doc a)
inlineWriter (MetaInlines [Inline]
is) = Doc a -> Val a
forall a. Doc a -> Val a
SimpleVal (Doc a -> Val a) -> m (Doc a) -> m (Val a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Doc a)
inlineWriter [Inline]
is
getField :: FromContext a b => Text -> Context a -> Maybe b
getField :: Text -> Context a -> Maybe b
getField Text
field (Context Map Text (Val a)
m) = Text -> Map Text (Val a) -> Maybe (Val a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
field Map Text (Val a)
m Maybe (Val a) -> (Val a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val a -> Maybe b
forall a b. FromContext a b => Val a -> Maybe b
fromVal
setField :: ToContext a b => Text -> b -> Context a -> Context a
setField :: Text -> b -> Context a -> Context a
setField Text
field b
val (Context Map Text (Val a)
m) =
Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Context a) -> Map Text (Val a) -> Context a
forall a b. (a -> b) -> a -> b
$ (Val a -> Val a -> Val a)
-> Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Val a -> Val a -> Val a
forall a. Val a -> Val a -> Val a
combine Text
field (b -> Val a
forall a b. ToContext a b => b -> Val a
toVal b
val) Map Text (Val a)
m
where
combine :: Val a -> Val a -> Val a
combine Val a
newval (ListVal [Val a]
xs) = [Val a] -> Val a
forall a. [Val a] -> Val a
ListVal ([Val a]
xs [Val a] -> [Val a] -> [Val a]
forall a. [a] -> [a] -> [a]
++ [Val a
newval])
combine Val a
newval Val a
x = [Val a] -> Val a
forall a. [Val a] -> Val a
ListVal [Val a
x, Val a
newval]
resetField :: ToContext a b => Text -> b -> Context a -> Context a
resetField :: Text -> b -> Context a -> Context a
resetField Text
field b
val (Context Map Text (Val a)
m) =
Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
field (b -> Val a
forall a b. ToContext a b => b -> Val a
toVal b
val) Map Text (Val a)
m)
defField :: ToContext a b => Text -> b -> Context a -> Context a
defField :: Text -> b -> Context a -> Context a
defField Text
field b
val (Context Map Text (Val a)
m) =
Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context ((Val a -> Val a -> Val a)
-> Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Val a -> Val a -> Val a
forall p p. p -> p -> p
f Text
field (b -> Val a
forall a b. ToContext a b => b -> Val a
toVal b
val) Map Text (Val a)
m)
where
f :: p -> p -> p
f p
_newval p
oldval = p
oldval
getLang :: WriterOptions -> Meta -> Maybe Text
getLang :: WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
opts Meta
meta =
case Text -> Context Text -> Maybe Text
forall a b. FromContext a b => Text -> Context a -> Maybe b
lookupContext Text
"lang" (WriterOptions -> Context Text
writerVariables WriterOptions
opts) of
Just Text
s -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Maybe Text
_ ->
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"lang" Meta
meta of
Just (MetaBlocks [Para [Str Text
s]]) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Just (MetaBlocks [Plain [Str Text
s]]) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Just (MetaInlines [Str Text
s]) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Just (MetaString Text
s) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Maybe MetaValue
_ -> Maybe Text
forall a. Maybe a
Nothing
tagWithAttrs :: HasChars a => Text -> Attr -> Doc a
tagWithAttrs :: Text -> Attr -> Doc a
tagWithAttrs Text
tag (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hsep
[Doc a
"<" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
tag)
,if Text -> Bool
T.null Text
ident
then Doc a
forall a. Doc a
empty
else Doc a
"id=" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ident)
,if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
then Doc a
forall a. Doc a
empty
else Doc a
"class=" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ([Text] -> Text
T.unwords [Text]
classes))
,[Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hsep (((Text, Text) -> Doc a) -> [(Text, Text)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> String -> Doc a
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack Text
k) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"=" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
Doc a -> Doc a
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> Text
escapeStringForXML Text
v))) [(Text, Text)]
kvs)
] Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
">"
isDisplayMath :: Inline -> Bool
isDisplayMath :: Inline -> Bool
isDisplayMath (Math MathType
DisplayMath Text
_) = Bool
True
isDisplayMath (Span Attr
_ [Math MathType
DisplayMath Text
_]) = Bool
True
isDisplayMath Inline
_ = Bool
False
stripLeadingTrailingSpace :: [Inline] -> [Inline]
stripLeadingTrailingSpace :: [Inline] -> [Inline]
stripLeadingTrailingSpace = [Inline] -> [Inline]
go ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
go ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
forall a. [a] -> [a]
reverse
where go :: [Inline] -> [Inline]
go (Inline
Space:[Inline]
xs) = [Inline]
xs
go (Inline
SoftBreak:[Inline]
xs) = [Inline]
xs
go [Inline]
xs = [Inline]
xs
fixDisplayMath :: Block -> Block
fixDisplayMath :: Block -> Block
fixDisplayMath (Plain [Inline]
lst)
| (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
isDisplayMath [Inline]
lst Bool -> Bool -> Bool
&& Bool -> Bool
not ((Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
isDisplayMath [Inline]
lst) =
Attr -> [Block] -> Block
Div (Text
"",[Text
"math"],[]) ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
([Inline] -> Block) -> [[Inline]] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Block
Plain ([[Inline]] -> [Block]) -> [[Inline]] -> [Block]
forall a b. (a -> b) -> a -> b
$
([Inline] -> Bool) -> [[Inline]] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Inline] -> Bool) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Inline]] -> [[Inline]]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [Inline]
stripLeadingTrailingSpace ([[Inline]] -> [[Inline]]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
(Inline -> Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Inline
x Inline
y -> (Inline -> Bool
isDisplayMath Inline
x Bool -> Bool -> Bool
&& Inline -> Bool
isDisplayMath Inline
y) Bool -> Bool -> Bool
||
Bool -> Bool
not (Inline -> Bool
isDisplayMath Inline
x Bool -> Bool -> Bool
|| Inline -> Bool
isDisplayMath Inline
y)) [Inline]
lst
fixDisplayMath (Para [Inline]
lst)
| (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Inline -> Bool
isDisplayMath [Inline]
lst Bool -> Bool -> Bool
&& Bool -> Bool
not ((Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
isDisplayMath [Inline]
lst) =
Attr -> [Block] -> Block
Div (Text
"",[Text
"math"],[]) ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
([Inline] -> Block) -> [[Inline]] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Block
Para ([[Inline]] -> [Block]) -> [[Inline]] -> [Block]
forall a b. (a -> b) -> a -> b
$
([Inline] -> Bool) -> [[Inline]] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Inline] -> Bool) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Inline]] -> [[Inline]]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
([Inline] -> [Inline]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> [Inline]
stripLeadingTrailingSpace ([[Inline]] -> [[Inline]]) -> [[Inline]] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$
(Inline -> Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Inline
x Inline
y -> (Inline -> Bool
isDisplayMath Inline
x Bool -> Bool -> Bool
&& Inline -> Bool
isDisplayMath Inline
y) Bool -> Bool -> Bool
||
Bool -> Bool
not (Inline -> Bool
isDisplayMath Inline
x Bool -> Bool -> Bool
|| Inline -> Bool
isDisplayMath Inline
y)) [Inline]
lst
fixDisplayMath Block
x = Block
x
unsmartify :: WriterOptions -> Text -> Text
unsmartify :: WriterOptions -> Text -> Text
unsmartify WriterOptions
opts = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
Char
'\8217' -> Text
"'"
Char
'\8230' -> Text
"..."
Char
'\8211'
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_old_dashes WriterOptions
opts -> Text
"-"
| Bool
otherwise -> Text
"--"
Char
'\8212'
| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_old_dashes WriterOptions
opts -> Text
"--"
| Bool
otherwise -> Text
"---"
Char
'\8220' -> Text
"\""
Char
'\8221' -> Text
"\""
Char
'\8216' -> Text
"'"
Char
_ -> Char -> Text
T.singleton Char
c
gridTable :: (Monad m, HasChars a)
=> WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable :: WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> m (Doc a)
blocksToDoc Bool
headless [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows = do
let numcols :: Int
numcols = NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
([[Block]] -> Int) -> [[[Block]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Block]]
headers[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
rows))
let officialWidthsInChars :: [a] -> [b]
officialWidthsInChars [a]
widths' = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (
(\b
x -> if b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
1 then b
1 else b
x) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\b
x -> b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
3) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WriterOptions -> Int
writerColumns WriterOptions
opts) a -> a -> a
forall a. Num a => a -> a -> a
*)
) [a]
widths'
let handleGivenWidthsInChars :: [Int] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidthsInChars [Int]
widthsInChars' = do
let useWidth :: Int -> WriterOptions
useWidth Int
w = WriterOptions
opts{writerColumns :: Int
writerColumns = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (WriterOptions -> Int
writerColumns WriterOptions
opts)}
let columnOptions :: [WriterOptions]
columnOptions = (Int -> WriterOptions) -> [Int] -> [WriterOptions]
forall a b. (a -> b) -> [a] -> [b]
map Int -> WriterOptions
useWidth [Int]
widthsInChars'
[Doc a]
rawHeaders' <- (WriterOptions -> [Block] -> m (Doc a))
-> [WriterOptions] -> [[Block]] -> m [Doc a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM WriterOptions -> [Block] -> m (Doc a)
blocksToDoc [WriterOptions]
columnOptions [[Block]]
headers
[[Doc a]]
rawRows' <- ([[Block]] -> m [Doc a]) -> [[[Block]]] -> m [[Doc a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(\[[Block]]
cs -> (WriterOptions -> [Block] -> m (Doc a))
-> [WriterOptions] -> [[Block]] -> m [Doc a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM WriterOptions -> [Block] -> m (Doc a)
blocksToDoc [WriterOptions]
columnOptions [[Block]]
cs)
[[[Block]]]
rows
([Int], [Doc a], [[Doc a]]) -> m ([Int], [Doc a], [[Doc a]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int]
widthsInChars', [Doc a]
rawHeaders', [[Doc a]]
rawRows')
let handleGivenWidths :: [a] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidths [a]
widths' = [Int] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidthsInChars
([a] -> [Int]
forall a b. (RealFrac a, Integral b) => [a] -> [b]
officialWidthsInChars [a]
widths')
let handleFullWidths :: [a] -> m ([Int], [Doc a], [[Doc a]])
handleFullWidths [a]
widths' = do
[Doc a]
rawHeaders' <- ([Block] -> m (Doc a)) -> [[Block]] -> m [Doc a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m (Doc a)
blocksToDoc WriterOptions
opts) [[Block]]
headers
[[Doc a]]
rawRows' <- ([[Block]] -> m [Doc a]) -> [[[Block]]] -> m [[Doc a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> m (Doc a)) -> [[Block]] -> m [Doc a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> m (Doc a)
blocksToDoc WriterOptions
opts)) [[[Block]]]
rows
let numChars :: [Doc a] -> Int
numChars = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc a] -> Maybe (NonEmpty Int)) -> [Doc a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc a] -> [Int]) -> [Doc a] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Int) -> [Doc a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc a -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
let minWidthsInChars :: [Int]
minWidthsInChars =
([Doc a] -> Int) -> [[Doc a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc a] -> Int
numChars ([[Doc a]] -> [Int]) -> [[Doc a]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Doc a]] -> [[Doc a]]
forall a. [[a]] -> [[a]]
transpose ([Doc a]
rawHeaders' [Doc a] -> [[Doc a]] -> [[Doc a]]
forall a. a -> [a] -> [a]
: [[Doc a]]
rawRows')
let widthsInChars' :: [Int]
widthsInChars' = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
[Int]
minWidthsInChars
([a] -> [Int]
forall a b. (RealFrac a, Integral b) => [a] -> [b]
officialWidthsInChars [a]
widths')
([Int], [Doc a], [[Doc a]]) -> m ([Int], [Doc a], [[Doc a]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int]
widthsInChars', [Doc a]
rawHeaders', [[Doc a]]
rawRows')
let handleZeroWidths :: [a] -> m ([Int], [Doc a], [[Doc a]])
handleZeroWidths [a]
widths' = do
([Int]
widthsInChars', [Doc a]
rawHeaders', [[Doc a]]
rawRows') <- [a] -> m ([Int], [Doc a], [[Doc a]])
forall a. RealFrac a => [a] -> m ([Int], [Doc a], [[Doc a]])
handleFullWidths [a]
widths'
if (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
widthsInChars' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerColumns WriterOptions
opts
then do
let evenCols :: Int
evenCols = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
5
(((WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numcols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
let (Int
numToExpand, Int
colsToExpand) =
(Int -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [Int] -> (Int, Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
w (Int
n, Int
tot) -> if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
evenCols
then (Int
n, Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
evenCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w))
else (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
tot))
(Int
0,Int
0) [Int]
widthsInChars'
let expandAllowance :: Int
expandAllowance = Int
colsToExpand Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numToExpand
let newWidthsInChars :: [Int]
newWidthsInChars = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
w -> if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
evenCols
then Int
w
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min
(Int
evenCols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
expandAllowance)
Int
w)
[Int]
widthsInChars'
[Int] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidthsInChars [Int]
newWidthsInChars
else ([Int], [Doc a], [[Doc a]]) -> m ([Int], [Doc a], [[Doc a]])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int]
widthsInChars', [Doc a]
rawHeaders', [[Doc a]]
rawRows')
let handleWidths :: m ([Int], [Doc a], [[Doc a]])
handleWidths
| WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapNone = [Double] -> m ([Int], [Doc a], [[Doc a]])
forall a. RealFrac a => [a] -> m ([Int], [Doc a], [[Doc a]])
handleFullWidths [Double]
widths
| (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths = [Double] -> m ([Int], [Doc a], [[Doc a]])
forall a. RealFrac a => [a] -> m ([Int], [Doc a], [[Doc a]])
handleZeroWidths [Double]
widths
| Bool
otherwise = [Double] -> m ([Int], [Doc a], [[Doc a]])
forall a. RealFrac a => [a] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidths [Double]
widths
([Int]
widthsInChars, [Doc a]
rawHeaders, [[Doc a]]
rawRows) <- m ([Int], [Doc a], [[Doc a]])
handleWidths
let hpipeBlocks :: [Doc a] -> Doc a
hpipeBlocks [Doc a]
blocks = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat [Doc a
beg, Doc a
middle, Doc a
end]
where sep' :: Doc a
sep' = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" | "
beg :: Doc a
beg = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"| "
end :: Doc a
end = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" |"
middle :: Doc a
middle = Doc a -> Doc a
forall a. Doc a -> Doc a
chomp (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
sep' [Doc a]
blocks
let makeRow :: [Doc a] -> Doc a
makeRow = [Doc a] -> Doc a
forall a. HasChars a => [Doc a] -> Doc a
hpipeBlocks ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc a -> Doc a) -> [Int] -> [Doc a] -> [Doc a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
widthsInChars
let head' :: Doc a
head' = [Doc a] -> Doc a
makeRow [Doc a]
rawHeaders
let rows' :: [Doc a]
rows' = ([Doc a] -> Doc a) -> [[Doc a]] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc a] -> Doc a
makeRow ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Doc a) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Doc a -> Doc a
forall a. Doc a -> Doc a
chomp) [[Doc a]]
rawRows
let borderpart :: Char -> Alignment -> Int -> Doc a
borderpart Char
ch Alignment
align Int
widthInChars =
(if Alignment
align Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft Bool -> Bool -> Bool
|| Alignment
align Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
then Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
':'
else Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
String -> Doc a
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
widthInChars Char
ch) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
(if Alignment
align Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight Bool -> Bool -> Bool
|| Alignment
align Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
then Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
':'
else Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch)
let border :: Char -> [Alignment] -> [Int] -> Doc a
border Char
ch [Alignment]
aligns' [Int]
widthsInChars' =
Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'+' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
[Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat (Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'+') ((Alignment -> Int -> Doc a) -> [Alignment] -> [Int] -> [Doc a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Char -> Alignment -> Int -> Doc a
forall a. HasChars a => Char -> Alignment -> Int -> Doc a
borderpart Char
ch)
[Alignment]
aligns' [Int]
widthsInChars')) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'+'
let body :: Doc a
body = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'-' (Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [Int]
widthsInChars)
[Doc a]
rows'
let head'' :: Doc a
head'' = if Bool
headless
then Doc a
forall a. Doc a
empty
else Doc a
head' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'=' [Alignment]
aligns [Int]
widthsInChars
if Bool
headless
then Doc a -> m (Doc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc a -> m (Doc a)) -> Doc a -> m (Doc a)
forall a b. (a -> b) -> a -> b
$
Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'-' [Alignment]
aligns [Int]
widthsInChars Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
Doc a
body Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'-' (Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [Int]
widthsInChars
else Doc a -> m (Doc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc a -> m (Doc a)) -> Doc a -> m (Doc a)
forall a b. (a -> b) -> a -> b
$
Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'-' (Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [Int]
widthsInChars Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
Doc a
head'' Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
Doc a
body Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$
Char -> [Alignment] -> [Int] -> Doc a
forall a. HasChars a => Char -> [Alignment] -> [Int] -> Doc a
border Char
'-' (Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [Int]
widthsInChars
lookupMetaBool :: Text -> Meta -> Bool
lookupMetaBool :: Text -> Meta -> Bool
lookupMetaBool Text
key Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
Just (MetaBlocks [Block]
_) -> Bool
True
Just (MetaInlines [Inline]
_) -> Bool
True
Just (MetaString Text
x) -> Bool -> Bool
not (Text -> Bool
T.null Text
x)
Just (MetaBool Bool
True) -> Bool
True
Maybe MetaValue
_ -> Bool
False
lookupMetaBlocks :: Text -> Meta -> [Block]
lookupMetaBlocks :: Text -> Meta -> [Block]
lookupMetaBlocks Text
key Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
Just (MetaBlocks [Block]
bs) -> [Block]
bs
Just (MetaInlines [Inline]
ils) -> [[Inline] -> Block
Plain [Inline]
ils]
Just (MetaString Text
s) -> [[Inline] -> Block
Plain [Text -> Inline
Str Text
s]]
Maybe MetaValue
_ -> []
lookupMetaInlines :: Text -> Meta -> [Inline]
lookupMetaInlines :: Text -> Meta -> [Inline]
lookupMetaInlines Text
key Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
Just (MetaString Text
s) -> [Text -> Inline
Str Text
s]
Just (MetaInlines [Inline]
ils) -> [Inline]
ils
Just (MetaBlocks [Plain [Inline]
ils]) -> [Inline]
ils
Just (MetaBlocks [Para [Inline]
ils]) -> [Inline]
ils
Maybe MetaValue
_ -> []
lookupMetaString :: Text -> Meta -> Text
lookupMetaString :: Text -> Meta -> Text
lookupMetaString Text
key Meta
meta =
case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
Just (MetaString Text
s) -> Text
s
Just (MetaInlines [Inline]
ils) -> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
Just (MetaBlocks [Block]
bs) -> [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bs
Just (MetaBool Bool
b) -> String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
b)
Maybe MetaValue
_ -> Text
""
toSuperscript :: Char -> Maybe Char
toSuperscript :: Char -> Maybe Char
toSuperscript Char
'1' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00B9'
toSuperscript Char
'2' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00B2'
toSuperscript Char
'3' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x00B3'
toSuperscript Char
'+' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207A'
toSuperscript Char
'-' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207B'
toSuperscript Char
'\x2212' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207B'
toSuperscript Char
'=' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207C'
toSuperscript Char
'(' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207D'
toSuperscript Char
')' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x207E'
toSuperscript Char
c
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' =
Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int
0x2070 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48))
| Char -> Bool
isSpace Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
| Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
toSubscript :: Char -> Maybe Char
toSubscript :: Char -> Maybe Char
toSubscript Char
'+' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x208A'
toSubscript Char
'-' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x208B'
toSubscript Char
'=' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x208C'
toSubscript Char
'(' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x208D'
toSubscript Char
')' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\x208E'
toSubscript Char
c
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' =
Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int
0x2080 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48))
| Char -> Bool
isSpace Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
| Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
toTableOfContents :: WriterOptions
-> [Block]
-> Block
toTableOfContents :: WriterOptions -> [Block] -> Block
toTableOfContents WriterOptions
opts [Block]
bs =
[[Block]] -> Block
BulletList ([[Block]] -> Block) -> [[Block]] -> Block
forall a b. (a -> b) -> a -> b
$ ([Block] -> Bool) -> [[Block]] -> [[Block]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Block] -> Bool) -> [Block] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
([[Block]] -> [[Block]]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ (Block -> [Block]) -> [Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> Block -> [Block]
sectionToListItem WriterOptions
opts)
([Block] -> [[Block]]) -> [Block] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) Maybe Int
forall a. Maybe a
Nothing [Block]
bs
sectionToListItem :: WriterOptions -> Block -> [Block]
sectionToListItem :: WriterOptions -> Block -> [Block]
sectionToListItem WriterOptions
opts (Div (Text
ident,[Text]
_,[(Text, Text)]
_)
(Header Int
lev (Text
_,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils : [Block]
subsecs))
| Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WriterOptions -> Int
writerTOCDepth WriterOptions
opts
, Bool -> Bool
not (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs) Bool -> Bool -> Bool
&& Text
"unlisted" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes)
= [Inline] -> Block
Plain [Inline]
headerLink Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [[[Block]] -> Block
BulletList [[Block]]
listContents | Bool -> Bool
not ([[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
listContents)]
where
num :: Text
num = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs
addNumber :: [Inline] -> [Inline]
addNumber = if Text -> Bool
T.null Text
num
then [Inline] -> [Inline]
forall a. a -> a
id
else (Attr -> [Inline] -> Inline
Span (Text
"",[Text
"toc-section-number"],[])
[Text -> Inline
Str Text
num] Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:) ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
headerText' :: [Inline]
headerText' = [Inline] -> [Inline]
addNumber ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deLink (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
deNote) [Inline]
ils
headerLink :: [Inline]
headerLink = if Text -> Bool
T.null Text
ident
then [Inline]
headerText'
else [Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
nullAttr [Inline]
headerText' (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident, Text
"")]
listContents :: [[Block]]
listContents = ([Block] -> Bool) -> [[Block]] -> [[Block]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Block] -> Bool) -> [Block] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Block]] -> [[Block]]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ (Block -> [Block]) -> [Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map (WriterOptions -> Block -> [Block]
sectionToListItem WriterOptions
opts) [Block]
subsecs
sectionToListItem WriterOptions
_ Block
_ = []
endsWithPlain :: [Block] -> Bool
endsWithPlain :: [Block] -> Bool
endsWithPlain [Block]
xs =
case [Block] -> Maybe Block
forall a. [a] -> Maybe a
lastMay [Block]
xs of
Just Plain{} -> Bool
True
Maybe Block
_ -> Bool
False
toLegacyTable :: Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable :: Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable (Caption Maybe [Inline]
_ [Block]
cbody) [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot
= ([Inline]
cbody', [Alignment]
aligns, [Double]
widths, [[Block]]
th', [[[Block]]]
tb')
where
numcols :: Int
numcols = [ColSpec] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs
([Alignment]
aligns, [ColWidth]
mwidths) = [ColSpec] -> ([Alignment], [ColWidth])
forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
specs
fromWidth :: ColWidth -> Double
fromWidth (ColWidth Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
w
fromWidth ColWidth
_ = Double
0
widths :: [Double]
widths = (ColWidth -> Double) -> [ColWidth] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Double
fromWidth [ColWidth]
mwidths
unRow :: Row -> [Cell]
unRow (Row Attr
_ [Cell]
x) = [Cell]
x
unBody :: TableBody -> [Row]
unBody (TableBody Attr
_ RowHeadColumns
_ [Row]
hd [Row]
bd) = [Row]
hd [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
bd
unBodies :: [TableBody] -> [Row]
unBodies = (TableBody -> [Row]) -> [TableBody] -> [Row]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [Row]
unBody
TableHead Attr
_ [Row]
th = Int -> TableHead -> TableHead
Builder.normalizeTableHead Int
numcols TableHead
thead
tb :: [TableBody]
tb = (TableBody -> TableBody) -> [TableBody] -> [TableBody]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TableBody -> TableBody
Builder.normalizeTableBody Int
numcols) [TableBody]
tbodies
TableFoot Attr
_ [Row]
tf = Int -> TableFoot -> TableFoot
Builder.normalizeTableFoot Int
numcols TableFoot
tfoot
cbody' :: [Inline]
cbody' = [Block] -> [Inline]
blocksToInlines [Block]
cbody
([[Block]]
th', [[[Block]]]
tb') = case [Row]
th of
Row
r:[Row]
rs -> let ([[[Block]]]
pendingPieces, [[Block]]
r') = [[[Block]]] -> [Cell] -> ([[[Block]]], [[Block]])
placeCutCells [] ([Cell] -> ([[[Block]]], [[Block]]))
-> [Cell] -> ([[[Block]]], [[Block]])
forall a b. (a -> b) -> a -> b
$ Row -> [Cell]
unRow Row
r
rs' :: [[[Block]]]
rs' = [[[Block]]] -> [Row] -> [[[Block]]]
cutRows [[[Block]]]
pendingPieces ([Row] -> [[[Block]]]) -> [Row] -> [[[Block]]]
forall a b. (a -> b) -> a -> b
$ [Row]
rs [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [TableBody] -> [Row]
unBodies [TableBody]
tb [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
tf
in ([[Block]]
r', [[[Block]]]
rs')
[] -> ([], [[[Block]]] -> [Row] -> [[[Block]]]
cutRows [] ([Row] -> [[[Block]]]) -> [Row] -> [[[Block]]]
forall a b. (a -> b) -> a -> b
$ [TableBody] -> [Row]
unBodies [TableBody]
tb [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
tf)
placeCutCells :: [[[Block]]] -> [Cell] -> ([[[Block]]], [[Block]])
placeCutCells [[[Block]]]
pendingPieces [Cell]
cells
| ([Block]
p:[[Block]]
ps):[[[Block]]]
pendingPieces' <- [[[Block]]]
pendingPieces
= let ([[[Block]]]
pendingPieces'', [[Block]]
rowPieces) = [[[Block]]] -> [Cell] -> ([[[Block]]], [[Block]])
placeCutCells [[[Block]]]
pendingPieces' [Cell]
cells
in ([[Block]]
ps [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
pendingPieces'', [Block]
p [Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
: [[Block]]
rowPieces)
| Cell
c:[Cell]
cells' <- [Cell]
cells
= let (Int
h, Int
w, [Block]
cBody) = Cell -> (Int, Int, [Block])
getComponents Cell
c
cRowPieces :: [[Block]]
cRowPieces = [Block]
cBody [Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
: Int -> [Block] -> [[Block]]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Block]
forall a. Monoid a => a
mempty
cPendingPieces :: [[[Block]]]
cPendingPieces = Int -> [[Block]] -> [[[Block]]]
forall a. Int -> a -> [a]
replicate Int
w ([[Block]] -> [[[Block]]]) -> [[Block]] -> [[[Block]]]
forall a b. (a -> b) -> a -> b
$ Int -> [Block] -> [[Block]]
forall a. Int -> a -> [a]
replicate (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Block]
forall a. Monoid a => a
mempty
pendingPieces' :: [[[Block]]]
pendingPieces' = ([[Block]] -> Bool) -> [[[Block]]] -> [[[Block]]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[Block]]]
pendingPieces
([[[Block]]]
pendingPieces'', [[Block]]
rowPieces) = [[[Block]]] -> [Cell] -> ([[[Block]]], [[Block]])
placeCutCells [[[Block]]]
pendingPieces' [Cell]
cells'
in ([[[Block]]]
cPendingPieces [[[Block]]] -> [[[Block]]] -> [[[Block]]]
forall a. Semigroup a => a -> a -> a
<> [[[Block]]]
pendingPieces'', [[Block]]
cRowPieces [[Block]] -> [[Block]] -> [[Block]]
forall a. Semigroup a => a -> a -> a
<> [[Block]]
rowPieces)
| Bool
otherwise = ([], [])
cutRows :: [[[Block]]] -> [Row] -> [[[Block]]]
cutRows [[[Block]]]
pendingPieces (Row
r:[Row]
rs)
= let ([[[Block]]]
pendingPieces', [[Block]]
r') = [[[Block]]] -> [Cell] -> ([[[Block]]], [[Block]])
placeCutCells [[[Block]]]
pendingPieces ([Cell] -> ([[[Block]]], [[Block]]))
-> [Cell] -> ([[[Block]]], [[Block]])
forall a b. (a -> b) -> a -> b
$ Row -> [Cell]
unRow Row
r
rs' :: [[[Block]]]
rs' = [[[Block]]] -> [Row] -> [[[Block]]]
cutRows [[[Block]]]
pendingPieces' [Row]
rs
in [[Block]]
r' [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rs'
cutRows [[[Block]]]
_ [] = []
getComponents :: Cell -> (Int, Int, [Block])
getComponents (Cell Attr
_ Alignment
_ (RowSpan Int
h) (ColSpan Int
w) [Block]
body)
= (Int
h, Int
w, [Block]
body)
splitSentences :: Doc Text -> Doc Text
splitSentences :: Doc Text -> Doc Text
splitSentences = [Doc Text] -> Doc Text
go ([Doc Text] -> Doc Text)
-> (Doc Text -> [Doc Text]) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text]
forall a. Doc a -> [Doc a]
toList
where
go :: [Doc Text] -> Doc Text
go [] = Doc Text
forall a. Monoid a => a
mempty
go (Text Int
len Text
t : Doc Text
BreakingSpace : [Doc Text]
xs) =
if Text -> Bool
isSentenceEnding Text
t
then Int -> Text -> Doc Text
forall a. Int -> a -> Doc a
Text Int
len Text
t Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
NewLine Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go [Doc Text]
xs
else Int -> Text -> Doc Text
forall a. Int -> a -> Doc a
Text Int
len Text
t Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
BreakingSpace Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go [Doc Text]
xs
go (Doc Text
x:[Doc Text]
xs) = Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
go [Doc Text]
xs
toList :: Doc a -> [Doc a]
toList (Concat (Concat Doc a
a Doc a
b) Doc a
c) = Doc a -> [Doc a]
toList (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
a (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
b Doc a
c))
toList (Concat Doc a
a Doc a
b) = Doc a
a Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
toList Doc a
b
toList Doc a
x = [Doc a
x]
isSentenceEnding :: Text -> Bool
isSentenceEnding Text
t =
case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
Just (Text
t',Char
c)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' -> Bool
True
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x201D' ->
case Text -> Maybe (Text, Char)
T.unsnoc Text
t' of
Just (Text
_,Char
d) -> Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
Maybe (Text, Char)
_ -> Bool
False
Maybe (Text, Char)
_ -> Bool
False