-- | Render an abstract representation of documentation (as produced
-- by `parseGtkDoc`) as Haddock formatted documentation.
module Data.GI.CodeGen.Haddock
  ( deprecatedPragma
  , writeDocumentation
  , RelativeDocPosition(..)
  , writeHaddock
  , writeArgDocumentation
  , writeReturnDocumentation
  , addSectionDocumentation
  ) where

#if !MIN_VERSION_base(4,13,0)
import Control.Monad (mapM_, unless)
#else
import Control.Monad (unless)
#endif
import qualified Data.Map as M
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import Data.Text (Text)

import Data.GI.GIR.Arg (Arg(..))
import Data.GI.GIR.Callable (Callable(..))
import Data.GI.GIR.Deprecation (DeprecationInfo(..))
import Data.GI.GIR.Documentation (Documentation(..))

import Data.GI.CodeGen.Code (CodeGen, config, line, HaddockSection,
                             getC2HMap, addSectionFormattedDocs)
import Data.GI.CodeGen.Config (modName, overrides)
import Data.GI.CodeGen.CtoHaskellMap (Hyperlink(..))
import Data.GI.CodeGen.GtkDoc (GtkDoc(..), Token(..), CRef(..), Language(..),
                               Link(..), ListItem(..), parseGtkDoc)
import Data.GI.CodeGen.Overrides (onlineDocsMap)
import Data.GI.CodeGen.SymbolNaming (lowerSymbol, signalHaskellName)

-- | Where is the documentation located with respect to the relevant
-- symbol, useful for determining whether we want to start with @|@ or @^@.
data RelativeDocPosition = DocBeforeSymbol
                         | DocAfterSymbol

-- | Given a `GtkDoc`, a map from C identifiers to Haskell symbols,
-- and a location online where to find the C documentation, render the
-- corresponding Haddock-formatted text. Note that the comment
-- delimiters are not included in the output.
--
-- === __Examples__
-- >>> formatHaddock M.empty "" (GtkDoc [Literal "Hello ", Literal "World!"])
-- "Hello World!"
--
-- >>> let c2h = M.fromList [(FunctionRef "foo", ValueIdentifier "foo")]
-- >>> formatHaddock c2h "" (GtkDoc [SymbolRef (FunctionRef "foo")])
-- "'foo'"
--
-- >>> let onlineDocs = "http://wiki.haskell.org"
-- >>> formatHaddock M.empty onlineDocs (GtkDoc [ExternalLink (Link "GI" "GObjectIntrospection")])
-- "<http://wiki.haskell.org/GObjectIntrospection GI>"
--
-- >>> formatHaddock M.empty "a" (GtkDoc [List [ListItem (GtkDoc [Image (Link "test" "test.png")]) []]])
-- "\n* <<a/test.png test>>\n"
formatHaddock :: M.Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock :: Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock c2h :: Map CRef Hyperlink
c2h docBase :: Text
docBase (GtkDoc doc :: [Token]
doc) = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Token -> Text) -> [Token] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Text
formatToken [Token]
doc
  where formatToken :: Token -> Text
        formatToken :: Token -> Text
formatToken (Literal l :: Text
l) = Text -> Text
escape Text
l
        formatToken (Comment _) = ""
        formatToken (Verbatim v :: Text
v) = "@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escape Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@"
        formatToken (CodeBlock l :: Maybe Language
l c :: Text
c) = Maybe Language -> Text -> Text
formatCodeBlock Maybe Language
l Text
c
        formatToken (ExternalLink l :: Link
l) = Link -> Text -> Text
formatLink Link
l Text
docBase
        formatToken (Image l :: Link
l) = Link -> Text -> Text
formatImage Link
l Text
docBase
        formatToken (SectionHeader l :: Int
l h :: GtkDoc
h) = Map CRef Hyperlink -> Text -> Int -> GtkDoc -> Text
formatSectionHeader Map CRef Hyperlink
c2h Text
docBase Int
l GtkDoc
h
        formatToken (List l :: [ListItem]
l) = Map CRef Hyperlink -> Text -> [ListItem] -> Text
formatList Map CRef Hyperlink
c2h Text
docBase [ListItem]
l
        formatToken (SymbolRef cr :: CRef
cr) = case CRef -> Map CRef Hyperlink -> Maybe Hyperlink
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CRef
cr Map CRef Hyperlink
c2h of
          Just hr :: Hyperlink
hr -> Hyperlink -> Text
formatHyperlink Hyperlink
hr
          Nothing -> Map CRef Hyperlink -> CRef -> Text
formatUnknownCRef Map CRef Hyperlink
c2h CRef
cr

-- | Format a `CRef` whose Haskell representation is not known.
formatUnknownCRef :: M.Map CRef Hyperlink -> CRef -> Text
formatUnknownCRef :: Map CRef Hyperlink -> CRef -> Text
formatUnknownCRef _ (FunctionRef f :: Text
f) = Text -> Text
formatCRef (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "()"
formatUnknownCRef _ (ParamRef p :: Text
p) = "/@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
lowerSymbol Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@/"
formatUnknownCRef _ (LocalSignalRef s :: Text
s) =
  let sn :: Text
sn = Text -> Text
signalHaskellName Text
s
  in "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "](#signal:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
formatUnknownCRef c2h :: Map CRef Hyperlink
c2h (SignalRef owner :: Text
owner signal :: Text
signal) =
  case CRef -> Map CRef Hyperlink -> Maybe Hyperlink
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CRef
TypeRef Text
owner) Map CRef Hyperlink
c2h of
    Nothing -> Text -> Text
formatCRef (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
signal
    Just r :: Hyperlink
r -> Hyperlink -> Text
formatHyperlink Hyperlink
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
formatCRef Text
signal
formatUnknownCRef c2h :: Map CRef Hyperlink
c2h (PropertyRef owner :: Text
owner prop :: Text
prop) =
  case CRef -> Map CRef Hyperlink -> Maybe Hyperlink
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CRef
TypeRef Text
owner) Map CRef Hyperlink
c2h of
    Nothing -> Text -> Text
formatCRef (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prop
    Just r :: Hyperlink
r -> Hyperlink -> Text
formatHyperlink Hyperlink
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
formatCRef Text
prop
formatUnknownCRef c2h :: Map CRef Hyperlink
c2h (VMethodRef owner :: Text
owner vmethod :: Text
vmethod) =
  case CRef -> Map CRef Hyperlink -> Maybe Hyperlink
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CRef
TypeRef Text
owner) Map CRef Hyperlink
c2h of
    Nothing -> Text -> Text
formatCRef (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vmethod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "()"
    Just r :: Hyperlink
r -> Hyperlink -> Text
formatHyperlink Hyperlink
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
formatCRef Text
vmethod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "()"
formatUnknownCRef c2h :: Map CRef Hyperlink
c2h (StructFieldRef owner :: Text
owner field :: Text
field) =
  case CRef -> Map CRef Hyperlink -> Maybe Hyperlink
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> CRef
TypeRef Text
owner) Map CRef Hyperlink
c2h of
    Nothing -> Text -> Text
formatCRef (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field
    Just r :: Hyperlink
r -> Hyperlink -> Text
formatHyperlink Hyperlink
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
formatCRef Text
field
formatUnknownCRef _ (TypeRef t :: Text
t) = Text -> Text
formatCRef Text
t
formatUnknownCRef _ (ConstantRef t :: Text
t) = Text -> Text
formatCRef Text
t

-- | Formatting for an unknown C reference.
formatCRef :: Text -> Text
formatCRef :: Text -> Text
formatCRef t :: Text
t = "@/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escape Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/@"

-- | Format a `Hyperlink` into plain `Text`.
formatHyperlink :: Hyperlink -> Text
formatHyperlink :: Hyperlink -> Text
formatHyperlink (TypeIdentifier t :: Text
t) = "t'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'"
formatHyperlink (ValueIdentifier t :: Text
t) = "'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'"
formatHyperlink (ModuleLink m :: Text
m) = "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
formatHyperlink (ModuleLinkWithAnchor mLabel :: Maybe Text
mLabel m :: Text
m a :: Text
a) =
  case Maybe Text
mLabel of
    Nothing -> "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
    Just label :: Text
label -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "](\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\")"

-- | Format a code block in a specified language.
formatCodeBlock :: Maybe Language -> Text -> Text
formatCodeBlock :: Maybe Language -> Text -> Text
formatCodeBlock maybeLang :: Maybe Language
maybeLang code :: Text
code =
  let header :: Text
header = case Maybe Language
maybeLang of
        Nothing -> ""
        Just (Language lang :: Text
lang) -> "\n=== /" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " code/\n"
      birdTrack :: Text -> Text
birdTrack = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
T.cons '>') ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  in Text
header Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
birdTrack Text
code

-- | Qualify the given address with the docBase, if it is not an
-- absolute address.
qualifiedWith :: Text -> Text -> Text
qualifiedWith :: Text -> Text -> Text
qualifiedWith address :: Text
address docBase :: Text
docBase =
  if "http://" Text -> Text -> Bool
`T.isPrefixOf` Text
address Bool -> Bool -> Bool
|| "https://" Text -> Text -> Bool
`T.isPrefixOf` Text
address
  then Text
address
  else if "/" Text -> Text -> Bool
`T.isSuffixOf` Text
docBase
       then Text
docBase Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address
       else Text
docBase Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address

-- | Format a link to some external resource.
formatLink :: Link -> Text -> Text
formatLink :: Link -> Text -> Text
formatLink (Link {linkName :: Link -> Text
linkName = Text
name, linkAddress :: Link -> Text
linkAddress = Text
address}) docBase :: Text
docBase =
  let address' :: Text
address' = Text
address Text -> Text -> Text
`qualifiedWith` Text
docBase
      name' :: Text
name' = Text -> Text -> Text -> Text
T.replace ">" "\\>" Text
name
  in "<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"

-- | Format an embedded image.
formatImage :: Link -> Text -> Text
formatImage :: Link -> Text -> Text
formatImage (Link {linkName :: Link -> Text
linkName = Text
name, linkAddress :: Link -> Text
linkAddress = Text
address}) docBase :: Text
docBase =
  let address' :: Text
address' = Text
address Text -> Text -> Text
`qualifiedWith` Text
docBase
      name' :: Text
name' = Text -> Text -> Text -> Text
T.replace ">" "\\>" Text
name
  in if Text -> Bool
T.null Text
name'
     then "<<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">>"
     else "<<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">>"

-- | Format a section header of the given level and with the given
-- text. Note that the level will be truncated to 2, if it is larger
-- than that.
formatSectionHeader :: M.Map CRef Hyperlink -> Text -> Int -> GtkDoc -> Text
formatSectionHeader :: Map CRef Hyperlink -> Text -> Int -> GtkDoc -> Text
formatSectionHeader c2h :: Map CRef Hyperlink
c2h docBase :: Text
docBase level :: Int
level header :: GtkDoc
header =
  Int -> Text -> Text
T.replicate Int
level "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase GtkDoc
header Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"

-- | Format a list of items.
formatList :: M.Map CRef Hyperlink -> Text -> [ListItem] -> Text
formatList :: Map CRef Hyperlink -> Text -> [ListItem] -> Text
formatList c2h :: Map CRef Hyperlink
c2h docBase :: Text
docBase items :: [ListItem]
items = "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((ListItem -> Text) -> [ListItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ListItem -> Text
formatListItem [ListItem]
items)
  where formatListItem :: ListItem -> Text
        formatListItem :: ListItem -> Text
formatListItem (ListItem first :: GtkDoc
first rest :: [GtkDoc]
rest) =
          "* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GtkDoc -> Text
format GtkDoc
first Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((GtkDoc -> Text) -> [GtkDoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n") (Text -> Text) -> (GtkDoc -> Text) -> GtkDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GtkDoc -> Text
format) [GtkDoc]
rest)

        format :: GtkDoc -> Text
        format :: GtkDoc -> Text
format = Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase

-- | Escape the reserved Haddock characters in a given `Text`.
--
-- === __Examples__
-- >>> escape "\""
-- "\\\""
--
-- >>> escape "foo@bar.com"
-- "foo\\@bar.com"
--
-- >>> escape "C:\\Applications"
-- "C:\\\\Applications"
escape :: Text -> Text
escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar
  where
    escapeChar :: Char -> Text
    escapeChar :: Char -> Text
escapeChar c :: Char
c = if Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("\\/'`\"@<" :: [Char])
                   then "\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
                   else Char -> Text
T.singleton Char
c

-- | Get the base url for the online C language documentation for the
-- module being currently generated.
getDocBase :: CodeGen Text
getDocBase :: BaseCodeGen e Text
getDocBase = do
  Text
mod <- Config -> Text
modName (Config -> Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Config
-> BaseCodeGen e Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Config
CodeGen Config
config
  Map Text Text
docsMap <- (Overrides -> Map Text Text
onlineDocsMap (Overrides -> Map Text Text)
-> (Config -> Overrides) -> Config -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Overrides
overrides) (Config -> Map Text Text)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Config
-> ReaderT
     CodeGenConfig
     (StateT (CGState, ModuleInfo) (Except e))
     (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Config
CodeGen Config
config
  Text -> BaseCodeGen e Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> BaseCodeGen e Text) -> Text -> BaseCodeGen e Text
forall a b. (a -> b) -> a -> b
$ case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
mod Map Text Text
docsMap of
             Just url :: Text
url -> Text
url
             Nothing -> "http://developer.gnome.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        "/stable"

-- | Write the deprecation pragma for the given `DeprecationInfo`, if
-- not `Nothing`.
deprecatedPragma :: Text -> Maybe DeprecationInfo -> CodeGen ()
deprecatedPragma :: Text -> Maybe DeprecationInfo -> CodeGen ()
deprecatedPragma _  Nothing = ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
deprecatedPragma name :: Text
name (Just info :: DeprecationInfo
info) = do
  Map CRef Hyperlink
c2h <- BaseCodeGen e (Map CRef Hyperlink)
CodeGen (Map CRef Hyperlink)
getC2HMap
  Text
docBase <- BaseCodeGen e Text
CodeGen Text
getDocBase
  Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
Text -> CodeGen ()
line (Text
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
-> Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall a b. (a -> b) -> a -> b
$ "{-# DEPRECATED " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    ([Char] -> Text
T.pack ([Char] -> Text) -> ([Text] -> [Char]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Char]
forall a. Show a => a -> [Char]
show) ([Text]
note [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Map CRef Hyperlink -> Text -> [Text]
reason Map CRef Hyperlink
c2h Text
docBase) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " #-}"
        where reason :: Map CRef Hyperlink -> Text -> [Text]
reason c2h :: Map CRef Hyperlink
c2h docBase :: Text
docBase =
                case DeprecationInfo -> Maybe Text
deprecationMessage DeprecationInfo
info of
                  Nothing -> []
                  Just msg :: Text
msg -> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase (GtkDoc -> Text) -> (Text -> GtkDoc) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> GtkDoc
parseGtkDoc)
                                  (Text -> [Text]
T.lines Text
msg)
              note :: [Text]
note = case DeprecationInfo -> Maybe Text
deprecatedSinceVersion DeprecationInfo
info of
                       Nothing -> []
                       Just v :: Text
v -> ["(Since version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"]

-- | Format the given documentation into a set of lines. Note that
-- this does include the opening or ending comment delimiters.
formatDocumentation :: M.Map CRef Hyperlink -> Text -> Documentation -> Text
formatDocumentation :: Map CRef Hyperlink -> Text -> Documentation -> Text
formatDocumentation c2h :: Map CRef Hyperlink
c2h docBase :: Text
docBase doc :: Documentation
doc = do
  let description :: Text
description = case Documentation -> Maybe Text
rawDocText Documentation
doc of
        Just raw :: Text
raw -> Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase (Text -> GtkDoc
parseGtkDoc Text
raw)
        Nothing -> "/No description available in the introspection data./"
  Text
description Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Documentation -> Maybe Text
sinceVersion Documentation
doc of
                   Nothing -> ""
                   Just ver :: Text
ver -> "\n\n/Since: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/"

-- | Write the given documentation into generated code.
writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen ()
writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen ()
writeDocumentation pos :: RelativeDocPosition
pos doc :: Documentation
doc = do
  Map CRef Hyperlink
c2h <- BaseCodeGen e (Map CRef Hyperlink)
CodeGen (Map CRef Hyperlink)
getC2HMap
  Text
docBase <- BaseCodeGen e Text
CodeGen Text
getDocBase
  RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
pos (Map CRef Hyperlink -> Text -> Documentation -> Text
formatDocumentation Map CRef Hyperlink
c2h Text
docBase Documentation
doc)

-- | Like `writeDocumentation`, but allows us to pass explicitly the
-- Haddock comment to write.
writeHaddock :: RelativeDocPosition -> Text -> CodeGen ()
writeHaddock :: RelativeDocPosition -> Text -> CodeGen ()
writeHaddock pos :: RelativeDocPosition
pos haddock :: Text
haddock =
  let marker :: Text
marker = case RelativeDocPosition
pos of
        DocBeforeSymbol -> "|"
        DocAfterSymbol -> "^"
      lines :: [Text]
lines = case Text -> [Text]
T.lines Text
haddock of
        [] -> []
        (first :: Text
first:rest :: [Text]
rest) -> ("-- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
first) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("-- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
rest
  in (Text
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
-> [Text]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
Text -> CodeGen ()
line [Text]
lines

-- | Write the documentation for the given argument.
writeArgDocumentation :: Arg -> CodeGen ()
writeArgDocumentation :: Arg -> CodeGen ()
writeArgDocumentation arg :: Arg
arg =
  case Documentation -> Maybe Text
rawDocText (Arg -> Documentation
argDoc Arg
arg) of
    Nothing -> ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just raw :: Text
raw -> do
      Map CRef Hyperlink
c2h <- BaseCodeGen e (Map CRef Hyperlink)
CodeGen (Map CRef Hyperlink)
getC2HMap
      Text
docBase <- BaseCodeGen e Text
CodeGen Text
getDocBase
      let haddock :: Text
haddock = "/@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
lowerSymbol (Arg -> Text
argCName Arg
arg) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@/: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase (Text -> GtkDoc
parseGtkDoc Text
raw)
      RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocAfterSymbol Text
haddock

-- | Write the documentation for the given return value.
writeReturnDocumentation :: Callable -> Bool -> CodeGen ()
writeReturnDocumentation :: Callable -> Bool -> CodeGen ()
writeReturnDocumentation callable :: Callable
callable skip :: Bool
skip = do
  Map CRef Hyperlink
c2h <- BaseCodeGen e (Map CRef Hyperlink)
CodeGen (Map CRef Hyperlink)
getC2HMap
  Text
docBase <- BaseCodeGen e Text
CodeGen Text
getDocBase
  let returnValInfo :: [Text]
returnValInfo = if Bool
skip
                      then []
                      else case Documentation -> Maybe Text
rawDocText (Callable -> Documentation
returnDocumentation Callable
callable) of
                             Nothing -> []
                             Just raw :: Text
raw -> ["__Returns:__ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                           Map CRef Hyperlink -> Text -> GtkDoc -> Text
formatHaddock Map CRef Hyperlink
c2h Text
docBase
                                           (Text -> GtkDoc
parseGtkDoc Text
raw)]
      throwsInfo :: [Text]
throwsInfo = if Callable -> Bool
callableThrows Callable
callable
                   then ["/(Can throw 'Data.GI.Base.GError.GError')/"]
                   else []
  let fullInfo :: Text
fullInfo = Text -> [Text] -> Text
T.intercalate " " ([Text]
returnValInfo [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
throwsInfo)
  Bool
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
fullInfo) (ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ())
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) ()
forall a b. (a -> b) -> a -> b
$
    RelativeDocPosition -> Text -> CodeGen ()
writeHaddock RelativeDocPosition
DocAfterSymbol Text
fullInfo

-- | Add the given text to the documentation for the section being generated.
addSectionDocumentation :: HaddockSection -> Documentation -> CodeGen ()
addSectionDocumentation :: HaddockSection -> Documentation -> CodeGen ()
addSectionDocumentation section :: HaddockSection
section doc :: Documentation
doc = do
  Map CRef Hyperlink
c2h <- BaseCodeGen e (Map CRef Hyperlink)
CodeGen (Map CRef Hyperlink)
getC2HMap
  Text
docBase <- BaseCodeGen e Text
CodeGen Text
getDocBase
  let formatted :: Text
formatted = Map CRef Hyperlink -> Text -> Documentation -> Text
formatDocumentation Map CRef Hyperlink
c2h Text
docBase Documentation
doc
  HaddockSection -> Text -> CodeGen ()
addSectionFormattedDocs HaddockSection
section Text
formatted