{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.Haddock
   Copyright   : Copyright (C) 2014-2015,2017 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to haddock markup.

Haddock:  <http://www.haskell.org/haddock/doc/html/>
-}
module Text.Pandoc.Writers.Haddock (writeHaddock) where
import Control.Monad.State.Strict
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]]
data WriterState = WriterState { WriterState -> Notes
stNotes :: Notes }
instance Default WriterState
  where def :: WriterState
def = WriterState :: Notes -> WriterState
WriterState{ stNotes :: Notes
stNotes = [] }

-- | Convert Pandoc to Haddock.
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

-- | Return haddock representation of document.
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

-- | Return haddock representation of notes.
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

-- | Escape special characters for Haddock.
escapeString :: Text -> Text
escapeString :: Text -> Text
escapeString = [(Char, Text)] -> Text -> Text
escapeStringUsing [(Char, Text)]
haddockEscapes
  where haddockEscapes :: [(Char, Text)]
haddockEscapes = String -> [(Char, Text)]
backslashEscapes "\\/'`\"@<"

-- | Convert Pandoc block element to haddock.
blockToHaddock :: PandocMonad m
               => WriterOptions -- ^ Options
               -> Block         -- ^ Block element
               -> 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
-- title beginning with fig: indicates figure
blockToHaddock opts :: WriterOptions
opts (Para [Image attr :: Attr
attr alt :: [Inline]
alt (src :: Text
src,tgt :: Text
tgt)])
  | Just tit :: Text
tit <- Text -> Text -> Maybe Text
T.stripPrefix "fig:" Text
tgt
  = 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) =
  -- TODO:  if it contains linebreaks, we need to use a @...@ block
  (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
-- Nothing in haddock corresponds to block quotes:
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 caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: Notes
headers rows :: [Notes]
rows) = do
  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
$ String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed "> " (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

-- | Convert bullet list item (list of blocks) to haddock
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

-- | Convert ordered list item (a list of blocks) to haddock
orderedListItemToHaddock :: PandocMonad m
                         => WriterOptions -- ^ options
                         -> Text        -- ^ list item marker
                         -> [Block]       -- ^ list item (list of blocks)
                         -> 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

-- | Convert definition list item (label, list of blocks) to haddock
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

-- | Convert list of Pandoc block elements to haddock
blockListToHaddock :: PandocMonad m
                   => WriterOptions -- ^ Options
                   -> [Block]       -- ^ List of block elements
                   -> 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

-- | Convert list of Pandoc inline elements to haddock.
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

-- | Convert Pandoc inline element to haddock.
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 (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
  -- not supported in haddock, but we fake it:
  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
<> "~~"
-- not supported in haddock:
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
-- not supported in haddock:
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
-- not supported in haddock:
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
-- no line break in haddock (see above on CodeBlock)
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
<> ">"
-- haddock doesn't have notes, but we can fake it:
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
<> "]>"