{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Shared
   Copyright   : Copyright (C) 2013-2019 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Shared utility functions for pandoc writers.
-}
module Text.Pandoc.Writers.Shared (
                       metaToContext
                     , metaToContext'
                     , addVariablesToContext
                     , getField
                     , setField
                     , resetField
                     , defField
                     , tagWithAttrs
                     , isDisplayMath
                     , fixDisplayMath
                     , unsmartify
                     , gridTable
                     , lookupMetaBool
                     , lookupMetaBlocks
                     , lookupMetaInlines
                     , lookupMetaString
                     , stripLeadingTrailingSpace
                     , toSubscript
                     , toSuperscript
                     , toTableOfContents
                     , endsWithPlain
                     )
where
import Prelude
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.Text.Conversions (FromText(..))
import qualified Data.Map as M
import qualified Data.Text as T
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)
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(..))

-- | Create template Context from a 'Meta' and an association list
-- of variables, specified at the command line or in the writer.
-- Variables overwrite metadata fields with the same names.
-- If multiple variables are set with the same name, a list is
-- assigned.  Does nothing if 'writerTemplate' is Nothing.
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 opts :: WriterOptions
opts blockWriter :: [Block] -> m (Doc a)
blockWriter inlineWriter :: [Inline] -> m (Doc a)
inlineWriter meta :: Meta
meta =
  case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
    Nothing -> Context a -> m (Context a)
forall (m :: * -> *) a. Monad m => a -> m a
return Context a
forall a. Monoid a => a
mempty
    Just _  -> 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

-- | Like 'metaToContext, but does not include variables and is
-- not sensitive to 'writerTemplate'.
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' blockWriter :: [Block] -> m (Doc a)
blockWriter inlineWriter :: [Inline] -> m (Doc a)
inlineWriter (Meta metamap :: 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

-- | Add variables to a template Context, using monoidal append.
-- Also add `meta-json`.  Note that metadata values are used
-- in template contexts only when like-named variables aren't set.
addVariablesToContext :: TemplateTarget a
                      => WriterOptions -> Context a -> Context a
addVariablesToContext :: WriterOptions -> Context a -> Context a
addVariablesToContext opts :: WriterOptions
opts c1 :: 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 "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 blockWriter :: [Block] -> m (Doc a)
blockWriter inlineWriter :: [Inline] -> m (Doc a)
inlineWriter (MetaMap 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 blockWriter :: [Block] -> m (Doc a)
blockWriter inlineWriter :: [Inline] -> m (Doc a)
inlineWriter (MetaList xs :: [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 _ _ (MetaBool True) = 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
$ Doc a -> Val a
forall a. Doc a -> Val a
SimpleVal "true"
metaValueToVal _ _ (MetaBool False) = Val a -> m (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
forall a. Val a
NullVal
metaValueToVal _ inlineWriter :: [Inline] -> m (Doc a)
inlineWriter (MetaString s :: 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 blockWriter :: [Block] -> m (Doc a)
blockWriter _ (MetaBlocks bs :: [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 _ inlineWriter :: [Inline] -> m (Doc a)
inlineWriter (MetaInlines is :: [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


-- | Retrieve a field value from a template context.
getField   :: FromContext a b => T.Text -> Context a -> Maybe b
getField :: Text -> Context a -> Maybe b
getField field :: Text
field (Context m :: 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

-- | Set a field of a template context.  If the field already has a value,
-- convert it into a list with the new value appended to the old value(s).
-- This is a utility function to be used in preparing template contexts.
setField   :: ToContext a b => T.Text -> b -> Context a -> Context a
setField :: Text -> b -> Context a -> Context a
setField field :: Text
field val :: b
val (Context m :: 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 newval :: Val a
newval (ListVal xs :: [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 newval :: Val a
newval x :: Val a
x              = [Val a] -> Val a
forall a. [Val a] -> Val a
ListVal [Val a
x, Val a
newval]

-- | Reset a field of a template context.  If the field already has a
-- value, the new value replaces it.
-- This is a utility function to be used in preparing template contexts.
resetField :: ToContext a b => T.Text -> b -> Context a -> Context a
resetField :: Text -> b -> Context a -> Context a
resetField field :: Text
field val :: b
val (Context m :: 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)

-- | Set a field of a template context if it currently has no value.
-- If it has a value, do nothing.
-- This is a utility function to be used in preparing template contexts.
defField   :: ToContext a b => T.Text -> b -> Context a -> Context a
defField :: Text -> b -> Context a -> Context a
defField field :: Text
field val :: b
val (Context m :: 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 _newval :: p
_newval oldval :: p
oldval = p
oldval

-- Produce an HTML tag with the given pandoc attributes.
tagWithAttrs :: HasChars a => T.Text -> Attr -> Doc a
tagWithAttrs :: Text -> Attr -> Doc a
tagWithAttrs tag :: Text
tag (ident :: Text
ident,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hsep
  ["<" 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 "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 "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 (\(k :: Text
k,v :: 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
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
<> ">"

isDisplayMath :: Inline -> Bool
isDisplayMath :: Inline -> Bool
isDisplayMath (Math DisplayMath _)          = Bool
True
isDisplayMath (Span _ [Math DisplayMath _]) = Bool
True
isDisplayMath _                             = 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 (Space:xs :: [Inline]
xs)     = [Inline]
xs
        go (SoftBreak:xs :: [Inline]
xs) = [Inline]
xs
        go xs :: [Inline]
xs             = [Inline]
xs

-- Put display math in its own block (for ODT/DOCX).
fixDisplayMath :: Block -> Block
fixDisplayMath :: Block -> Block
fixDisplayMath (Plain lst :: [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) =
    -- chop into several paragraphs so each displaymath is its own
    Attr -> [Block] -> Block
Div ("",["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 (\x :: Inline
x y :: 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 lst :: [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) =
    -- chop into several paragraphs so each displaymath is its own
    Attr -> [Block] -> Block
Div ("",["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 (\x :: Inline
x y :: 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 x :: Block
x = Block
x

unsmartify :: WriterOptions -> T.Text -> T.Text
unsmartify :: WriterOptions -> Text -> Text
unsmartify opts :: WriterOptions
opts = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \c :: Char
c -> case Char
c of
  '\8217' -> "'"
  '\8230' -> "..."
  '\8211'
    | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_old_dashes WriterOptions
opts -> "-"
    | Bool
otherwise                     -> "--"
  '\8212'
    | Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_old_dashes WriterOptions
opts -> "--"
    | Bool
otherwise                     -> "---"
  '\8220' -> "\""
  '\8221' -> "\""
  '\8216' -> "'"
  _       -> Char -> Text
T.singleton Char
c

gridTable :: (Monad m, HasChars a)
          => WriterOptions
          -> (WriterOptions -> [Block] -> m (Doc a))
          -> Bool -- ^ headless
          -> [Alignment]
          -> [Double]
          -> [[Block]]
          -> [[[Block]]]
          -> m (Doc a)
gridTable :: WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> m (Doc a)
gridTable opts :: WriterOptions
opts blocksToDoc :: WriterOptions -> [Block] -> m (Doc a)
blocksToDoc headless :: Bool
headless aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows = do
  -- the number of columns will be used in case of even widths
  let numcols :: Int
numcols = [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] -> [Int]
forall a. a -> [a] -> [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 widths' :: [a]
widths' = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (
                        (\x :: b
x -> if b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< 1 then 1 else b
x) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (\x :: b
x -> b
x b -> b -> b
forall a. Num a => a -> a -> a
- 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'
  -- handleGivenWidths wraps the given blocks in order for them to fit
  -- in cells with given widths. the returned content can be
  -- concatenated with borders and frames
  let handleGivenWidthsInChars :: [Int] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidthsInChars widthsInChars' :: [Int]
widthsInChars' = do
        -- replace page width (in columns) in the options with a
        -- given width if smaller (adjusting by two)
        let useWidth :: Int -> WriterOptions
useWidth w :: 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
- 2) (WriterOptions -> Int
writerColumns WriterOptions
opts)}
        -- prepare options to use with header and row cells
        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
             (\cs :: [[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 widths' :: [a]
widths' = [Int] -> m ([Int], [Doc a], [[Doc a]])
handleGivenWidthsInChars
                                     ([a] -> [Int]
forall a b. (RealFrac a, Integral b) => [a] -> [b]
officialWidthsInChars [a]
widths')
  -- handleFullWidths tries to wrap cells to the page width or even
  -- more in cases where `--wrap=none`. thus the content here is left
  -- as wide as possible
  let handleFullWidths :: [a] -> m ([Int], [Doc a], [[Doc a]])
handleFullWidths widths' :: [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 [] = 0
            numChars xs :: [Doc a]
xs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Doc a] -> [Int]) -> [Doc a] -> 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 ([Doc a] -> Int) -> [Doc a] -> Int
forall a b. (a -> b) -> a -> b
$ [Doc a]
xs
        let minWidthsInChars :: [Int]
minWidthsInChars =
                ([Doc a] -> Int) -> [[Doc a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc a] -> Int
forall a. HasChars a => [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')
  -- handleZeroWidths calls handleFullWidths to check whether a wide
  -- table would fit in the page. if the produced table is too wide,
  -- it calculates even widths and passes the content to
  -- handleGivenWidths
  let handleZeroWidths :: [a] -> m ([Int], [Doc a], [[Doc a]])
handleZeroWidths widths' :: [a]
widths' = do
        (widthsInChars' :: [Int]
widthsInChars', rawHeaders' :: [Doc a]
rawHeaders', rawRows' :: [[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
(+) 0 [Int]
widthsInChars' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WriterOptions -> Int
writerColumns WriterOptions
opts
           then do -- use even widths except for thin columns
             let evenCols :: Int
evenCols  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 5
                              (((WriterOptions -> Int
writerColumns WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numcols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3)
             let (numToExpand :: Int
numToExpand, colsToExpand :: 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 (\w :: Int
w (n :: Int
n, tot :: 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
+ 1, Int
tot))
                                   (0,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 (\w :: 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')
  -- render the contents of header and row cells differently depending
  -- on command line options, widths given in this specific table, and
  -- cells' contents
  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
== 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
  (widthsInChars :: [Int]
widthsInChars, rawHeaders :: [Doc a]
rawHeaders, rawRows :: [[Doc a]]
rawRows) <- m ([Int], [Doc a], [[Doc a]])
handleWidths
  let hpipeBlocks :: [Doc a] -> Doc a
hpipeBlocks blocks :: [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 " | "
              beg :: Doc a
beg     = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill "| "
              end :: Doc a
end     = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill " |"
              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 ch :: Char
ch align :: Alignment
align widthInChars :: 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 ':'
               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 ':'
               else Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch)
  let border :: Char -> [Alignment] -> [Int] -> Doc a
border ch :: Char
ch aligns' :: [Alignment]
aligns' widthsInChars' :: [Int]
widthsInChars' =
        Char -> Doc a
forall a. HasChars a => Char -> Doc a
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 '+') ((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 '+'
  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 '-' (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 '=' [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 '-' [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 '-' (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 '-' (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 '-' (Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault) [Int]
widthsInChars

-- | Retrieve the metadata value for a given @key@
-- and convert to Bool.
lookupMetaBool :: T.Text -> Meta -> Bool
lookupMetaBool :: Text -> Meta -> Bool
lookupMetaBool key :: Text
key meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
      Just (MetaBlocks _)  -> Bool
True
      Just (MetaInlines _) -> Bool
True
      Just (MetaString x :: Text
x)  -> Bool -> Bool
not (Text -> Bool
T.null Text
x)
      Just (MetaBool True) -> Bool
True
      _                    -> Bool
False

-- | Retrieve the metadata value for a given @key@
-- and extract blocks.
lookupMetaBlocks :: T.Text -> Meta -> [Block]
lookupMetaBlocks :: Text -> Meta -> [Block]
lookupMetaBlocks key :: Text
key meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
         Just (MetaBlocks bs :: [Block]
bs)   -> [Block]
bs
         Just (MetaInlines ils :: [Inline]
ils) -> [[Inline] -> Block
Plain [Inline]
ils]
         Just (MetaString s :: Text
s)    -> [[Inline] -> Block
Plain [Text -> Inline
Str Text
s]]
         _                      -> []

-- | Retrieve the metadata value for a given @key@
-- and extract inlines.
lookupMetaInlines :: T.Text -> Meta -> [Inline]
lookupMetaInlines :: Text -> Meta -> [Inline]
lookupMetaInlines key :: Text
key meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
         Just (MetaString s :: Text
s)           -> [Text -> Inline
Str Text
s]
         Just (MetaInlines ils :: [Inline]
ils)        -> [Inline]
ils
         Just (MetaBlocks [Plain ils :: [Inline]
ils]) -> [Inline]
ils
         Just (MetaBlocks [Para ils :: [Inline]
ils])  -> [Inline]
ils
         _                             -> []

-- | Retrieve the metadata value for a given @key@
-- and convert to String.
lookupMetaString :: T.Text -> Meta -> T.Text
lookupMetaString :: Text -> Meta -> Text
lookupMetaString key :: Text
key meta :: Meta
meta =
  case Text -> Meta -> Maybe MetaValue
lookupMeta Text
key Meta
meta of
         Just (MetaString s :: Text
s)    -> Text
s
         Just (MetaInlines ils :: [Inline]
ils) -> [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
         Just (MetaBlocks bs :: [Block]
bs)   -> [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
bs
         Just (MetaBool b :: Bool
b)      -> String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
b)
         _                      -> ""

toSuperscript :: Char -> Maybe Char
toSuperscript :: Char -> Maybe Char
toSuperscript '1' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x00B9'
toSuperscript '2' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x00B2'
toSuperscript '3' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x00B3'
toSuperscript '+' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x207A'
toSuperscript '-' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x207B'
toSuperscript '=' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x207C'
toSuperscript '(' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x207D'
toSuperscript ')' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x207E'
toSuperscript c :: Char
c
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '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 (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
- 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 -> Maybe Char
forall a. a -> Maybe a
Just '\x208A'
toSubscript '-' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x208B'
toSubscript '=' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x208C'
toSubscript '(' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x208D'
toSubscript ')' = Char -> Maybe Char
forall a. a -> Maybe a
Just '\x208E'
toSubscript c :: Char
c
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '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 (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
- 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

-- | Construct table of contents (as a bullet list) from document body.
toTableOfContents :: WriterOptions
                  -> [Block]
                  -> Block
toTableOfContents :: WriterOptions -> [Block] -> Block
toTableOfContents opts :: WriterOptions
opts bs :: [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

-- | Converts an Element to a list item for a table of contents,
sectionToListItem :: WriterOptions -> Block -> [Block]
sectionToListItem :: WriterOptions -> Block -> [Block]
sectionToListItem opts :: WriterOptions
opts (Div (ident :: Text
ident,_,_)
                         (Header lev :: Int
lev (_,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) ils :: [Inline]
ils : subsecs :: [Block]
subsecs))
  | 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 "number" [(Text, Text)]
kvs) Bool -> Bool -> Bool
&& "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)
                                              , Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< WriterOptions -> Int
writerTOCDepth WriterOptions
opts]
 where
   num :: Text
num = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (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 "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 ("",["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
forall a. Semigroup a => a -> a -> a
<> Text
ident, "")]
   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 _ _ = []

endsWithPlain :: [Block] -> Bool
endsWithPlain :: [Block] -> Bool
endsWithPlain xs :: [Block]
xs =
  case [Block] -> Maybe Block
forall a. [a] -> Maybe a
lastMay [Block]
xs of
    Just (Plain{}) -> Bool
True
    _              -> Bool
False