module Documentation.Haddock.Doc
  ( docParagraph
  , docAppend
  , docConcat
  , metaDocConcat
  , metaDocAppend
  , emptyMetaDoc
  , metaAppend
  , metaConcat
  ) where

import Control.Applicative ((<|>))
import Data.Char (isSpace)

import Documentation.Haddock.Types

docConcat :: [DocH mod id] -> DocH mod id
docConcat :: forall mod id. [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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) 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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) 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 :: forall mod id. [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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) 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 :: forall mod id. 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{_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 MetaSince
v1) (Meta Maybe MetaSince
v2) = Maybe MetaSince -> Meta
Meta (Maybe MetaSince
v1 Maybe MetaSince -> Maybe MetaSince -> Maybe MetaSince
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Maybe MetaSince
v2)

emptyMetaDoc :: MetaDoc mod id
emptyMetaDoc :: forall mod id. MetaDoc mod id
emptyMetaDoc = 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 MetaSince -> Meta
Meta Maybe MetaSince
forall a. Maybe a
Nothing

docAppend :: DocH mod id -> DocH mod id -> DocH mod id
docAppend :: forall mod id. 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 String
s1) (DocString String
s2) = String -> DocH mod id
forall mod id. String -> DocH mod id
DocString (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2)
docAppend (DocAppend DocH mod id
d (DocString String
s1)) (DocString String
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 (String -> DocH mod id
forall mod id. String -> DocH mod id
DocString (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2))
docAppend (DocString String
s1) (DocAppend (DocString String
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 (String -> DocH mod id
forall mod id. String -> DocH mod id
DocString (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 :: forall mod id. 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 String
s1) (DocMonospaced DocH mod id
p))
  | (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
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 String
s1)
      (DocAppend (DocMonospaced DocH mod id
p) (DocString String
s2))
    )
    | (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s1 Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
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 String
s2))
  | (Char -> Bool) -> String -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
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 :: 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