{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Writers.Haddock (writeHaddock) where
import Control.Monad.State.Strict
import Data.Char (isAlphaNum)
import Data.Default
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
type Notes = [[Block]]
newtype WriterState = WriterState { WriterState -> Notes
stNotes :: Notes }
instance Default WriterState
where def :: WriterState
def = WriterState :: Notes -> WriterState
WriterState{ stNotes :: Notes
stNotes = [] }
writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHaddock :: WriterOptions -> Pandoc -> m Text
writeHaddock opts :: WriterOptions
opts document :: Pandoc
document =
StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions -> Pandoc -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToHaddock WriterOptions
opts{
writerWrapText :: WrapOption
writerWrapText = WriterOptions -> WrapOption
writerWrapText WriterOptions
opts } Pandoc
document) WriterState
forall a. Default a => a
def
pandocToHaddock :: PandocMonad m
=> WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToHaddock :: WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToHaddock opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
Doc Text
body <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts [Block]
blocks
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
Doc Text
notes' <- WriterOptions -> Notes -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Notes -> StateT WriterState m (Doc Text)
notesToHaddock WriterOptions
opts (Notes -> Notes
forall a. [a] -> [a]
reverse (Notes -> Notes) -> Notes -> Notes
forall a b. (a -> b) -> a -> b
$ WriterState -> Notes
stNotes WriterState
st)
let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
notes' then Doc Text
forall a. Doc a
empty else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
notes')
Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
(WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts)
((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts)
Meta
meta
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "body" Doc Text
main Context Text
metadata
Text -> StateT WriterState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT WriterState m Text)
-> Text -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Nothing -> Doc Text
main
Just tpl :: Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
notesToHaddock :: PandocMonad m
=> WriterOptions -> [[Block]] -> StateT WriterState m (Doc Text)
notesToHaddock :: WriterOptions -> Notes -> StateT WriterState m (Doc Text)
notesToHaddock opts :: WriterOptions
opts notes :: Notes
notes =
if Notes -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
notes
then Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else do
Doc Text
contents <- WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts (Block -> StateT WriterState m (Doc Text))
-> Block -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ListAttributes -> Notes -> Block
OrderedList (1,ListNumberStyle
DefaultStyle,ListNumberDelim
DefaultDelim) Notes
notes
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "#notes#" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
escapeString :: Text -> Text
escapeString :: Text -> Text
escapeString t :: Text
t
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
t = Text
t
| Bool
otherwise = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
t
where
escChar :: Char -> Text
escChar '\\' = "\\\\"
escChar '/' = "\\/"
escChar '\'' = "\\'"
escChar '`' = "\\`"
escChar '"' = "\\\""
escChar '@' = "\\@"
escChar '<' = "\\<"
escChar c :: Char
c = Char -> Text
T.singleton Char
c
blockToHaddock :: PandocMonad m
=> WriterOptions
-> Block
-> StateT WriterState m (Doc Text)
blockToHaddock :: WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock _ Null = Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToHaddock opts :: WriterOptions
opts (Div _ ils :: [Block]
ils) = do
Doc Text
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts [Block]
ils
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (Plain inlines :: [Inline]
inlines) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
inlines
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
blockToHaddock opts :: WriterOptions
opts (SimpleFigure attr :: Attr
attr alt :: [Inline]
alt (src :: Text
src, tit :: Text
tit))
= WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts ([Inline] -> Block
Para [Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
alt (Text
src,Text
tit)])
blockToHaddock opts :: WriterOptions
opts (Para inlines :: [Inline]
inlines) =
(Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts ([Inline] -> Block
Plain [Inline]
inlines)
blockToHaddock opts :: WriterOptions
opts (LineBlock lns :: [[Inline]]
lns) =
WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts (Block -> StateT WriterState m (Doc Text))
-> Block -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToHaddock _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "haddock" =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "\n"
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToHaddock opts :: WriterOptions
opts HorizontalRule =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (WriterOptions -> Int
writerColumns WriterOptions
opts) '_') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (Header level :: Int
level (ident :: Text
ident,_,_) inlines :: [Inline]
inlines) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
inlines
let attr' :: Doc Text
attr' = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
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 Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "#"
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
level '=') 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
<> Doc Text
contents)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
attr' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock _ (CodeBlock (_,_,_) str :: Text
str) =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed "> " (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (BlockQuote blocks :: [Block]
blocks) =
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts [Block]
blocks
blockToHaddock opts :: WriterOptions
opts (Table _ blkCapt :: Caption
blkCapt specs :: [ColSpec]
specs thead :: TableHead
thead tbody :: [TableBody]
tbody tfoot :: TableFoot
tfoot) = do
let (caption :: [Inline]
caption, aligns :: [Alignment]
aligns, widths :: [Double]
widths, headers :: Notes
headers, rows :: [Notes]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], Notes, [Notes])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
Doc Text
caption' <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
caption
let caption'' :: Doc Text
caption'' = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then Doc Text
forall a. Doc a
empty
else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
Doc Text
tbl <- WriterOptions
-> (WriterOptions -> [Block] -> StateT WriterState m (Doc Text))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a.
(Monad m, HasChars a) =>
WriterOptions
-> (WriterOptions -> [Block] -> m (Doc a))
-> Bool
-> [Alignment]
-> [Double]
-> Notes
-> [Notes]
-> m (Doc a)
gridTable WriterOptions
opts WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock
(([Block] -> Bool) -> Notes -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Notes
headers) ((Alignment -> Alignment) -> [Alignment] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> Alignment -> Alignment
forall a b. a -> b -> a
const Alignment
AlignDefault) [Alignment]
aligns)
[Double]
widths Notes
headers [Notes]
rows
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Doc Text
tbl 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 -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption'') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (BulletList items :: Notes
items) = do
[Doc Text]
contents <- ([Block] -> StateT WriterState m (Doc Text))
-> Notes -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToHaddock WriterOptions
opts) Notes
items
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Notes -> Bool
isTightList Notes
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (OrderedList (start :: Int
start,_,delim :: ListNumberDelim
delim) items :: Notes
items) = do
let attribs :: ListAttributes
attribs = (Int
start, ListNumberStyle
Decimal, ListNumberDelim
delim)
let markers :: [Text]
markers = ListAttributes -> [Text]
orderedListMarkers ListAttributes
attribs
let markers' :: [Text]
markers' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\m :: Text
m -> if Text -> Int
T.length Text
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3
then Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m) " "
else Text
m) [Text]
markers
[Doc Text]
contents <- (Text -> [Block] -> StateT WriterState m (Doc Text))
-> [Text] -> Notes -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
orderedListItemToHaddock WriterOptions
opts) [Text]
markers' Notes
items
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if Notes -> Bool
isTightList Notes
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToHaddock opts :: WriterOptions
opts (DefinitionList items :: [([Inline], Notes)]
items) = do
[Doc Text]
contents <- (([Inline], Notes) -> StateT WriterState m (Doc Text))
-> [([Inline], Notes)] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions
-> ([Inline], Notes) -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Inline], Notes) -> StateT WriterState m (Doc Text)
definitionListItemToHaddock WriterOptions
opts) [([Inline], Notes)]
items
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
bulletListItemToHaddock :: PandocMonad m
=> WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToHaddock :: WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
bulletListItemToHaddock opts :: WriterOptions
opts items :: [Block]
items = do
Doc Text
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts [Block]
items
let sps :: String
sps = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (WriterOptions -> Int
writerTabStop WriterOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) ' '
let start :: Doc Text
start = String -> Doc Text
forall a. HasChars a => String -> Doc a
text ('-' Char -> String -> String
forall a. a -> [a] -> [a]
: ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
sps)
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (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 (WriterOptions -> Int
writerTabStop WriterOptions
opts) Doc Text
start Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [Block] -> Bool
endsWithPlain [Block]
items
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
orderedListItemToHaddock :: PandocMonad m
=> WriterOptions
-> Text
-> [Block]
-> StateT WriterState m (Doc Text)
orderedListItemToHaddock :: WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
orderedListItemToHaddock opts :: WriterOptions
opts marker :: Text
marker items :: [Block]
items = do
Doc Text
contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock WriterOptions
opts [Block]
items
let sps :: Doc Text
sps = case Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
- WriterOptions -> Int
writerTabStop WriterOptions
opts of
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n ' '
_ -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text " "
let start :: Doc Text
start = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sps
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (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 (WriterOptions -> Int
writerTabStop WriterOptions
opts) Doc Text
start Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [Block] -> Bool
endsWithPlain [Block]
items
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
definitionListItemToHaddock :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> StateT WriterState m (Doc Text)
definitionListItemToHaddock :: WriterOptions
-> ([Inline], Notes) -> StateT WriterState m (Doc Text)
definitionListItemToHaddock opts :: WriterOptions
opts (label :: [Inline]
label, defs :: Notes
defs) = do
Doc Text
labelText <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
label
[[Doc Text]]
defs' <- ([Block] -> StateT WriterState m [Doc Text])
-> Notes -> StateT WriterState m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts)) Notes
defs
let contents :: Doc Text
contents = (if Notes -> Bool
isTightList Notes
defs then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: [Doc Text]
d -> Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang 4 Doc Text
forall a. Doc a
empty (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr) [[Doc Text]]
defs'
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
labelText) 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
$$
if Notes -> Bool
isTightList Notes
defs
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
blockListToHaddock :: PandocMonad m
=> WriterOptions
-> [Block]
-> StateT WriterState m (Doc Text)
blockListToHaddock :: WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
blockListToHaddock opts :: WriterOptions
opts blocks :: [Block]
blocks =
[Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> StateT WriterState m (Doc Text)
blockToHaddock WriterOptions
opts) [Block]
blocks
inlineListToHaddock :: PandocMonad m
=> WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock :: WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock opts :: WriterOptions
opts lst :: [Inline]
lst =
[Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock WriterOptions
opts) [Inline]
lst
inlineToHaddock :: PandocMonad m
=> WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock :: WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock opts :: WriterOptions
opts (Span (ident :: Text
ident,_,_) ils :: [Inline]
ils) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
ils
if Bool -> Bool
not (Text -> Bool
T.null Text
ident) Bool -> Bool -> Bool
&& [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
then Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "#" 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
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "#"
else Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
contents
inlineToHaddock opts :: WriterOptions
opts (Emph lst :: [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "/" 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
<> "/"
inlineToHaddock opts :: WriterOptions
opts (Underline lst :: [Inline]
lst) =
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock WriterOptions
opts ([Inline] -> Inline
Emph [Inline]
lst)
inlineToHaddock opts :: WriterOptions
opts (Strong lst :: [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "__" 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
<> "__"
inlineToHaddock opts :: WriterOptions
opts (Strikeout lst :: [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "~~" 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
<> "~~"
inlineToHaddock opts :: WriterOptions
opts (Superscript lst :: [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
inlineToHaddock opts :: WriterOptions
opts (Subscript lst :: [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
inlineToHaddock opts :: WriterOptions
opts (SmallCaps lst :: [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
inlineToHaddock opts :: WriterOptions
opts (Quoted SingleQuote lst :: [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "‘" 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
<> "’"
inlineToHaddock opts :: WriterOptions
opts (Quoted DoubleQuote lst :: [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "“" 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
<> "”"
inlineToHaddock _ (Code _ str :: Text
str) =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "@" 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 -> Text
escapeString Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "@"
inlineToHaddock _ (Str str :: Text
str) =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> 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
$ Text -> Text
escapeString Text
str
inlineToHaddock _ (Math mt :: MathType
mt str :: Text
str) =
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ case MathType
mt of
DisplayMath -> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\[" 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
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
InlineMath -> "\\(" 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
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "\\)"
inlineToHaddock _ il :: Inline
il@(RawInline f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "haddock" = Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToHaddock _ LineBreak = Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToHaddock opts :: WriterOptions
opts SoftBreak =
case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
WrapAuto -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
WrapNone -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
WrapPreserve -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToHaddock _ Space = Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToHaddock opts :: WriterOptions
opts (Cite _ lst :: [Inline]
lst) = WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
inlineListToHaddock WriterOptions
opts [Inline]
lst
inlineToHaddock _ (Link _ txt :: [Inline]
txt (src :: Text
src, _)) = do
let linktext :: Doc Text
linktext = 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
escapeString (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt
let useAuto :: Bool
useAuto = Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&&
case [Inline]
txt of
[Str s :: Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Bool
True
_ -> Bool
False
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "<" 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
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
(if Bool
useAuto then Doc Text
forall a. Doc a
empty else Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linktext) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ">"
inlineToHaddock opts :: WriterOptions
opts (Image attr :: Attr
attr alternate :: [Inline]
alternate (source :: Text
source, tit :: Text
tit)) = do
Doc Text
linkhaddock <- WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> StateT WriterState m (Doc Text)
inlineToHaddock WriterOptions
opts (Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
alternate (Text
source, Text
tit))
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkhaddock Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> ">"
inlineToHaddock opts :: WriterOptions
opts (Note contents :: [Block]
contents) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: WriterState
st -> WriterState
st{ stNotes :: Notes
stNotes = [Block]
contents [Block] -> Notes -> Notes
forall a. a -> [a] -> [a]
: WriterState -> Notes
stNotes WriterState
st })
WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
let ref :: Doc Text
ref = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Notes -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Notes -> Int) -> Notes -> Int
forall a b. (a -> b) -> a -> b
$ WriterState -> Notes
stNotes WriterState
st)
Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ "<#notes [" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> "]>"