{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE StrictData #-}
module Djot.Djot
  ( renderDjot
  , RenderOptions(..)
  )
where

import Djot.AST
import Djot.Options (RenderOptions(..))
import Data.Char (ord, chr)
import Djot.Parse (utf8ToStr)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.List (sortOn, intersperse, transpose)
import Control.Monad
import Control.Monad.State
import qualified Data.Foldable as F
import Text.DocLayout hiding (Doc)
import qualified Text.DocLayout as Layout
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.IntMap.Strict as IntMap

renderDjot :: RenderOptions -> Doc -> Layout.Doc Text
renderDjot :: RenderOptions -> Doc -> Doc Text
renderDjot RenderOptions
opts Doc
doc = State BState (Doc Text) -> BState -> Doc Text
forall s a. State s a -> s -> a
evalState
                           (do body <- Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Doc -> Many (Node Block)
docBlocks Doc
doc)
                               refs <- gets referenceMap >>= toReferences
                               notes <- toNotes
                               pure $ body $$ refs $$ notes <> cr)
                         BState{ noteMap :: NoteMap
noteMap = Doc -> NoteMap
docFootnotes Doc
doc
                               , noteOrder :: Map ByteString Int
noteOrder = Map ByteString Int
forall a. Monoid a => a
mempty
                               , referenceMap :: ReferenceMap
referenceMap = Doc -> ReferenceMap
docReferences Doc
doc
                               , autoIds :: Set ByteString
autoIds = Doc -> Set ByteString
docAutoIdentifiers Doc
doc
                               , afterSpace :: Bool
afterSpace = Bool
True
                               , nestings :: IntMap Int
nestings = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromList
                                  -- anything not in this list
                                  -- will ALWAYS get {}:
                                  [(Char -> Int
ord Char
'_', Int
0)
                                  ,(Char -> Int
ord Char
'*', Int
0)
                                  ,(Char -> Int
ord Char
'~', Int
0)
                                  ,(Char -> Int
ord Char
'\'', Int
0)
                                  ,(Char -> Int
ord Char
'"', Int
0)
                                  ,(Char -> Int
ord Char
'^', Int
0)]
                               , lastBullet :: Maybe Char
lastBullet = Maybe Char
forall a. Maybe a
Nothing
                               , options :: RenderOptions
options = RenderOptions
opts
                               }

data BState =
  BState { BState -> NoteMap
noteMap :: NoteMap
         , BState -> Map ByteString Int
noteOrder :: M.Map ByteString Int
         , BState -> ReferenceMap
referenceMap :: ReferenceMap
         , BState -> Set ByteString
autoIds :: Set ByteString
         , BState -> Bool
afterSpace :: Bool
         , BState -> IntMap Int
nestings :: IntMap.IntMap Int
         , BState -> Maybe Char
lastBullet :: Maybe Char
         , BState -> RenderOptions
options :: RenderOptions
         }

toReferences :: ReferenceMap -> State BState (Layout.Doc Text)
toReferences :: ReferenceMap -> State BState (Doc Text)
toReferences (ReferenceMap Map ByteString (ByteString, Attr)
refs) =
  (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) (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
vcat ([Doc Text] -> Doc Text)
-> StateT BState Identity [Doc Text] -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, (ByteString, Attr)) -> State BState (Doc Text))
-> [(ByteString, (ByteString, Attr))]
-> StateT BState Identity [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString, (ByteString, Attr)) -> State BState (Doc Text)
toReference (Map ByteString (ByteString, Attr)
-> [(ByteString, (ByteString, Attr))]
forall k a. Map k a -> [(k, a)]
M.toList Map ByteString (ByteString, Attr)
refs)

toReference :: (ByteString, (ByteString, Attr)) -> State BState (Layout.Doc Text)
toReference :: (ByteString, (ByteString, Attr)) -> State BState (Doc Text)
toReference (ByteString
label, (ByteString
url, Attr
attr)) = do
  attr' <- Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Attr
attr
  let ref = Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
label) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]:" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
url)
  pure $ attr' $$ ref

toNotes :: State BState (Layout.Doc Text)
toNotes :: State BState (Doc Text)
toNotes = do
  noterefs <- (BState -> Map ByteString Int)
-> StateT BState Identity (Map ByteString Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Map ByteString Int
noteOrder
  allLabels <- gets (M.keys . unNoteMap . noteMap)
  let sortedLabels = (ByteString -> Maybe Int) -> [ByteString] -> [ByteString]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ByteString -> Map ByteString Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map ByteString Int
noterefs) [ByteString]
allLabels
  (<> cr) . vsep <$> mapM toNote sortedLabels

toNote :: ByteString -> State BState (Layout.Doc Text)
toNote :: ByteString -> State BState (Doc Text)
toNote ByteString
label = do
  notes <- (BState -> NoteMap) -> StateT BState Identity NoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> NoteMap
noteMap
  case lookupNote label notes of
    Maybe (Many (Node Block))
Nothing -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
    Just Many (Node Block)
bls ->
      Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
4 (ByteString -> Doc Text
toNoteRef ByteString
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls

fromUtf8 :: ByteString -> Text
fromUtf8 :: ByteString -> Text
fromUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode

data EscapeContext = Normal

{-# INLINE escapeDjot #-}
escapeDjot :: EscapeContext -> ByteString -> Text
escapeDjot :: EscapeContext -> ByteString -> Text
escapeDjot EscapeContext
Normal ByteString
bs
  | (Char -> Bool) -> ByteString -> Bool
B8.any Char -> Bool
escapable ByteString
bs = String -> Text
T.pack(String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
utf8ToStr (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs
  | Bool
otherwise = ByteString -> Text
fromUtf8 ByteString
bs
 where
  escapable :: Char -> Bool
escapable 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 -> 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
'!' 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
':' 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
'~' 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
'\''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
'|' 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
'\\'
  go :: String -> String
go [] = []
  go (Char
'$':Char
c:String
cs)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
    | Bool
otherwise = Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)
  go (Char
'-':String
cs) =
    case String
cs of
      Char
'-':String
_ -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
      String
_ -> Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
  go (Char
'.':String
cs) =
    case String
cs of
      Char
'.':Char
'.':String
_ -> Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
      String
_ -> Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
  go (Char
c:Char
':':String
cs)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']'
    , case String
cs of
        [] -> Bool
True
        (Char
' ':String
_) -> Bool
True
        String
_ -> Bool
False
       = (if Char -> Bool
escapable Char
c then (Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
:) else String -> String
forall a. a -> a
id) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
  go (Char
c:String
cs)
    | Char -> Bool
escapable Char
c = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
    | Bool
otherwise = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs

newtype BlockAttr = BlockAttr Attr

formatAttrPart :: (ByteString, ByteString) -> Layout.Doc Text
formatAttrPart :: (ByteString, ByteString) -> Doc Text
formatAttrPart (ByteString
"id",ByteString
ident) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
ident)
formatAttrPart (ByteString
"class", ByteString
classes') = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc Text
"." Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal)
                                         ([Text] -> [Doc Text]) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
fromUtf8 ByteString
classes'
formatAttrPart (ByteString
k,ByteString
v) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
k) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                       Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (EscapeContext -> ByteString -> Text
escapeDjot EscapeContext
Normal ByteString
v))

{-# SPECIALIZE toLayout :: Blocks -> State BState (Layout.Doc Text) #-}
{-# SPECIALIZE toLayout :: Inlines -> State BState (Layout.Doc Text) #-}
{-# SPECIALIZE toLayout :: Attr -> State BState (Layout.Doc Text) #-}
class ToLayout a where
  toLayout :: a -> State BState (Layout.Doc Text)

instance ToLayout Inlines where
  toLayout :: Many (Node Inline) -> State BState (Doc Text)
toLayout = (Seq (Doc Text) -> Doc Text)
-> StateT BState Identity (Seq (Doc Text))
-> State BState (Doc Text)
forall a b.
(a -> b) -> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq (Doc Text) -> Doc Text
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (StateT BState Identity (Seq (Doc Text))
 -> State BState (Doc Text))
-> (Many (Node Inline) -> StateT BState Identity (Seq (Doc Text)))
-> Many (Node Inline)
-> State BState (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Inline -> State BState (Doc Text))
-> Seq (Node Inline) -> StateT BState Identity (Seq (Doc Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Node Inline -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Seq (Node Inline) -> StateT BState Identity (Seq (Doc Text)))
-> (Many (Node Inline) -> Seq (Node Inline))
-> Many (Node Inline)
-> StateT BState Identity (Seq (Doc Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many (Node Inline) -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany

instance ToLayout Blocks where
  toLayout :: Many (Node Block) -> State BState (Doc Text)
toLayout = (Seq (Doc Text) -> Doc Text)
-> StateT BState Identity (Seq (Doc Text))
-> State BState (Doc Text)
forall a b.
(a -> b) -> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq (Doc Text) -> Doc Text
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (StateT BState Identity (Seq (Doc Text))
 -> State BState (Doc Text))
-> (Many (Node Block) -> StateT BState Identity (Seq (Doc Text)))
-> Many (Node Block)
-> State BState (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Block -> State BState (Doc Text))
-> Seq (Node Block) -> StateT BState Identity (Seq (Doc Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Node Block -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Seq (Node Block) -> StateT BState Identity (Seq (Doc Text)))
-> (Many (Node Block) -> Seq (Node Block))
-> Many (Node Block)
-> StateT BState Identity (Seq (Doc Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many (Node Block) -> Seq (Node Block)
forall a. Many a -> Seq a
unMany

instance ToLayout Attr where
  toLayout :: Attr -> State BState (Doc Text)
toLayout (Attr [(ByteString, ByteString)]
kvs)
    = Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
contents
                then Doc Text
forall a. Monoid a => a
mempty
                else Doc Text
"{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
       where
         contents :: Doc Text
contents = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep (((ByteString, ByteString) -> Doc Text)
-> [(ByteString, ByteString)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> Doc Text
formatAttrPart [(ByteString, ByteString)]
kvs)

instance ToLayout BlockAttr where
  toLayout :: BlockAttr -> State BState (Doc Text)
toLayout (BlockAttr (Attr [(ByteString, ByteString)]
kvs))
    = Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
contents
                then Doc Text
forall a. Monoid a => a
mempty
                else Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
1 Doc Text
"{" (Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}")
       where
         contents :: Doc Text
contents = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep (((ByteString, ByteString) -> Doc Text)
-> [(ByteString, ByteString)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> Doc Text
formatAttrPart [(ByteString, ByteString)]
kvs)

instance ToLayout (Node Block) where
  toLayout :: Node Block -> State BState (Doc Text)
toLayout (Node Pos
_pos Attr
attr Block
bl) =
    Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
($$) (Doc Text -> Doc Text -> Doc Text)
-> State BState (Doc Text)
-> StateT BState Identity (Doc Text -> Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (case Block
bl of
                -- don't print an id that was generated implicitly
                Heading{} -> do
                  autoids <- (BState -> Set ByteString)
-> StateT BState Identity (Set ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Set ByteString
autoIds
                  let Attr as = attr
                  toLayout $ BlockAttr
                           $ Attr [(k,v) | (k,v) <- as
                                  , not (k == "id" && v `Set.member` autoids)]
                Section{} -> do
                  autoids <- (BState -> Set ByteString)
-> StateT BState Identity (Set ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Set ByteString
autoIds
                  let Attr as = attr
                  toLayout $ BlockAttr
                           $ Attr [(k,v) | (k,v) <- as
                                  , not (k == "id" &&
                                         v `Set.member` autoids)]
                Block
_ -> BlockAttr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Attr -> BlockAttr
BlockAttr Attr
attr))
         StateT BState Identity (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall a b.
StateT BState Identity (a -> b)
-> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Block
bl of
               Para Many (Node Inline)
ils -> Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
               Heading Int
lev Many (Node Inline)
ils -> do
                 contents <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
                 pure $ literal (T.replicate lev "#") <+> contents
               Section Many (Node Block)
bls -> (Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls
               Block
ThematicBreak -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"* * * *"
               BulletList ListSpacing
listSpacing [Many (Node Block)]
items -> do
                 lastb <- (BState -> Maybe Char) -> StateT BState Identity (Maybe Char)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Maybe Char
lastBullet
                 let bullet = case Maybe Char
lastb of
                                Just Char
'+' -> Doc Text
"-"
                                Just Char
'-' -> Doc Text
"+"
                                Maybe Char
_ -> Doc Text
"-"
                 (case listSpacing of
                    ListSpacing
Tight -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp
                    ListSpacing
Loose -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) <$>
                   mapM (fmap (hang 2 (bullet <> space)) . toLayout) items
               OrderedList OrderedListAttributes
listAttr ListSpacing
listSpacing [Many (Node Block)]
items ->
                 (case ListSpacing
listSpacing of
                    ListSpacing
Tight -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp
                    ListSpacing
Loose -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) ([Doc Text] -> Doc Text)
-> StateT BState Identity [Doc Text] -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Int -> Many (Node Block) -> State BState (Doc Text))
-> [Int]
-> [Many (Node Block)]
-> StateT BState Identity [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (OrderedListAttributes
-> Int -> Many (Node Block) -> State BState (Doc Text)
toOrderedListItem OrderedListAttributes
listAttr)
                          [(OrderedListAttributes -> Int
orderedListStart OrderedListAttributes
listAttr)..]
                          [Many (Node Block)]
items
               DefinitionList ListSpacing
listSpacing [(Many (Node Inline), Many (Node Block))]
items ->
                 (case ListSpacing
listSpacing of
                    ListSpacing
Tight -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp
                    ListSpacing
Loose -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) ([Doc Text] -> Doc Text)
-> StateT BState Identity [Doc Text] -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 ((Many (Node Inline), Many (Node Block))
 -> State BState (Doc Text))
-> [(Many (Node Inline), Many (Node Block))]
-> StateT BState Identity [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Many (Node Inline), Many (Node Block)) -> State BState (Doc Text)
toDefinitionListItem [(Many (Node Inline), Many (Node Block))]
items
               TaskList ListSpacing
listSpacing [(TaskStatus, Many (Node Block))]
items ->
                 (case ListSpacing
listSpacing of
                    ListSpacing
Tight -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp
                    ListSpacing
Loose -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) ([Doc Text] -> Doc Text)
-> StateT BState Identity [Doc Text] -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 ((TaskStatus, Many (Node Block)) -> State BState (Doc Text))
-> [(TaskStatus, Many (Node Block))]
-> StateT BState Identity [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TaskStatus, Many (Node Block)) -> State BState (Doc Text)
toTaskListItem [(TaskStatus, Many (Node Block))]
items
               Div Many (Node Block)
bls -> do
                 let nestedDivs :: Int
nestedDivs = Many (Node Block) -> Int
computeDivNestingLevel Many (Node Block)
bls
                 contents <- Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls
                 let colons = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Int
nestedDivs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Text
":")
                 pure $ colons $$ contents $$ colons
               BlockQuote Many (Node Block)
bls ->
                 if Many (Node Block)
bls Many (Node Block) -> Many (Node Block) -> Bool
forall a. Eq a => a -> a -> Bool
== Many (Node Block)
forall a. Monoid a => a
mempty
                    then Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
">"
                    else String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
"> " (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls
               CodeBlock ByteString
lang ByteString
bs -> do
                 let longesttickline :: Int
longesttickline =
                       case ByteString -> [ByteString]
B8.lines ByteString
bs of
                         [] -> Int
0
                         [ByteString]
ls -> [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Int
B8.length (ByteString -> Int)
-> (ByteString -> ByteString) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B8.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'`')) [ByteString]
ls
                 let numticks :: Int
numticks = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 Int
longesttickline
                 let ticks :: Doc Text
ticks = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
numticks Text
"`"
                 let lang' :: Doc Text
lang' = if ByteString
lang ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty
                                then Doc Text
forall a. Monoid a => a
mempty
                                else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
lang)
                 Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
ticks Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
lang'
                      Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
bs)
                      Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
ticks
               Table Maybe Caption
mbCaption [[Cell]]
rows -> do
                 caption <- case Maybe Caption
mbCaption of
                               Maybe Caption
Nothing -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
                               Just (Caption Many (Node Block)
bls)
                                       -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (Doc Text
"^" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls
                 body <- toTable rows
                 pure $ body $+$ caption
               RawBlock (Format ByteString
"djot") ByteString
bs ->
                 Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
bs)
               RawBlock Format
_ ByteString
_ -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty)
         State BState (Doc Text)
-> StateT BState Identity () -> State BState (Doc Text)
forall a b.
StateT BState Identity a
-> StateT BState Identity b -> StateT BState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\BState
st -> BState
st{ afterSpace = True
                              -- Handle case of one bullet list right after
                              -- another; we need to change the bullet to
                              -- start a new list:
                              , lastBullet = case bl of
                                               BulletList{} ->
                                                 case BState -> Maybe Char
lastBullet BState
st of
                                                   Just Char
'-' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'+'
                                                   Just Char
'+' -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-'
                                                   Maybe Char
_ -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'-'
                                               Block
_ -> Maybe Char
forall a. Maybe a
Nothing })

toTable :: [[Cell]] -> State BState (Layout.Doc Text)
toTable :: [[Cell]] -> State BState (Doc Text)
toTable [] = Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"|--|" -- minimal empty table
toTable [[Cell]]
rows = do
  let getCellContents :: Cell -> StateT BState Identity ((CellType, Align), Doc Text)
getCellContents (Cell CellType
hd Align
al Many (Node Inline)
ils) = ((CellType
hd, Align
al),) (Doc Text -> ((CellType, Align), Doc Text))
-> State BState (Doc Text)
-> StateT BState Identity ((CellType, Align), Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
  rowContents <- ([Cell] -> StateT BState Identity [((CellType, Align), Doc Text)])
-> [[Cell]]
-> StateT BState Identity [[((CellType, Align), Doc Text)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Cell -> StateT BState Identity ((CellType, Align), Doc Text))
-> [Cell] -> StateT BState Identity [((CellType, Align), Doc Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Cell -> StateT BState Identity ((CellType, Align), Doc Text)
getCellContents) [[Cell]]
rows
  let colwidths = ([((CellType, Align), Doc Text)] -> Int)
-> [[((CellType, Align), Doc Text)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> ([((CellType, Align), Doc Text)] -> [Int])
-> [((CellType, Align), Doc Text)]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((CellType, Align), Doc Text) -> Int)
-> [((CellType, Align), Doc Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset (Doc Text -> Int)
-> (((CellType, Align), Doc Text) -> Doc Text)
-> ((CellType, Align), Doc Text)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CellType, Align), Doc Text) -> Doc Text
forall a b. (a, b) -> b
snd))
                      ([[((CellType, Align), Doc Text)]]
-> [[((CellType, Align), Doc Text)]]
forall a. [[a]] -> [[a]]
transpose [[((CellType, Align), Doc Text)]]
rowContents)
  let toCell Int
width ((a
_,Align
align), Doc a
d) =
        (case Align
align of
          Align
AlignLeft -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
          Align
AlignRight -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
rblock
          Align
AlignCenter -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
cblock
          Align
AlignDefault -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock) Int
width Doc a
d
  let mkRow [Doc a]
ds = [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
$ a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"| " Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" | ") [Doc a]
ds [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++
                           [a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" |"]
  let mkLines [Doc a]
ds = [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
$ a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"|" Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"|") [Doc a]
ds [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++
                             [a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"|"]
  let toUnderline Int
width ((a
_,Align
al),b
_) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
        case Align
al of
           Align
AlignLeft -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-"
           Align
AlignRight -> Int -> Text -> Text
T.replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
           Align
AlignCenter -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
width Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
           Align
AlignDefault -> Int -> Text -> Text
T.replicate Int
width Text
"-"
  let initialSep = case [[((CellType, Align), Doc Text)]]
rowContents of
                     cells :: [((CellType, Align), Doc Text)]
cells@(((CellType
BodyCell,Align
al),Doc Text
_):[((CellType, Align), Doc Text)]
_):[[((CellType, Align), Doc Text)]]
_ | Align
al Align -> Align -> Bool
forall a. Eq a => a -> a -> Bool
/= Align
AlignDefault
                       -> [Doc Text] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
mkLines ((Int -> ((CellType, Align), Doc Text) -> Doc Text)
-> [Int] -> [((CellType, Align), Doc Text)] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ((CellType, Align), Doc Text) -> Doc Text
forall {a} {b}. Int -> ((a, Align), b) -> Doc Text
toUnderline [Int]
colwidths [((CellType, Align), Doc Text)]
cells)
                     [[((CellType, Align), Doc Text)]]
_ -> Doc Text
forall a. Monoid a => a
mempty
  let toRow [((CellType, Align), Doc Text)]
cells =
         let isHeader :: Bool
isHeader = case [((CellType, Align), Doc Text)]
cells of
                          ((CellType
HeadCell,Align
_),Doc Text
_) : [((CellType, Align), Doc Text)]
_ -> Bool
True
                          [((CellType, Align), Doc Text)]
_ -> Bool
False
         in [Doc Text] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
mkRow ((Int -> ((CellType, Align), Doc Text) -> Doc Text)
-> [Int] -> [((CellType, Align), Doc Text)] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ((CellType, Align), Doc Text) -> Doc Text
forall {a} {a}. HasChars a => Int -> ((a, Align), Doc a) -> Doc a
toCell [Int]
colwidths [((CellType, Align), Doc Text)]
cells)
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
            if Bool
isHeader
               then [Doc Text] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
mkLines ((Int -> ((CellType, Align), Doc Text) -> Doc Text)
-> [Int] -> [((CellType, Align), Doc Text)] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ((CellType, Align), Doc Text) -> Doc Text
forall {a} {b}. Int -> ((a, Align), b) -> Doc Text
toUnderline [Int]
colwidths [((CellType, Align), Doc Text)]
cells)
               else Doc Text
forall a. Monoid a => a
mempty
  pure $ initialSep $$ vcat (map toRow rowContents)

toDefinitionListItem :: (Inlines, Blocks) -> State BState (Layout.Doc Text)
toDefinitionListItem :: (Many (Node Inline), Many (Node Block)) -> State BState (Doc Text)
toDefinitionListItem (Many (Node Inline)
term, Many (Node Block)
def) = do
  term' <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
term
  def' <- toLayout def
  pure $ hang 2 (":" <> space) $ term' $+$ def'

toTaskListItem :: (TaskStatus, Blocks) -> State BState (Layout.Doc Text)
toTaskListItem :: (TaskStatus, Many (Node Block)) -> State BState (Doc Text)
toTaskListItem (TaskStatus
status, Many (Node Block)
bls) = do
  contents <- Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bls
  let marker = case TaskStatus
status of
                  TaskStatus
Incomplete -> Doc Text
"- [ ]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
                  TaskStatus
Complete -> Doc Text
"- [X]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space
  pure $ hang 2 marker contents

toOrderedListItem :: OrderedListAttributes -> Int -> Blocks
                  -> State BState (Layout.Doc Text)
toOrderedListItem :: OrderedListAttributes
-> Int -> Many (Node Block) -> State BState (Doc Text)
toOrderedListItem OrderedListAttributes
listAttr Int
num Many (Node Block)
bs = do
  contents <- Many (Node Block) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Block)
bs
  let marker = OrderedListAttributes -> Int -> Doc Text
formatOrderedListMarker OrderedListAttributes
listAttr Int
num
  pure $ hang (offset marker + 1) (marker <> space) contents

formatOrderedListMarker :: OrderedListAttributes -> Int -> Layout.Doc Text
formatOrderedListMarker :: OrderedListAttributes -> Int -> Doc Text
formatOrderedListMarker OrderedListAttributes
listAttr =
  OrderedListDelim -> Doc Text -> Doc Text
addDelims (OrderedListAttributes -> OrderedListDelim
orderedListDelim OrderedListAttributes
listAttr) (Doc Text -> Doc Text) -> (Int -> Doc Text) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    OrderedListStyle -> Int -> Doc Text
formatNumber (OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
listAttr)

addDelims :: OrderedListDelim -> Layout.Doc Text -> Layout.Doc Text
addDelims :: OrderedListDelim -> Doc Text -> Doc Text
addDelims OrderedListDelim
RightPeriod Doc Text
d = Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"."
addDelims OrderedListDelim
RightParen Doc Text
d = Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
addDelims OrderedListDelim
LeftRightParen Doc Text
d = Doc Text
"(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"

formatNumber :: OrderedListStyle -> Int -> Layout.Doc Text
formatNumber :: OrderedListStyle -> Int -> Doc Text
formatNumber OrderedListStyle
Decimal Int
n = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n))
formatNumber OrderedListStyle
LetterUpper Int
n = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Char -> Text
T.singleton (Int -> Char
chr (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
formatNumber OrderedListStyle
LetterLower Int
n = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Char -> Text
T.singleton (Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
formatNumber OrderedListStyle
RomanUpper Int
n = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
toRomanNumeral Int
n
formatNumber OrderedListStyle
RomanLower Int
n = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Int -> Text
toRomanNumeral Int
n)

-- | Convert number < 4000 to uppercase roman numeral. (from pandoc)
toRomanNumeral :: Int -> T.Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"CM" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
900)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"D" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
500)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"CD" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
400)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"C" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"XC" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"L"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"XL" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"IX"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"IV"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"I" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Text
""



instance ToLayout (Node Inline) where
  toLayout :: Node Inline -> State BState (Doc Text)
toLayout (Node Pos
_pos Attr
attr Inline
il) = Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>)
    (Doc Text -> Doc Text -> Doc Text)
-> State BState (Doc Text)
-> StateT BState Identity (Doc Text -> Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Inline
il of
          Str ByteString
bs -> do
            let fixSmart :: Text -> Text
fixSmart = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\x2014" Text
"---" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\x2013" Text
"--" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\x2026" Text
"..." (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\x2019" Text
"'" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\x201C" Text
"\""
            let chunks :: [Text]
chunks =
                  (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy
                   (\Char
c Char
d -> (Char
c 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
c 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
' '))
                   (Text -> Text
fixSmart (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ EscapeContext -> ByteString -> Text
escapeDjot EscapeContext
Normal ByteString
bs)
            let toChunk :: Text -> Doc Text
toChunk Text
ch
                  = case Text -> Maybe (Char, Text)
T.uncons Text
ch of
                      Just (Char
' ', Text
rest)
                        -> Text -> Doc Text
forall a. Text -> Doc a
afterBreak Text
"{}" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
rest
                      Maybe (Char, Text)
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ch
            Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
toChunk [Text]
chunks
          Inline
SoftBreak -> do
            opts <- (BState -> RenderOptions) -> StateT BState Identity RenderOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> RenderOptions
options
            pure $ if preserveSoftBreaks opts then cr else space
          Inline
HardBreak -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
          Inline
NonBreakingSpace -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"\\ "
          Emph Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'_' Many (Node Inline)
ils
          Strong Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'*' Many (Node Inline)
ils
          Highlight Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'=' Many (Node Inline)
ils
          Insert Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'+' Many (Node Inline)
ils
          Delete Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'-' Many (Node Inline)
ils
          Superscript Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'^' Many (Node Inline)
ils
          Subscript Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'~' Many (Node Inline)
ils
          Quoted QuoteType
SingleQuotes Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'\'' Many (Node Inline)
ils
          Quoted QuoteType
DoubleQuotes Many (Node Inline)
ils -> Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
'"' Many (Node Inline)
ils
          Verbatim ByteString
bs -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc Text
toVerbatimSpan ByteString
bs
          Math MathStyle
mt ByteString
bs -> do
            let suffix :: Doc Text
suffix = ByteString -> Doc Text
toVerbatimSpan ByteString
bs
            let prefix :: Doc Text
prefix = case MathStyle
mt of
                            MathStyle
DisplayMath -> Doc Text
"$$"
                            MathStyle
InlineMath -> Doc Text
"$"
            Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
prefix Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
suffix
          Symbol ByteString
bs -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
bs) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":"
          Span Many (Node Inline)
ils -> do
            contents <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
            pure $ "[" <> contents <> "]" <>
                    case attr of  -- there must be attributes for it to be a span
                      Attr [] -> Doc Text
"{}"
                      Attr
_ -> Doc Text
forall a. Monoid a => a
mempty
          Link Many (Node Inline)
ils Target
target -> do
            contents <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
            let suffix = Target -> Doc Text -> Doc Text
toLinkSuffix Target
target Doc Text
contents
            pure $ "[" <> contents <> "]" <> suffix
          Image Many (Node Inline)
ils Target
target -> do
            contents <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
            let suffix = Target -> Doc Text -> Doc Text
toLinkSuffix Target
target Doc Text
contents
            pure $ "![" <> contents <> "]" <> suffix
          EmailLink ByteString
email -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
email) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
          UrlLink ByteString
url -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
url) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
          RawInline (Format ByteString
"djot") ByteString
bs -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> State BState (Doc Text))
-> Doc Text -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
bs)
          RawInline Format
_ ByteString
_ -> Doc Text -> State BState (Doc Text)
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
          FootnoteReference ByteString
label -> do
            order <- (BState -> Map ByteString Int)
-> StateT BState Identity (Map ByteString Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Map ByteString Int
noteOrder
            case M.lookup label order of
              Maybe Int
Nothing -> (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((BState -> BState) -> StateT BState Identity ())
-> (BState -> BState) -> StateT BState Identity ()
forall a b. (a -> b) -> a -> b
$ \BState
st ->
                            BState
st{ noteOrder =
                                  M.insert label (M.size order + 1) order }
              Just Int
_ -> () -> StateT BState Identity ()
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            pure $ toNoteRef label
   StateT BState Identity (Doc Text -> Doc Text)
-> State BState (Doc Text) -> State BState (Doc Text)
forall a b.
StateT BState Identity (a -> b)
-> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Attr
attr
    State BState (Doc Text)
-> StateT BState Identity () -> State BState (Doc Text)
forall a b.
StateT BState Identity a
-> StateT BState Identity b -> StateT BState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\BState
st ->
                 BState
st{ afterSpace =
                      case il of
                         Str ByteString
bs | ByteString -> Bool
isWhite (Int -> ByteString -> ByteString
B8.takeEnd Int
1 ByteString
bs) -> Bool
True
                         Inline
SoftBreak -> Bool
True
                         Inline
HardBreak -> Bool
True
                         Inline
NonBreakingSpace -> Bool
True
                         Inline
_ -> Bool
False })

toLinkSuffix :: Target -> Layout.Doc Text -> Layout.Doc Text
toLinkSuffix :: Target -> Doc Text -> Doc Text
toLinkSuffix (Direct ByteString
url) Doc Text
_ = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
toLinkSuffix (Reference ByteString
label) Doc Text
d
  | Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Text
fromUtf8 ByteString
label = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[]"
  | Bool
otherwise = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

toVerbatimSpan :: ByteString -> Layout.Doc Text
toVerbatimSpan :: ByteString -> Doc Text
toVerbatimSpan ByteString
bs =
  Doc Text
ticks Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
startsWithTick then Doc Text
" " else Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
    Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (ByteString -> Text
fromUtf8 ByteString
bs) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
    (if Bool
endsWithTick then Doc Text
" " else Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
ticks
 where
  startsWithTick :: Bool
startsWithTick = Int -> ByteString -> ByteString
B8.take Int
1 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"`"
  endsWithTick :: Bool
endsWithTick = Int -> ByteString -> ByteString
B8.takeEnd Int
1 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"`"
  ticks :: Doc Text
ticks = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int
maxticks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"`"
  maxticks :: Int
maxticks = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Char -> (Int, Int))
-> (Int, Int) -> ByteString -> (Int, Int)
forall a. (a -> Char -> a) -> a -> ByteString -> a
B8.foldl' (Int, Int) -> Char -> (Int, Int)
forall {b}. (Ord b, Num b) => (b, b) -> Char -> (b, b)
scanTicks (Int
0,Int
0) ByteString
bs
  scanTicks :: (b, b) -> Char -> (b, b)
scanTicks (b
longest, b
theseticks) Char
'`' =
     (b -> b -> b
forall a. Ord a => a -> a -> a
max (b
theseticks b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) b
longest, b
theseticks b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
  scanTicks (b
longest, b
_) Char
_ = (b
longest, b
0)

isWhite :: ByteString -> Bool
isWhite :: ByteString -> Bool
isWhite ByteString
" " = Bool
True
isWhite ByteString
"\t" = Bool
True
isWhite ByteString
_ = Bool
False

surround :: Char -> Inlines -> State BState (Layout.Doc Text)
surround :: Char -> Many (Node Inline) -> State BState (Doc Text)
surround Char
c Many (Node Inline)
ils = do
  let startBeforeSpace :: Bool
startBeforeSpace =
        case Seq (Node Inline) -> ViewL (Node Inline)
forall a. Seq a -> ViewL a
Seq.viewl (Many (Node Inline) -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany Many (Node Inline)
ils) of
                Node Pos
_pos Attr
_ (Str ByteString
bs) Seq.:< Seq (Node Inline)
_ ->
                    ByteString -> Bool
isWhite (Int -> ByteString -> ByteString
B8.take Int
1 ByteString
bs)
                ViewL (Node Inline)
_ -> Bool
False
  (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((BState -> BState) -> StateT BState Identity ())
-> (BState -> BState) -> StateT BState Identity ()
forall a b. (a -> b) -> a -> b
$ \BState
st -> BState
st{ nestings = IntMap.adjust (+ 1) (ord c) (nestings st)}
  contents <- Many (Node Inline) -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Many (Node Inline)
ils
  modify' $ \BState
st -> BState
st{ nestings = IntMap.adjust (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        (ord c) (nestings st)}
  endAfterSpace <- gets afterSpace
  nestingLevel <- gets (fromMaybe 1 . IntMap.lookup (ord c) . nestings)
  let core = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
c Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
c
  pure $
    if nestingLevel == 0 && not (startBeforeSpace || endAfterSpace) &&
         not (null ils)
       then core
       else char '{' <> core <> char '}'

toNoteRef :: ByteString -> Layout.Doc Text
toNoteRef :: ByteString -> Doc Text
toNoteRef ByteString
bs = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
fromUtf8 ByteString
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

computeDivNestingLevel :: Blocks -> Int
computeDivNestingLevel :: Many (Node Block) -> Int
computeDivNestingLevel =
  (Node Block -> Int -> Int) -> Int -> Seq (Node Block) -> Int
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node Block -> Int -> Int
forall {t}. (Ord t, Num t) => Node Block -> t -> t
go Int
0 (Seq (Node Block) -> Int)
-> (Many (Node Block) -> Seq (Node Block))
-> Many (Node Block)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many (Node Block) -> Seq (Node Block)
forall a. Many a -> Seq a
unMany
 where
   go :: Node Block -> t -> t
go (Node Pos
_pos Attr
_ (Div Many (Node Block)
bls')) t
n =
     t -> t -> t
forall a. Ord a => a -> a -> a
max (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) ((Node Block -> t -> t) -> t -> Seq (Node Block) -> t
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node Block -> t -> t
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (Many (Node Block) -> Seq (Node Block)
forall a. Many a -> Seq a
unMany Many (Node Block)
bls'))
   go Node Block
_ t
n = t
n