{-# 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 Doc Text
body <- Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Doc -> Blocks
docBlocks Doc
doc)
                               Doc Text
refs <- (BState -> ReferenceMap) -> StateT BState Identity ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> ReferenceMap
referenceMap StateT BState Identity ReferenceMap
-> (ReferenceMap -> State BState (Doc Text))
-> State BState (Doc Text)
forall a b.
StateT BState Identity a
-> (a -> StateT BState Identity b) -> StateT BState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReferenceMap -> State BState (Doc Text)
toReferences
                               Doc Text
notes <- State BState (Doc Text)
toNotes
                               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
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
refs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
notes Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
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
  Doc Text
attr' <- Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Attr
attr
  let ref :: Doc Text
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)
  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
attr' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
ref

toNotes :: State BState (Layout.Doc Text)
toNotes :: State BState (Doc Text)
toNotes = do
  Map ByteString Int
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
  [ByteString]
allLabels <- (BState -> [ByteString]) -> StateT BState Identity [ByteString]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map ByteString Blocks -> [ByteString]
forall k a. Map k a -> [k]
M.keys (Map ByteString Blocks -> [ByteString])
-> (BState -> Map ByteString Blocks) -> BState -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteMap -> Map ByteString Blocks
unNoteMap (NoteMap -> Map ByteString Blocks)
-> (BState -> NoteMap) -> BState -> Map ByteString Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BState -> NoteMap
noteMap)
  let sortedLabels :: [ByteString]
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
  (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
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
<$> (ByteString -> State BState (Doc Text))
-> [ByteString] -> 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 -> State BState (Doc Text)
toNote [ByteString]
sortedLabels

toNote :: ByteString -> State BState (Layout.Doc Text)
toNote :: ByteString -> State BState (Doc Text)
toNote ByteString
label = do
  NoteMap
notes <- (BState -> NoteMap) -> StateT BState Identity NoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> NoteMap
noteMap
  case ByteString -> NoteMap -> Maybe Blocks
lookupNote ByteString
label NoteMap
notes of
    Maybe Blocks
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 Blocks
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
<$> Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
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

{-# 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 :: Inlines -> 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))
-> (Inlines -> StateT BState Identity (Seq (Doc Text)))
-> Inlines
-> 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)))
-> (Inlines -> Seq (Node Inline))
-> Inlines
-> StateT BState Identity (Seq (Doc Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany

instance ToLayout Blocks where
  toLayout :: Blocks -> 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))
-> (Blocks -> StateT BState Identity (Seq (Doc Text)))
-> Blocks
-> 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)))
-> (Blocks -> Seq (Node Block))
-> Blocks
-> StateT BState Identity (Seq (Doc Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> 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
go [(ByteString, ByteString)]
kvs)
         go :: (ByteString, ByteString) -> Doc Text
go (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)
         go (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'
         go (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))

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
                  Set ByteString
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 [(ByteString, ByteString)]
as = Attr
attr
                  Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Attr -> State BState (Doc Text))
-> Attr -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
k,ByteString
v) | (ByteString
k,ByteString
v) <- [(ByteString, ByteString)]
as
                                  , Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"id" Bool -> Bool -> Bool
&& ByteString
v ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ByteString
autoids)]
                Section{} -> do
                  Set ByteString
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 [(ByteString, ByteString)]
as = Attr
attr
                  Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout (Attr -> State BState (Doc Text))
-> Attr -> State BState (Doc Text)
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
k,ByteString
v) | (ByteString
k,ByteString
v) <- [(ByteString, ByteString)]
as
                                  , Bool -> Bool
not (ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"id" Bool -> Bool -> Bool
&&
                                         ByteString
v ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ByteString
autoids)]
                Block
_ -> Attr -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout 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 Inlines
ils -> Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
               Heading Int
lev Inlines
ils -> do
                 Doc Text
contents <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
                 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 (Int -> Text -> Text
T.replicate Int
lev Text
"#") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
contents
               Section Blocks
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
<$> Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
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 [Blocks]
items -> do
                 Maybe Char
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 :: Doc Text
bullet = case Maybe Char
lastb of
                                Just Char
'+' -> Doc Text
"-"
                                Just Char
'-' -> Doc Text
"+"
                                Maybe Char
_ -> Doc Text
"-"
                 (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
<$>
                   (Blocks -> State BState (Doc Text))
-> [Blocks] -> 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 ((Doc Text -> Doc Text)
-> State BState (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 (Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 (Doc Text
bullet Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space)) (State BState (Doc Text) -> State BState (Doc Text))
-> (Blocks -> State BState (Doc Text))
-> Blocks
-> State BState (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout) [Blocks]
items
               OrderedList OrderedListAttributes
listAttr ListSpacing
listSpacing [Blocks]
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 -> Blocks -> State BState (Doc Text))
-> [Int] -> [Blocks] -> StateT BState Identity [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (OrderedListAttributes -> Int -> Blocks -> State BState (Doc Text)
toOrderedListItem OrderedListAttributes
listAttr)
                          [(OrderedListAttributes -> Int
orderedListStart OrderedListAttributes
listAttr)..]
                          [Blocks]
items
               DefinitionList ListSpacing
listSpacing [(Inlines, Blocks)]
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
<$>
                 ((Inlines, Blocks) -> State BState (Doc Text))
-> [(Inlines, Blocks)] -> 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 (Inlines, Blocks) -> State BState (Doc Text)
toDefinitionListItem [(Inlines, Blocks)]
items
               TaskList ListSpacing
listSpacing [(TaskStatus, Blocks)]
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, Blocks) -> State BState (Doc Text))
-> [(TaskStatus, Blocks)] -> 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, Blocks) -> State BState (Doc Text)
toTaskListItem [(TaskStatus, Blocks)]
items
               Div Blocks
bls -> do
                 let nestedDivs :: Int
nestedDivs = Blocks -> Int
computeDivNestingLevel Blocks
bls
                 Doc Text
contents <- Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
bls
                 let colons :: Doc Text
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
":")
                 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
colons Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
colons
               BlockQuote Blocks
bls ->
                 if Blocks
bls Blocks -> Blocks -> Bool
forall a. Eq a => a -> a -> Bool
== Blocks
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
<$> Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
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
                 Doc Text
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 Blocks
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
<$> Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
bls
                 Doc Text
body <- [[Cell]] -> State BState (Doc Text)
toTable [[Cell]]
rows
                 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
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
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 Inlines
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
<$> Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
  [[((CellType, Align), Doc Text)]]
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 :: [Int]
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 -> ((a, Align), Doc a) -> Doc a
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] -> Doc a
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] -> Doc a
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 -> ((a, Align), b) -> Doc Text
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 toRow :: [((CellType, Align), Doc Text)] -> Doc Text
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
  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
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([((CellType, Align), Doc Text)] -> Doc Text)
-> [[((CellType, Align), Doc Text)]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [((CellType, Align), Doc Text)] -> Doc Text
toRow [[((CellType, Align), Doc Text)]]
rowContents

toDefinitionListItem :: (Inlines, Blocks) -> State BState (Layout.Doc Text)
toDefinitionListItem :: (Inlines, Blocks) -> State BState (Doc Text)
toDefinitionListItem (Inlines
term, Blocks
def) = do
  Doc Text
term' <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
term
  Doc Text
def' <- Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
def
  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
$ 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) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
def'

toTaskListItem :: (TaskStatus, Blocks) -> State BState (Layout.Doc Text)
toTaskListItem :: (TaskStatus, Blocks) -> State BState (Doc Text)
toTaskListItem (TaskStatus
status, Blocks
bls) = do
  Doc Text
contents <- Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
bls
  let marker :: Doc Text
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
  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
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
marker Doc Text
contents

toOrderedListItem :: OrderedListAttributes -> Int -> Blocks
                  -> State BState (Layout.Doc Text)
toOrderedListItem :: OrderedListAttributes -> Int -> Blocks -> State BState (Doc Text)
toOrderedListItem OrderedListAttributes
listAttr Int
num Blocks
bs = do
  Doc Text
contents <- Blocks -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Blocks
bs
  let marker :: Doc Text
marker = OrderedListAttributes -> Int -> Doc Text
formatOrderedListMarker OrderedListAttributes
listAttr Int
num
  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
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) Doc Text
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
            RenderOptions
opts <- (BState -> RenderOptions) -> StateT BState Identity RenderOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> RenderOptions
options
            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 RenderOptions -> Bool
preserveSoftBreaks RenderOptions
opts then Doc Text
forall a. Doc a
cr else Doc Text
forall a. Doc a
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 Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'_' Inlines
ils
          Strong Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'*' Inlines
ils
          Highlight Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'=' Inlines
ils
          Insert Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'+' Inlines
ils
          Delete Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'-' Inlines
ils
          Superscript Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'^' Inlines
ils
          Subscript Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'~' Inlines
ils
          Quoted QuoteType
SingleQuotes Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'\'' Inlines
ils
          Quoted QuoteType
DoubleQuotes Inlines
ils -> Char -> Inlines -> State BState (Doc Text)
surround Char
'"' Inlines
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 Inlines
ils -> do
            Doc Text
contents <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
            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
<> Doc Text
contents 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
<>
                    case Attr
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 Inlines
ils Target
target -> do
            Doc Text
contents <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
            let suffix :: Doc Text
suffix = Target -> Doc Text -> Doc Text
toLinkSuffix Target
target Doc Text
contents
            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
<> Doc Text
contents 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
suffix
          Image Inlines
ils Target
target -> do
            Doc Text
contents <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
            let suffix :: Doc Text
suffix = Target -> Doc Text -> Doc Text
toLinkSuffix Target
target Doc Text
contents
            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
<> Doc Text
contents 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
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
            Map ByteString Int
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 ByteString -> Map ByteString Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
label Map ByteString Int
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 ()
            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
toNoteRef ByteString
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 -> Inlines -> State BState (Doc Text)
surround Char
c Inlines
ils = do
  let startBeforeSpace :: Bool
startBeforeSpace =
        case Seq (Node Inline) -> ViewL (Node Inline)
forall a. Seq a -> ViewL a
Seq.viewl (Inlines -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany Inlines
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)}
  Doc Text
contents <- Inlines -> State BState (Doc Text)
forall a. ToLayout a => a -> State BState (Doc Text)
toLayout Inlines
ils
  (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 (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        (ord c) (nestings st)}
  Bool
endAfterSpace <- (BState -> Bool) -> StateT BState Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Bool
afterSpace
  Int
nestingLevel <- (BState -> Int) -> StateT BState Identity Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> (BState -> Maybe Int) -> BState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Char -> Int
ord Char
c) (IntMap Int -> Maybe Int)
-> (BState -> IntMap Int) -> BState -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BState -> IntMap Int
nestings)
  let core :: Doc Text
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
  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 Int
nestingLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
startBeforeSpace Bool -> Bool -> Bool
|| Bool
endAfterSpace) Bool -> Bool -> Bool
&&
         Bool -> Bool
not (Inlines -> Bool
forall a. Many a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
ils)
       then Doc Text
core
       else Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'{' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
core 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
'}'

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 :: Blocks -> 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 {a}. (Ord a, Num a) => Node Block -> a -> a
go Int
0 (Seq (Node Block) -> Int)
-> (Blocks -> Seq (Node Block)) -> Blocks -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany
 where
   go :: Node Block -> a -> a
go (Node Pos
_pos Attr
_ (Div Blocks
bls')) a
n =
     a -> a -> a
forall a. Ord a => a -> a -> a
max (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ((Node Block -> a -> a) -> a -> Seq (Node Block) -> a
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 -> a -> a
go (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany Blocks
bls'))
   go Node Block
_ a
n = a
n