    {-# 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 (zipWithM)
    import Control.Monad.State.Strict
        ( StateT, MonadState(get), modify, evalStateT )
    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.URI
    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{ stNotes :: Notes
    stNotes = [] }

    -- | Convert Pandoc to Haddock.
    writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m Text
    writeHaddock :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeHaddock WriterOptions
    opts 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 = writerWrapText 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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> StateT WriterState m Text
    pandocToHaddock WriterOptions
    opts (Pandoc Meta
    meta [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
      body <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    blockListToHaddock WriterOptions
    opts [Block]
    blocks
      st <- get
      notes' <- notesToHaddock opts (reverse $ stNotes st)
      let 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')
      metadata <- metaToContext opts
                   (blockListToHaddock opts)
                   (fmap chomp . inlineListToHaddock opts)
                   meta
      let context  = Text -> Doc Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    defField Text
    "body" Doc Text
    main Context Text
    metadata
      return $ render colwidth $
        case writerTemplate opts of
              Maybe (Template Text)
    Nothing  -> Doc Text
    main
              Just 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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Notes -> StateT WriterState m (Doc Text)
    notesToHaddock WriterOptions
    opts Notes
    notes =
      if Notes -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Notes
    notes
         then Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
         else do
           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 (Int
    1,ListNumberStyle
    DefaultStyle,ListNumberDelim
    DefaultDelim) Notes
    notes
           return $ text "#notes#" <> blankline <> contents

    -- | Escape special characters for Haddock.
    escapeString :: Text -> Text
    escapeString :: Text -> Text
    escapeString 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 Char
    '\\' = Text
    "\\\\"
      escChar Char
    '/'  = Text
    "\\/"
      escChar Char
    '\'' = Text
    "\\'"
      escChar Char
    '`'  = Text
    "\\`"
      escChar Char
    '"'  = Text
    "\\\""
      escChar Char
    '@'  = Text
    "\\@"
      escChar Char
    '<'  = Text
    "\\<"
      escChar Char
    c    = Char -> Text
    T.singleton Char
    c

    -- | Convert Pandoc block element to haddock.
    blockToHaddock :: PandocMonad m
                   => WriterOptions -- ^ Options
                   -> Block         -- ^ Block element
                   -> StateT WriterState m (Doc Text)
    blockToHaddock :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> StateT WriterState m (Doc Text)
    blockToHaddock WriterOptions
    opts (Div Attr
    _ [Block]
    ils) = do
      contents <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    blockListToHaddock WriterOptions
    opts [Block]
    ils
      return $ contents <> blankline
    blockToHaddock WriterOptions
    opts (Plain [Inline]
    inlines) = do
      contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    inlines
      return $ contents <> cr
    blockToHaddock WriterOptions
    opts (Para [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 a b.
    (a -> b) -> StateT WriterState m a -> StateT WriterState m b
    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 WriterOptions
    opts (LineBlock [[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 WriterOptions
    _ b :: Block
    b@(RawBlock Format
    f Text
    str)
      | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format
    "haddock" =
          Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 String
    "\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 a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToHaddock WriterOptions
    opts Block
    HorizontalRule =
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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) Char
    '_') Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    forall a. Doc a
    blankline
    blockToHaddock WriterOptions
    opts (Header Int
    level (Text
    ident,[Text]
    _,[(Text, Text)]
    _) [Inline]
    inlines) = do
      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' = 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 String
    "#" 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 String
    "#"
      return $ nowrap (text (replicate level '=') <> space <> contents)
                     <> attr' <> blankline
    blockToHaddock WriterOptions
    _ (CodeBlock (Text
    _,[Text]
    _,[(Text, Text)]
    _) Text
    str) =
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 String
    "> " (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 WriterOptions
    opts (BlockQuote [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 WriterOptions
    opts (Table Attr
    _ Caption
    blkCapt [ColSpec]
    specs TableHead
    thead [TableBody]
    tbody TableFoot
    tfoot) = do
      let Caption Maybe [Inline]
    _ [Block]
    caption = Caption
    blkCapt
      caption' <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    blockListToHaddock WriterOptions
    opts [Block]
    caption
      let caption'' = if [Block] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Block]
    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
      tbl <- gridTable opts blockListToHaddock specs thead tbody tfoot
      return $ (tbl $$ blankline $$ caption'') $$ blankline
    blockToHaddock WriterOptions
    opts (BulletList Notes
    items) = do
      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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
      return $ (if isTightList items then vcat else vsep) contents <> blankline
    blockToHaddock WriterOptions
    opts (OrderedList (Int
    start,ListNumberStyle
    _,ListNumberDelim
    delim) 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 (\Text
    m -> if Text -> Int
    T.length Text
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    3
                                   then Text
    m Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text -> Text
    T.replicate (Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    m) Text
    " "
                                   else Text
    m) [Text]
    markers
      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
      return $ (if isTightList items then vcat else vsep) contents <> blankline
    blockToHaddock WriterOptions
    opts (DefinitionList [([Inline], Notes)]
    items) = do
      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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
      return $ vcat contents <> blankline
    blockToHaddock WriterOptions
    opts (Figure Attr
    _ (Caption Maybe [Inline]
    _ [Block]
    longcapt) [Block]
    body) =
      -- Haddock has no concept of figures, floats, or captions.
      (Doc Text -> Doc Text)
    -> StateT WriterState m (Doc Text)
    -> StateT WriterState m (Doc Text)
    forall a b.
    (a -> b) -> StateT WriterState m a -> StateT WriterState m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    forall a. Doc a
    blankline) (WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    blockListToHaddock WriterOptions
    opts ([Block]
    body [Block] -> [Block] -> [Block]
    forall a. [a] -> [a] -> [a]
    ++ [Block]
    longcapt))

    -- | Convert bullet list item (list of blocks) to haddock
    bulletListItemToHaddock :: PandocMonad m
                            => WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    bulletListItemToHaddock :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    bulletListItemToHaddock WriterOptions
    opts [Block]
    items = do
      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 = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (WriterOptions -> Int
    writerTabStop WriterOptions
    opts Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Char
    ' '
      let start = String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (Char
    '-' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    sps)
      return $ hang (writerTabStop opts) start contents $$
               if endsWithPlain items
                  then cr
                  else 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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
    orderedListItemToHaddock WriterOptions
    opts Text
    marker [Block]
    items = do
      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 = case Text -> Int
    T.length Text
    marker Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - WriterOptions -> Int
    writerTabStop WriterOptions
    opts of
                       Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    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 Char
    ' '
                       Int
    _ -> String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text String
    " "
      let 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
      return $ hang (writerTabStop opts) start contents $$
               if endsWithPlain items
                  then cr
                  else blankline

    -- | Convert definition list item (label, list of blocks) to haddock
    definitionListItemToHaddock :: PandocMonad m
                                => WriterOptions
                                -> ([Inline],[[Block]])
                                -> StateT WriterState m (Doc Text)
    definitionListItemToHaddock :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> ([Inline], Notes) -> StateT WriterState m (Doc Text)
    definitionListItemToHaddock WriterOptions
    opts ([Inline]
    label, Notes
    defs) = do
      labelText <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    label
      defs' <- mapM (mapM (blockToHaddock opts)) defs
      let 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 (\[Doc Text]
    d -> Int -> Doc Text -> Doc Text -> Doc Text
    forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
    hang Int
    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'
      return $ nowrap (brackets labelText) $$ contents $$
               if isTightList defs
                  then cr
                  else 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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
    blockListToHaddock WriterOptions
    opts [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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> StateT WriterState m (Doc Text)
    inlineToHaddock WriterOptions
    opts (Span (Text
    ident,[Text]
    _,[(Text, Text)]
    _) [Inline]
    ils) = do
      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 not (T.null ident) && null ils
         then return $ "#" <> literal ident <> "#"
         else return contents
    inlineToHaddock WriterOptions
    opts (Emph [Inline]
    lst) = do
      contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    lst
      return $ "/" <> contents <> "/"
    -- Underline is not supported, treat the same as Emph
    inlineToHaddock WriterOptions
    opts (Underline [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 WriterOptions
    opts (Strong [Inline]
    lst) = do
      contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    lst
      return $ "__" <> contents <> "__"
    inlineToHaddock WriterOptions
    opts (Strikeout [Inline]
    lst) = do
      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:
      return $ "~~" <> contents <> "~~"
    -- not supported in haddock:
    inlineToHaddock WriterOptions
    opts (Superscript [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 WriterOptions
    opts (Subscript [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 WriterOptions
    opts (SmallCaps [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 WriterOptions
    opts (Quoted QuoteType
    SingleQuote [Inline]
    lst) = do
      contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    lst
      return $ "‘" <> contents <> "’"
    inlineToHaddock WriterOptions
    opts (Quoted QuoteType
    DoubleQuote [Inline]
    lst) = do
      contents <- WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
    inlineListToHaddock WriterOptions
    opts [Inline]
    lst
      return $ "“" <> contents <> "”"
    inlineToHaddock WriterOptions
    _ (Code Attr
    _ Text
    str) =
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 -> 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
    <> Doc Text
    "@"
    inlineToHaddock WriterOptions
    _ (Str Text
    str) =
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 WriterOptions
    _ (Math MathType
    mt Text
    str) =
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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
        MathType
    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 -> 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 -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    forall a. Doc a
    cr
        MathType
    InlineMath  -> 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 Text
    str Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    "\\)"
    inlineToHaddock WriterOptions
    _ il :: Inline
    il@(RawInline Format
    f Text
    str)
      | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format
    "haddock" = Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 a. a -> StateT WriterState m a
    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 WriterOptions
    _ Inline
    LineBreak = Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    cr
    inlineToHaddock WriterOptions
    opts Inline
    SoftBreak =
      case WriterOptions -> WrapOption
    writerWrapText WriterOptions
    opts of
           WrapOption
    WrapAuto     -> Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
           WrapOption
    WrapNone     -> Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
           WrapOption
    WrapPreserve -> Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    cr
    inlineToHaddock WriterOptions
    _ Inline
    Space = Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
    inlineToHaddock WriterOptions
    opts (Cite [Citation]
    _ [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 WriterOptions
    _ (Link Attr
    _ [Inline]
    txt (Text
    src, Text
    _)) = 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 Text
    s] | Text -> Text
    escapeURI Text
    s Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    src -> Bool
    True
                          [Inline]
    _       -> Bool
    False
      Doc Text -> StateT WriterState m (Doc Text)
    forall a. a -> StateT WriterState m a
    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 -> 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
    <> Doc Text
    ">"
    inlineToHaddock WriterOptions
    opts (Image Attr
    attr [Inline]
    alternate (Text
    source, Text
    tit)) = do
      linkhaddock <- WriterOptions -> Inline -> StateT WriterState m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Inline -> StateT WriterState m (Doc Text)
    inlineToHaddock WriterOptions
    opts (Attr -> [Inline] -> (Text, Text) -> Inline
    Link Attr
    attr [Inline]
    alternate (Text
    source, Text
    tit))
      return $ "<" <> linkhaddock <> ">"
    -- haddock doesn't have notes, but we can fake it:
    inlineToHaddock WriterOptions
    opts (Note [Block]
    contents) = do
      (WriterState -> WriterState) -> StateT WriterState m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\WriterState
    st -> WriterState
    st{ stNotes = contents : stNotes st })
      st <- StateT WriterState m WriterState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let 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 a. [a] -> 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)
      return $ "<#notes [" <> ref <> "]>"