{-# OPTIONS_GHC -fno-warn-orphans #-}

module Haddock.Doc
  ( module Documentation.Haddock.Doc
  , docCodeBlock
  , combineDocumentation
  ) where

import Data.Maybe

import Documentation.Haddock.Doc
import Haddock.Types
import Haddock.Utils (mkMeta)

combineDocumentation :: Documentation name -> Maybe (MDoc name)
combineDocumentation :: forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation (Documentation Maybe (MDoc name)
Nothing Maybe (Doc name)
Nothing) = Maybe (MDoc name)
forall a. Maybe a
Nothing
combineDocumentation (Documentation Maybe (MDoc name)
mDoc Maybe (Doc name)
mWarning) =
  MDoc name -> Maybe (MDoc name)
forall a. a -> Maybe a
Just
    ( MDoc name
-> (Doc name -> MDoc name) -> Maybe (Doc name) -> MDoc name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MDoc name
forall mod id. MetaDoc mod id
emptyMetaDoc Doc name -> MDoc name
forall a. Doc a -> MDoc a
mkMeta Maybe (Doc name)
mWarning
        MDoc name -> MDoc name -> MDoc name
forall mod id. MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
`metaDocAppend` MDoc name -> Maybe (MDoc name) -> MDoc name
forall a. a -> Maybe a -> a
fromMaybe MDoc name
forall mod id. MetaDoc mod id
emptyMetaDoc Maybe (MDoc name)
mDoc
    )

-- Drop trailing whitespace from @..@ code blocks.  Otherwise this:
--
--    -- @
--    -- foo
--    -- @
--
-- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML
-- gives an extra vertical space after the code block.  The single space
-- on the final line seems to trigger the extra vertical space.
--
docCodeBlock :: DocH mod id -> DocH mod id
docCodeBlock :: forall mod id. DocH mod id -> DocH mod id
docCodeBlock (DocString String
s) =
  String -> DocH mod id
forall mod id. String -> DocH mod id
DocString (String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` String
" \t") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
s)
docCodeBlock (DocAppend DocH mod id
l DocH mod id
r) =
  DocH mod id -> DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend DocH mod id
l (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
docCodeBlock DocH mod id
r)
docCodeBlock DocH mod id
d = DocH mod id
d