{-# OPTIONS_GHC -fno-warn-orphans #-}
module Documentation.Haddock.Doc (docParagraph, docAppend,
                                  docConcat, metaDocConcat,
                                  metaDocAppend, emptyMetaDoc,
                                  metaAppend, metaConcat) where

import Control.Applicative ((<|>), empty)
import Documentation.Haddock.Types
import Data.Char (isSpace)

docConcat :: [DocH mod id] -> DocH mod id
docConcat :: [DocH mod id] -> DocH mod id
docConcat = (DocH mod id -> DocH mod id -> DocH mod id)
-> DocH mod id -> [DocH mod id] -> DocH mod id
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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
forall mod id. DocH mod id
DocEmpty

-- | Concat using 'metaAppend'.
metaConcat :: [Meta] -> Meta
metaConcat :: [Meta] -> Meta
metaConcat = (Meta -> Meta -> Meta) -> Meta -> [Meta] -> Meta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Meta -> Meta -> Meta
metaAppend Meta
emptyMeta

-- | Like 'docConcat' but also joins the 'Meta' info.
metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id
metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id
metaDocConcat = (MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id)
-> MetaDoc mod id -> [MetaDoc mod id] -> MetaDoc mod id
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
forall mod id. MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
metaDocAppend MetaDoc mod id
forall mod id. MetaDoc mod id
emptyMetaDoc

-- | We do something perhaps unexpected here and join the meta info
-- in ‘reverse’: this results in the metadata from the ‘latest’
-- paragraphs taking precedence.
metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
metaDocAppend (MetaDoc { _meta :: forall mod id. MetaDoc mod id -> Meta
_meta = Meta
m, _doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocH mod id
d })
              (MetaDoc { _meta :: forall mod id. MetaDoc mod id -> Meta
_meta = Meta
m', _doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocH mod id
d' }) =
  MetaDoc :: forall mod id. Meta -> DocH mod id -> MetaDoc mod id
MetaDoc { _meta :: Meta
_meta = Meta
m' Meta -> Meta -> Meta
`metaAppend` Meta
m, _doc :: DocH mod id
_doc = DocH mod id
d 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
d' }

-- | This is not a monoidal append, it uses '<|>' for the '_version' and
-- '_package'.
metaAppend :: Meta -> Meta -> Meta
metaAppend :: Meta -> Meta -> Meta
metaAppend (Meta Maybe Version
v1 Maybe Package
p1) (Meta Maybe Version
v2 Maybe Package
p2) = Maybe Version -> Maybe Package -> Meta
Meta (Maybe Version
v1 Maybe Version -> Maybe Version -> Maybe Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Version
v2) (Maybe Package
p1 Maybe Package -> Maybe Package -> Maybe Package
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Package
p2)

emptyMetaDoc :: MetaDoc mod id
emptyMetaDoc :: MetaDoc mod id
emptyMetaDoc = MetaDoc :: forall mod id. Meta -> DocH mod id -> MetaDoc mod id
MetaDoc { _meta :: Meta
_meta = Meta
emptyMeta, _doc :: DocH mod id
_doc = DocH mod id
forall mod id. DocH mod id
DocEmpty }

emptyMeta :: Meta
emptyMeta :: Meta
emptyMeta = Maybe Version -> Maybe Package -> Meta
Meta Maybe Version
forall (f :: * -> *) a. Alternative f => f a
empty Maybe Package
forall (f :: * -> *) a. Alternative f => f a
empty

docAppend :: DocH mod id -> DocH mod id -> DocH mod id
docAppend :: DocH mod id -> DocH mod id -> DocH mod id
docAppend (DocDefList [(DocH mod id, DocH mod id)]
ds1) (DocDefList [(DocH mod id, DocH mod id)]
ds2) = [(DocH mod id, DocH mod id)] -> DocH mod id
forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList ([(DocH mod id, DocH mod id)]
ds1[(DocH mod id, DocH mod id)]
-> [(DocH mod id, DocH mod id)] -> [(DocH mod id, DocH mod id)]
forall a. [a] -> [a] -> [a]
++[(DocH mod id, DocH mod id)]
ds2)
docAppend (DocDefList [(DocH mod id, DocH mod id)]
ds1) (DocAppend (DocDefList [(DocH mod id, DocH mod id)]
ds2) DocH mod id
d) = 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, DocH mod id)] -> DocH mod id
forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList ([(DocH mod id, DocH mod id)]
ds1[(DocH mod id, DocH mod id)]
-> [(DocH mod id, DocH mod id)] -> [(DocH mod id, DocH mod id)]
forall a. [a] -> [a] -> [a]
++[(DocH mod id, DocH mod id)]
ds2)) DocH mod id
d
docAppend (DocOrderedList [(Int, DocH mod id)]
ds1) (DocOrderedList [(Int, DocH mod id)]
ds2) = [(Int, DocH mod id)] -> DocH mod id
forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList ([(Int, DocH mod id)]
ds1 [(Int, DocH mod id)]
-> [(Int, DocH mod id)] -> [(Int, DocH mod id)]
forall a. [a] -> [a] -> [a]
++ [(Int, DocH mod id)]
ds2)
docAppend (DocOrderedList [(Int, DocH mod id)]
ds1) (DocAppend (DocOrderedList [(Int, DocH mod id)]
ds2) DocH mod id
d) = DocH mod id -> DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend ([(Int, DocH mod id)] -> DocH mod id
forall mod id. [(Int, DocH mod id)] -> DocH mod id
DocOrderedList ([(Int, DocH mod id)]
ds1[(Int, DocH mod id)]
-> [(Int, DocH mod id)] -> [(Int, DocH mod id)]
forall a. [a] -> [a] -> [a]
++[(Int, DocH mod id)]
ds2)) DocH mod id
d
docAppend (DocUnorderedList [DocH mod id]
ds1) (DocUnorderedList [DocH mod id]
ds2) = [DocH mod id] -> DocH mod id
forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList ([DocH mod id]
ds1 [DocH mod id] -> [DocH mod id] -> [DocH mod id]
forall a. [a] -> [a] -> [a]
++ [DocH mod id]
ds2)
docAppend (DocUnorderedList [DocH mod id]
ds1) (DocAppend (DocUnorderedList [DocH mod id]
ds2) DocH mod id
d) = 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] -> DocH mod id
forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList ([DocH mod id]
ds1[DocH mod id] -> [DocH mod id] -> [DocH mod id]
forall a. [a] -> [a] -> [a]
++[DocH mod id]
ds2)) DocH mod id
d
docAppend DocH mod id
DocEmpty DocH mod id
d = DocH mod id
d
docAppend DocH mod id
d DocH mod id
DocEmpty = DocH mod id
d
docAppend (DocString Package
s1) (DocString Package
s2) = Package -> DocH mod id
forall mod id. Package -> DocH mod id
DocString (Package
s1 Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
s2)
docAppend (DocAppend DocH mod id
d (DocString Package
s1)) (DocString Package
s2) = 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
d (Package -> DocH mod id
forall mod id. Package -> DocH mod id
DocString (Package
s1 Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
s2))
docAppend (DocString Package
s1) (DocAppend (DocString Package
s2) DocH mod id
d) = DocH mod id -> DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend (Package -> DocH mod id
forall mod id. Package -> DocH mod id
DocString (Package
s1 Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Package
s2)) DocH mod id
d
docAppend DocH mod id
d1 DocH mod id
d2 = 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
d1 DocH mod id
d2

-- again to make parsing easier - we spot a paragraph whose only item
-- is a DocMonospaced and make it into a DocCodeBlock
docParagraph :: DocH mod id -> DocH mod id
docParagraph :: DocH mod id -> DocH mod id
docParagraph (DocMonospaced DocH mod id
p)
  = DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
docCodeBlock DocH mod id
p)
docParagraph (DocAppend (DocString Package
s1) (DocMonospaced DocH mod id
p))
  | (Char -> Bool) -> Package -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Package
s1
  = DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
docCodeBlock DocH mod id
p)
docParagraph (DocAppend (DocString Package
s1)
    (DocAppend (DocMonospaced DocH mod id
p) (DocString Package
s2)))
  | (Char -> Bool) -> Package -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Package
s1 Bool -> Bool -> Bool
&& (Char -> Bool) -> Package -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Package
s2
  = DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
docCodeBlock DocH mod id
p)
docParagraph (DocAppend (DocMonospaced DocH mod id
p) (DocString Package
s2))
  | (Char -> Bool) -> Package -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Package
s2
  = DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
docCodeBlock DocH mod id
p)
docParagraph DocH mod id
p
  = DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocParagraph DocH mod id
p


-- 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 :: DocH mod id -> DocH mod id
docCodeBlock (DocString Package
s)
  = Package -> DocH mod id
forall mod id. Package -> DocH mod id
DocString (Package -> Package
forall a. [a] -> [a]
reverse (Package -> Package) -> Package -> Package
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Package -> Package
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Package -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Package
" \t") (Package -> Package) -> Package -> Package
forall a b. (a -> b) -> a -> b
$ Package -> Package
forall a. [a] -> [a]
reverse Package
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