genTypeHeader :: IState -- ^ Needed to determine the types of names
              -> FunDoc -- ^ Type to generate type declaration for
              -> H.Html -- ^ Resulting HTML
genTypeHeader ist (FD n _ args ftype _) = do
  H.span ! class_ (toValue $ "name " ++ getType n)
         ! title  (toValue $ show n)
         $ toHtml $ name $ nsroot n
  H.span ! class_ "word"     $ do nbsp; ":"; nbsp
  H.span ! class_ "signature" $ preEscapedToHtml htmlSignature

  where
        htmlSignature  = displayDecorated decorator $ renderCompact signature
        signature      = pprintPTerm defaultPPOption [] names (idris_infixes ist) ftype
        names          = [ n | (n@(UN n'), _, _, _) <- args,
                           not (T.isPrefixOf (txt "__") n') ]

        decorator (AnnConst c) str | constIsType c = htmlSpan str "type" str
                                   | otherwise     = htmlSpan str "data" str
        decorator (AnnData _ _) str = htmlSpan str "data"    str
        decorator (AnnType _ _)   str = htmlSpan str "type"    str
        decorator AnnKeyword    str = htmlSpan ""  "keyword" str
        decorator (AnnBoundName n i) str | Just t <- M.lookup n docs =
          let cs = (if i then "implicit " else "") ++ "documented boundvar"
          in  htmlSpan t cs str
        decorator (AnnBoundName _ i) str =
          let cs = (if i then "implicit " else "") ++ "boundvar"
          in  htmlSpan "" cs str
        decorator (AnnName n _ _ _) str
          | filterName n = htmlLink (show n) (getType n) (link n) str
          | otherwise    = htmlSpan ""       (getType n)          str
        decorator (AnnTextFmt BoldText)      str = "<b>" ++ str ++ "</b>"
        decorator (AnnTextFmt UnderlineText) str = "<u>" ++ str ++ "</u>"
        decorator (AnnTextFmt ItalicText)    str = "<i>" ++ str ++ "</i>"
        decorator _ str = str

        htmlSpan :: String -> String -> String -> String
        htmlSpan t cs str = do
          R.renderHtml $ H.span ! class_ (toValue cs)
                                ! title (toValue t)
                                $ toHtml str
        htmlLink :: String -> String -> String -> String -> String
        htmlLink t cs a str = do
          R.renderHtml $ H.a ! class_ (toValue cs)
                       ! title (toValue t) ! href (toValue a)
                       $ toHtml str

        docs           = M.fromList $ mapMaybe docExtractor args
        docExtractor (_, _, _, Nothing) = Nothing
        docExtractor (n, _, _, Just d)  = Just (n, doc2Str d)
                         -- TODO: Remove <p> tags more robustly
        doc2Str d      = let dirty = renderMarkup $ contents $ Docstrings.renderHtml d
                         in  take (length dirty - 8) $ drop 3 dirty

        name (NS n ns) = show (NS (sUN $ name n) ns)
        name n         = let n' = show n
                         in  if (head n') `elem` opChars
                                then '(':(n' ++ ")")
                                else n'

        link n         = let path = genRelNsPath (getNs n) "html"
                         in  path ++ "#" ++ (show n)

        getType :: Name -> String
        getType n      = let ctxt = tt_ctxt ist
                         in  case () of
                               _ | isDConName n ctxt -> "constructor"
                               _ | isFnName   n ctxt -> "function"
                               _ | isTConName n ctxt -> "type"
                               _ | otherwise         -> ""

-- | Generates HTML documentation for a function.
genTypeHeader :: IState -- ^ Needed to determine the types of names
              -> FunDoc -- ^ Type to generate type declaration for
              -> H.Html
genTypeHeader ist (FD n _ args ftype _) = do
  H.span ! class_ (toValue $ "name " ++ getType n)
         ! title  (toValue $ show n)
         $ toHtml $ name $ nsroot n
  H.span ! class_ "word"     $ do nbsp; ":"; nbsp
  H.span ! class_ "signature" $ preEscapedToHtml htmlSignature

  where
        htmlSignature  = displayDecorated decorator $ renderCompact signature
        signature      = pprintPTerm defaultPPOption [] names (idris_infixes ist) ftype
        names          = [ n | (n@(UN n'), _, _, _) <- args,
                           not (T.isPrefixOf (txt "__") n') ]

        decorator (AnnConst c) str | constIsType c = htmlSpan str "type" str
                                   | otherwise     = htmlSpan str "data" str
        decorator (AnnData _ _) str = htmlSpan str "data"    str
        decorator (AnnType _ _)   str = htmlSpan str "type"    str
        decorator AnnKeyword    str = htmlSpan ""  "keyword" str
        decorator (AnnBoundName n i) str | Just t <- M.lookup n docs =
          let cs = (if i then "implicit " else "") ++ "documented boundvar"
          in  htmlSpan t cs str
        decorator (AnnBoundName _ i) str =
          let cs = (if i then "implicit " else "") ++ "boundvar"
          in  htmlSpan "" cs str
        decorator (AnnName n _ _ _) str
          | filterName n = htmlLink (show n) (getType n) (link n) str
          | otherwise    = htmlSpan ""       (getType n)          str
        decorator (AnnTextFmt BoldText)      str = "<b>" ++ str ++ "</b>"
        decorator (AnnTextFmt UnderlineText) str = "<u>" ++ str ++ "</u>"
        decorator (AnnTextFmt ItalicText)    str = "<i>" ++ str ++ "</i>"
        decorator _ str = str

        htmlSpan :: String -> String -> String -> String
        htmlSpan t cs str = do
          R.renderHtml $ H.span ! class_ (toValue cs)
                                ! title (toValue t)
                                $ toHtml str
        htmlLink :: String -> String -> String -> String -> String
        htmlLink t cs a str = do
          R.renderHtml $ H.a ! class_ (toValue cs)
                       ! title (toValue t) ! href (toValue a)
                       $ toHtml str

        docs           = M.fromList $ mapMaybe docExtractor args
        docExtractor (_, _, _, Nothing) = Nothing
        docExtractor (n, _, _, Just d)  = Just (n, doc2Str d)
                         -- TODO: Remove <p> tags more robustly
        doc2Str d      = let dirty = renderMarkup $ contents $ Docstrings.renderHtml d
                         in  take (length dirty - 8) $ drop 3 dirty

        name (NS n ns) = show (NS (sUN $ name n) ns)
        name n         = let n' = show n
                         in  if (head n') `elem` opChars
                                then '(':(n' ++ ")")
                                else n'

        link n         = let path = genRelNsPath (getNs n) "html"
                         in  path ++ "#" ++ (show n)

        getType :: Name -> String
        getType n      = let ctxt = tt_ctxt ist
                         in  case () of
                               _ | isDConName n ctxt -> "constructor"
                               _ | isFnName   n ctxt -> "function"
                               _ | isTConName n ctxt -> "type"
                               _ | otherwise         -> ""

-- | Generates HTML documentation for a function.
genTypeHeader ist (FD n _ args ftype _) = do
  H.span ! class_ (toValue $ "name " ++ getType n)
         ! title  (toValue $ show n)
         $ toHtml $ name $ nsroot n
  H.span ! class_ "word"     $ do nbsp; ":"; nbsp
  H.span ! class_ "signature" $ preEscapedToHtml htmlSignature

  where
        htmlSignature  = displayDecorated decorator $ renderCompact signature
        signature      = pprintPTerm defaultPPOption [] names (idris_infixes ist) ftype
        names          = [ n | (n@(UN n'), _, _, _) <- args,
                           not (T.isPrefixOf (txt "__") n') ]

        decorator (AnnConst c) str | constIsType c = htmlSpan str "type" str
                                   | otherwise     = htmlSpan str "data" str
        decorator (AnnData _ _) str = htmlSpan str "data"    str
        decorator (AnnType _ _)   str = htmlSpan str "type"    str
        decorator AnnKeyword    str = htmlSpan ""  "keyword" str
        decorator (AnnBoundName n i) str | Just t <- M.lookup n docs =
          let cs = (if i then "implicit " else "") ++ "documented boundvar"
          in  htmlSpan t cs str
        decorator (AnnBoundName _ i) str =
          let cs = (if i then "implicit " else "") ++ "boundvar"
          in  htmlSpan "" cs str
        decorator (AnnName n _ _ _) str
          | filterName n = htmlLink (show n) (getType n) (link n) str
          | otherwise    = htmlSpan ""       (getType n)          str
        decorator (AnnTextFmt BoldText)      str = "<b>" ++ str ++ "</b>"
        decorator (AnnTextFmt UnderlineText) str = "<u>" ++ str ++ "</u>"
        decorator (AnnTextFmt ItalicText)    str = "<i>" ++ str ++ "</i>"
        decorator _ str = str

        htmlSpan :: String -> String -> String -> String
        htmlSpan t cs str = do
          R.renderHtml $ H.span ! class_ (toValue cs)
                                ! title (toValue t)
                                $ toHtml str
        htmlLink :: String -> String -> String -> String -> String
        htmlLink t cs a str = do
          R.renderHtml $ H.a ! class_ (toValue cs)
                       ! title (toValue t) ! href (toValue a)
                       $ toHtml str

        docs           = M.fromList $ mapMaybe docExtractor args
        docExtractor (_, _, _, Nothing) = Nothing
        docExtractor (n, _, _, Just d)  = Just (n, doc2Str d)
                         -- TODO: Remove <p> tags more robustly
        doc2Str d      = let dirty = renderMarkup $ contents $ Docstrings.renderHtml d
                         in  take (length dirty - 8) $ drop 3 dirty

        name (NS n ns) = show (NS (sUN $ name n) ns)
        name n         = let n' = show n
                         in  if (head n') `elem` opChars
                                then '(':(n' ++ ")")
                                else n'

        link n         = let path = genRelNsPath (getNs n) "html"
                         in  path ++ "#" ++ (show n)

        getType :: Name -> String
        getType n      = let ctxt = tt_ctxt ist
                         in  case () of
                               _ | isDConName n ctxt -> "constructor"
                               _ | isFnName   n ctxt -> "function"
                               _ | isTConName n ctxt -> "type"
                               _ | otherwise         -> ""

-- | Generates HTML documentation for a function.