-- | A parser for gtk-doc formatted documentation, see
-- https://developer.gnome.org/gtk-doc-manual/ for the spec.
module Data.GI.CodeGen.GtkDoc
  ( parseGtkDoc
  , GtkDoc(..)
  , Token(..)
  , Language(..)
  , Link(..)
  , CRef(..)
  , DocSymbolName(..)
  , docName
  , resolveDocSymbol
  ) where

import Prelude hiding (takeWhile)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*))
#endif
import Control.Applicative ((<|>))
import Control.Monad (forM, guard, when)
import Data.Either (isRight)
#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>))
#endif

import Data.GI.CodeGen.Util (terror)
import Data.GI.GIR.BasicTypes (Name(Name))

import Data.Attoparsec.Text
import Data.Char (isAlphaNum, isAlpha, isAscii, isDigit)
import qualified Data.Text as T
import Data.Text (Text)

-- | A parsed gtk-doc token.
data Token = Literal Text
           | Comment Text
           | Verbatim Text
           | CodeBlock (Maybe Language) Text
           | ExternalLink Link
           | Image Link
           | UnnumberedList [GtkDoc]
           -- ^ An unnumbered list of items.
           | NumberedList [(Text, GtkDoc)]
           -- ^ A list of numbered list items. The first element in
           -- the pair is the index.
           | SectionHeader Int GtkDoc -- ^ A section header of the given depth.
           | SymbolRef CRef
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq)

-- | A link to a resource, either offline or a section of the documentation.
data Link = Link { Link -> Text
linkName :: Text
                 , Link -> Text
linkAddress :: Text }
  deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Link -> ShowS
showsPrec :: Int -> Link -> ShowS
$cshow :: Link -> String
show :: Link -> String
$cshowList :: [Link] -> ShowS
showList :: [Link] -> ShowS
Show, Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
/= :: Link -> Link -> Bool
Eq)

-- | The language for an embedded code block.
newtype Language = Language Text
  deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq)

-- | A reference to some symbol in the API.
data CRef = FunctionRef DocSymbolName
          | OldFunctionRef Text
          | MethodRef DocSymbolName Text
          | ParamRef Text
          | ConstantRef Text
          | SignalRef DocSymbolName Text
          | OldSignalRef Text Text
          | LocalSignalRef Text
          | PropertyRef DocSymbolName Text
          | OldPropertyRef Text Text
          | VMethodRef Text Text
          | VFuncRef DocSymbolName Text
          | StructFieldRef Text Text
          | EnumMemberRef DocSymbolName Text
          | CTypeRef Text
          | TypeRef DocSymbolName
          deriving (Int -> CRef -> ShowS
[CRef] -> ShowS
CRef -> String
(Int -> CRef -> ShowS)
-> (CRef -> String) -> ([CRef] -> ShowS) -> Show CRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRef -> ShowS
showsPrec :: Int -> CRef -> ShowS
$cshow :: CRef -> String
show :: CRef -> String
$cshowList :: [CRef] -> ShowS
showList :: [CRef] -> ShowS
Show, CRef -> CRef -> Bool
(CRef -> CRef -> Bool) -> (CRef -> CRef -> Bool) -> Eq CRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRef -> CRef -> Bool
== :: CRef -> CRef -> Bool
$c/= :: CRef -> CRef -> Bool
/= :: CRef -> CRef -> Bool
Eq, Eq CRef
Eq CRef =>
(CRef -> CRef -> Ordering)
-> (CRef -> CRef -> Bool)
-> (CRef -> CRef -> Bool)
-> (CRef -> CRef -> Bool)
-> (CRef -> CRef -> Bool)
-> (CRef -> CRef -> CRef)
-> (CRef -> CRef -> CRef)
-> Ord CRef
CRef -> CRef -> Bool
CRef -> CRef -> Ordering
CRef -> CRef -> CRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CRef -> CRef -> Ordering
compare :: CRef -> CRef -> Ordering
$c< :: CRef -> CRef -> Bool
< :: CRef -> CRef -> Bool
$c<= :: CRef -> CRef -> Bool
<= :: CRef -> CRef -> Bool
$c> :: CRef -> CRef -> Bool
> :: CRef -> CRef -> Bool
$c>= :: CRef -> CRef -> Bool
>= :: CRef -> CRef -> Bool
$cmax :: CRef -> CRef -> CRef
max :: CRef -> CRef -> CRef
$cmin :: CRef -> CRef -> CRef
min :: CRef -> CRef -> CRef
Ord)

-- | Reference to a name (of a class, for instance) in the
-- documentation. It can be either relative to the module where the
-- documentation is, of in some other namespace.
data DocSymbolName = RelativeName Text
                     -- ^ The symbol without a namespace specified
                   | AbsoluteName Text Text
                     -- ^ Namespace and symbol
  deriving (Int -> DocSymbolName -> ShowS
[DocSymbolName] -> ShowS
DocSymbolName -> String
(Int -> DocSymbolName -> ShowS)
-> (DocSymbolName -> String)
-> ([DocSymbolName] -> ShowS)
-> Show DocSymbolName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocSymbolName -> ShowS
showsPrec :: Int -> DocSymbolName -> ShowS
$cshow :: DocSymbolName -> String
show :: DocSymbolName -> String
$cshowList :: [DocSymbolName] -> ShowS
showList :: [DocSymbolName] -> ShowS
Show, DocSymbolName -> DocSymbolName -> Bool
(DocSymbolName -> DocSymbolName -> Bool)
-> (DocSymbolName -> DocSymbolName -> Bool) -> Eq DocSymbolName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocSymbolName -> DocSymbolName -> Bool
== :: DocSymbolName -> DocSymbolName -> Bool
$c/= :: DocSymbolName -> DocSymbolName -> Bool
/= :: DocSymbolName -> DocSymbolName -> Bool
Eq, Eq DocSymbolName
Eq DocSymbolName =>
(DocSymbolName -> DocSymbolName -> Ordering)
-> (DocSymbolName -> DocSymbolName -> Bool)
-> (DocSymbolName -> DocSymbolName -> Bool)
-> (DocSymbolName -> DocSymbolName -> Bool)
-> (DocSymbolName -> DocSymbolName -> Bool)
-> (DocSymbolName -> DocSymbolName -> DocSymbolName)
-> (DocSymbolName -> DocSymbolName -> DocSymbolName)
-> Ord DocSymbolName
DocSymbolName -> DocSymbolName -> Bool
DocSymbolName -> DocSymbolName -> Ordering
DocSymbolName -> DocSymbolName -> DocSymbolName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DocSymbolName -> DocSymbolName -> Ordering
compare :: DocSymbolName -> DocSymbolName -> Ordering
$c< :: DocSymbolName -> DocSymbolName -> Bool
< :: DocSymbolName -> DocSymbolName -> Bool
$c<= :: DocSymbolName -> DocSymbolName -> Bool
<= :: DocSymbolName -> DocSymbolName -> Bool
$c> :: DocSymbolName -> DocSymbolName -> Bool
> :: DocSymbolName -> DocSymbolName -> Bool
$c>= :: DocSymbolName -> DocSymbolName -> Bool
>= :: DocSymbolName -> DocSymbolName -> Bool
$cmax :: DocSymbolName -> DocSymbolName -> DocSymbolName
max :: DocSymbolName -> DocSymbolName -> DocSymbolName
$cmin :: DocSymbolName -> DocSymbolName -> DocSymbolName
min :: DocSymbolName -> DocSymbolName -> DocSymbolName
Ord)

-- | A parsed gtk-doc with fully resolved references.
newtype GtkDoc = GtkDoc [Token]
  deriving (Int -> GtkDoc -> ShowS
[GtkDoc] -> ShowS
GtkDoc -> String
(Int -> GtkDoc -> ShowS)
-> (GtkDoc -> String) -> ([GtkDoc] -> ShowS) -> Show GtkDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GtkDoc -> ShowS
showsPrec :: Int -> GtkDoc -> ShowS
$cshow :: GtkDoc -> String
show :: GtkDoc -> String
$cshowList :: [GtkDoc] -> ShowS
showList :: [GtkDoc] -> ShowS
Show, GtkDoc -> GtkDoc -> Bool
(GtkDoc -> GtkDoc -> Bool)
-> (GtkDoc -> GtkDoc -> Bool) -> Eq GtkDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GtkDoc -> GtkDoc -> Bool
== :: GtkDoc -> GtkDoc -> Bool
$c/= :: GtkDoc -> GtkDoc -> Bool
/= :: GtkDoc -> GtkDoc -> Bool
Eq)

-- | Parse the given gtk-doc formatted documentation.
--
-- === __Examples__
-- >>> parseGtkDoc ""
-- GtkDoc []
--
-- >>> parseGtkDoc "func()"
-- GtkDoc [SymbolRef (OldFunctionRef "func")]
--
-- >>> parseGtkDoc "literal"
-- GtkDoc [Literal "literal"]
--
-- >>> parseGtkDoc "This is a long literal"
-- GtkDoc [Literal "This is a long literal"]
--
-- >>> parseGtkDoc "Call foo() for free cookies"
-- GtkDoc [Literal "Call ",SymbolRef (OldFunctionRef "foo"),Literal " for free cookies"]
--
-- >>> parseGtkDoc "The signal ::activate is related to gtk_button_activate()."
-- GtkDoc [Literal "The signal ",SymbolRef (LocalSignalRef "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."]
--
-- >>> parseGtkDoc "The signal ##%#GtkButton::activate is related to gtk_button_activate()."
-- GtkDoc [Literal "The signal ##%",SymbolRef (OldSignalRef "GtkButton" "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."]
--
-- >>> parseGtkDoc "# A section\n\n## and a subsection ##\n"
-- GtkDoc [SectionHeader 1 (GtkDoc [Literal "A section"]),Literal "\n",SectionHeader 2 (GtkDoc [Literal "and a subsection "])]
--
-- >>> parseGtkDoc "Compact list:\n- First item\n- Second item"
-- GtkDoc [Literal "Compact list:\n",UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]]
--
-- >>> parseGtkDoc "Spaced list:\n\n- First item\n\n- Second item"
-- GtkDoc [Literal "Spaced list:\n\n",UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]]
--
-- >>> parseGtkDoc "List with urls:\n- [test](http://test)\n- ![](image.png)"
-- GtkDoc [Literal "List with urls:\n",UnnumberedList [GtkDoc [ExternalLink (Link {linkName = "test", linkAddress = "http://test"})],GtkDoc [Image (Link {linkName = "", linkAddress = "image.png"})]]]
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc Text
doc = Text -> GtkDoc
rawParseGtkDoc (Char -> Text -> Text
T.cons Char
startOfString Text
doc)

-- | Like `parseGtkDoc`, but it does not annotate beginning of lines.
rawParseGtkDoc :: Text -> GtkDoc
rawParseGtkDoc :: Text -> GtkDoc
rawParseGtkDoc Text
raw =
  case Parser [Token] -> Text -> Either String [Token]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser [Token]
parseTokens Parser [Token] -> Parser Text () -> Parser [Token]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
raw of
    Left String
e ->
      Text -> GtkDoc
forall a. HasCallStack => Text -> a
terror (Text -> GtkDoc) -> Text -> GtkDoc
forall a b. (a -> b) -> a -> b
$ Text
"gtk-doc parsing failed with error \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" on the input \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (Char -> Text
T.singleton Char
startOfString) Text
"" Text
raw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
    Right [Token]
tks -> [Token] -> GtkDoc
GtkDoc ([Token] -> GtkDoc) -> ([Token] -> [Token]) -> [Token] -> GtkDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
coalesceLiterals ([Token] -> [Token]) -> ([Token] -> [Token]) -> [Token] -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
removeSOS ([Token] -> GtkDoc) -> [Token] -> GtkDoc
forall a b. (a -> b) -> a -> b
$ [Token]
tks

-- | A character indicating the start of the string, to simplify the
-- GtkDoc parser (part of the syntax is sensitive to the start of
-- lines, which we can represent as any character after '\n' or SOS).
startOfString :: Char
startOfString :: Char
startOfString = Char
'\x98' -- Unicode Start Of String (SOS)

-- | Remove the SOS marker from the input. Since this only appears at
-- the beginning of the text, we only need to worry about replacing it
-- in the first token, and only if it's a literal.
removeSOS :: [Token] -> [Token]
removeSOS :: [Token] -> [Token]
removeSOS [] = []
removeSOS (Literal Text
l : [Token]
rest) =
  if Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Text
T.singleton Char
startOfString
  then [Token]
rest
  else Text -> Token
Literal (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (Char -> Text
T.singleton Char
startOfString) Text
"" Text
l) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
rest
removeSOS (Token
other : [Token]
rest) = Token
other Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
rest

-- | Accumulate consecutive literals into a single literal.
coalesceLiterals :: [Token] -> [Token]
coalesceLiterals :: [Token] -> [Token]
coalesceLiterals [Token]
tks = Maybe Text -> [Token] -> [Token]
go Maybe Text
forall a. Maybe a
Nothing [Token]
tks
  where
    go :: Maybe Text -> [Token] -> [Token]
    go :: Maybe Text -> [Token] -> [Token]
go Maybe Text
Nothing  [] = []
    go (Just Text
l) [] = [Text -> Token
Literal Text
l]
    go Maybe Text
Nothing (Literal Text
l : [Token]
rest) = Maybe Text -> [Token] -> [Token]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l) [Token]
rest
    go (Just Text
l) (Literal Text
l' : [Token]
rest) = Maybe Text -> [Token] -> [Token]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l')) [Token]
rest
    go Maybe Text
Nothing (Token
tk : [Token]
rest) = Token
tk Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Text -> [Token] -> [Token]
go Maybe Text
forall a. Maybe a
Nothing [Token]
rest
    go (Just Text
l) (Token
tk : [Token]
rest) = Text -> Token
Literal Text
l Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
tk Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Maybe Text -> [Token] -> [Token]
go Maybe Text
forall a. Maybe a
Nothing [Token]
rest

-- | Parser for tokens.
parseTokens :: Parser [Token]
parseTokens :: Parser [Token]
parseTokens = Parser [Token]
headerAndTokens Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
justTokens
  where -- In case the input starts by a section header.
        headerAndTokens :: Parser [Token]
        headerAndTokens :: Parser [Token]
headerAndTokens = do
          header <- Parser [Token]
parseInitialSectionHeader
          tokens <- justTokens
          return (header <> tokens)

        justTokens :: Parser [Token]
        justTokens :: Parser [Token]
justTokens = [[Token]] -> [Token]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Token]] -> [Token]) -> Parser Text [[Token]] -> Parser [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Token] -> Parser Text [[Token]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser [Token]
parseToken

-- | Parse a single token. This can sometimes return more than a
-- single token, when parsing a logical token produces multiple output
-- tokens (for example when keeping the initial structure requires
-- adding together literals and other tokens).
--
-- === __Examples__
-- >>> parseOnly (parseToken <* endOfInput) "func()"
-- Right [SymbolRef (OldFunctionRef "func")]
parseToken :: Parser [Token]
parseToken :: Parser [Token]
parseToken = -- Note that the parsers overlap, so this is not as
             -- efficient as it could be (if we had combined parsers
             -- and then branched, so that there is no
             -- backtracking). But speed is not an issue here, so for
             -- clarity we keep the parsers distinct. The exception
             -- is parseFunctionRef, since it does not complicate the
             -- parser much, and it is the main source of
             -- backtracking.
                 Parser [Token]
parseFunctionRef
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseMethod
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseConstructor
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseSignal
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseId
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseLocalSignal
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseProperty
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseVMethod
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseStructField
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseClass
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseCType
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseConstant
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseEnumMember
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseParam
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseEscaped
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseCodeBlock
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseVerbatim
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseUrl
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseImage
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseSectionHeader
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseUnnumberedList
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseNumberedList
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseComment
             Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseBoringLiteral

-- | Whether the given character is valid in a C identifier.
isCIdent :: Char -> Bool
isCIdent :: Char -> Bool
isCIdent Char
'_' = Bool
True
isCIdent Char
c   = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c

-- | Something that could be a valid C identifier (loosely speaking,
-- we do not need to be too strict here).
parseCIdent :: Parser Text
parseCIdent :: Parser Text
parseCIdent = (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent

-- | Parse a function ref
parseFunctionRef :: Parser [Token]
parseFunctionRef :: Parser [Token]
parseFunctionRef = Parser [Token]
parseOldFunctionRef Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseNewFunctionRef

-- | Parse an unresolved reference to a C symbol in new gtk-doc notation.
parseId :: Parser [Token]
parseId :: Parser [Token]
parseId = do
  _ <- Text -> Parser Text
string Text
"[id@"
  ident <- parseCIdent
  _ <- char ']'
  return [SymbolRef (OldFunctionRef ident)]

-- | Parse a function ref, given by a valid C identifier followed by
-- '()', for instance 'gtk_widget_show()'. If the identifier is not
-- followed by "()", return it as a literal instead.
--
-- === __Examples__
-- >>> parseOnly (parseFunctionRef <* endOfInput) "test_func()"
-- Right [SymbolRef (OldFunctionRef "test_func")]
--
-- >>> parseOnly (parseFunctionRef <* endOfInput) "not_a_func"
-- Right [Literal "not_a_func"]
parseOldFunctionRef :: Parser [Token]
parseOldFunctionRef :: Parser [Token]
parseOldFunctionRef = do
  ident <- Parser Text
parseCIdent
  option [Literal ident] (string "()" >>
                          return [SymbolRef (OldFunctionRef ident)])

-- | Parse a function name in new style, of the form
-- > [func@Namespace.c_func_name]
--
-- === __Examples__
-- >>> parseOnly (parseFunctionRef <* endOfInput) "[func@Gtk.init]"
-- Right [SymbolRef (FunctionRef (AbsoluteName "Gtk" "init"))]
parseNewFunctionRef :: Parser [Token]
parseNewFunctionRef :: Parser [Token]
parseNewFunctionRef = do
  _ <- Text -> Parser Text
string Text
"[func@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- takeWhile1 isCIdent
  _ <- char ']'
  return [SymbolRef $ FunctionRef (AbsoluteName ns n)]

-- | Parse a method name, of the form
-- > [method@Namespace.Object.c_func_name]
--
-- === __Examples__
-- >>> parseOnly (parseMethod <* endOfInput) "[method@Gtk.Button.set_child]"
-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Button") "set_child")]
--
-- >>> parseOnly (parseMethod <* endOfInput) "[func@Gtk.Settings.get_for_display]"
-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Settings") "get_for_display")]
parseMethod :: Parser [Token]
parseMethod :: Parser [Token]
parseMethod = do
  _ <- Text -> Parser Text
string Text
"[method@" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"[func@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- takeWhile1 isCIdent
  _ <- char '.'
  method <- takeWhile1 isCIdent
  _ <- char ']'
  return [SymbolRef $ MethodRef (AbsoluteName ns n) method]

-- | Parse a reference to a constructor, of the form
-- > [ctor@Namespace.Object.c_func_name]
--
-- === __Examples__
-- >>> parseOnly (parseConstructor <* endOfInput) "[ctor@Gtk.Builder.new_from_file]"
-- Right [SymbolRef (MethodRef (AbsoluteName "Gtk" "Builder") "new_from_file")]
parseConstructor :: Parser [Token]
parseConstructor :: Parser [Token]
parseConstructor = do
  _ <- Text -> Parser Text
string Text
"[ctor@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- takeWhile1 isCIdent
  _ <- char '.'
  method <- takeWhile1 isCIdent
  _ <- char ']'
  return [SymbolRef $ MethodRef (AbsoluteName ns n) method]

-- | Parse a reference to a type, of the form
-- > [class@Namespace.Name]
-- an interface of the form
-- > [iface@Namespace.Name]
-- or an enumeration type, of the form
-- > [enum@Namespace.Name]
--
-- === __Examples__
-- >>> parseOnly (parseClass <* endOfInput) "[class@Gtk.Dialog]"
-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "Dialog"))]
--
-- >>> parseOnly (parseClass <* endOfInput) "[iface@Gtk.Editable]"
-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "Editable"))]
--
-- >>> parseOnly (parseClass <* endOfInput) "[enum@Gtk.SizeRequestMode]"
-- Right [SymbolRef (TypeRef (AbsoluteName "Gtk" "SizeRequestMode"))]
--
-- >>> parseOnly (parseClass <* endOfInput) "[struct@GLib.Variant]"
-- Right [SymbolRef (TypeRef (AbsoluteName "GLib" "Variant"))]
parseClass :: Parser [Token]
parseClass :: Parser [Token]
parseClass = do
  _ <- Text -> Parser Text
string Text
"[class@" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"[iface@" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       Text -> Parser Text
string Text
"[enum@" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"[struct@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- takeWhile1 isCIdent
  _ <- char ']'
  return [SymbolRef $ TypeRef (AbsoluteName ns n)]

-- | Parse a reference to a member of the enum, of the form
-- > [enum@Gtk.FontRendering.AUTOMATIC]
--
-- === __Examples__
-- >>> parseOnly (parseEnumMember <* endOfInput) "[enum@Gtk.FontRendering.AUTOMATIC]"
-- Right [SymbolRef (EnumMemberRef (AbsoluteName "Gtk" "FontRendering") "automatic")]
parseEnumMember :: Parser [Token]
parseEnumMember :: Parser [Token]
parseEnumMember = do
  _ <- Text -> Parser Text
string Text
"[enum@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- takeWhile1 isCIdent
  _ <- char '.'
  member <- takeWhile1 isCIdent
  _ <- char ']'
  -- Sometimes the references are written in uppercase while the name
  -- of the member in the introspection data is written in lowercase,
  -- so normalise everything to lowercase. (See the similar annotation
  -- in CtoHaskellMap.hs.)
  return [SymbolRef $ EnumMemberRef (AbsoluteName ns n) (T.toLower member)]

parseSignal :: Parser [Token]
parseSignal :: Parser [Token]
parseSignal = Parser [Token]
parseOldSignal Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseNewSignal

-- | Parse an old style signal name, of the form
-- > #Object::signal
--
-- === __Examples__
-- >>> parseOnly (parseOldSignal <* endOfInput) "#GtkButton::activate"
-- Right [SymbolRef (OldSignalRef "GtkButton" "activate")]
parseOldSignal :: Parser [Token]
parseOldSignal :: Parser [Token]
parseOldSignal = do
  _ <- Char -> Parser Char
char Char
'#'
  obj <- parseCIdent
  _ <- string "::"
  signal <- signalOrPropName
  return [SymbolRef (OldSignalRef obj signal)]

-- | Parse a new style signal ref, of the form
-- > [signal@Namespace.Object::signal-name]
--
-- === __Examples__
-- >>> parseOnly (parseNewSignal <* endOfInput) "[signal@Gtk.AboutDialog::activate-link]"
-- Right [SymbolRef (SignalRef (AbsoluteName "Gtk" "AboutDialog") "activate-link")]
parseNewSignal :: Parser [Token]
parseNewSignal :: Parser [Token]
parseNewSignal = do
  _ <- Text -> Parser Text
string Text
"[signal@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- parseCIdent
  _ <- string "::"
  signal <- takeWhile1 (\Char
c -> (Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
  _ <- char ']'
  return [SymbolRef (SignalRef (AbsoluteName ns n) signal)]

-- | Parse a reference to a signal defined in the current module, of the form
-- > ::signal
--
-- === __Examples__
-- >>> parseOnly (parseLocalSignal <* endOfInput) "::activate"
-- Right [SymbolRef (LocalSignalRef "activate")]
parseLocalSignal :: Parser [Token]
parseLocalSignal :: Parser [Token]
parseLocalSignal = do
  _ <- Text -> Parser Text
string Text
"::"
  signal <- signalOrPropName
  return [SymbolRef (LocalSignalRef signal)]

-- | Parse a property name in the old style, of the form
-- > #Object:property
--
-- === __Examples__
-- >>> parseOnly (parseOldProperty <* endOfInput) "#GtkButton:always-show-image"
-- Right [SymbolRef (OldPropertyRef "GtkButton" "always-show-image")]
parseOldProperty :: Parser [Token]
parseOldProperty :: Parser [Token]
parseOldProperty = do
  _ <- Char -> Parser Char
char Char
'#'
  obj <- parseCIdent
  _ <- char ':'
  property <- signalOrPropName
  return [SymbolRef (OldPropertyRef obj property)]

-- | Parse a property name in the new style:
-- > [property@Namespace.Object:property-name]
--
-- === __Examples__
-- >>> parseOnly (parseNewProperty <* endOfInput) "[property@Gtk.ProgressBar:show-text]"
-- Right [SymbolRef (PropertyRef (AbsoluteName "Gtk" "ProgressBar") "show-text")]
-- >>> parseOnly (parseNewProperty <* endOfInput) "[property@Gtk.Editable:width-chars]"
-- Right [SymbolRef (PropertyRef (AbsoluteName "Gtk" "Editable") "width-chars")]
parseNewProperty :: Parser [Token]
parseNewProperty :: Parser [Token]
parseNewProperty = do
  _ <- Text -> Parser Text
string Text
"[property@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- parseCIdent
  _ <- char ':'
  property <- takeWhile1 (\Char
c -> (Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
  _ <- char ']'
  return [SymbolRef (PropertyRef (AbsoluteName ns n) property)]

-- | Parse a property
parseProperty :: Parser [Token]
parseProperty :: Parser [Token]
parseProperty = Parser [Token]
parseOldProperty Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseNewProperty

-- | Parse an xml comment, of the form
-- > <!-- comment -->
-- Note that this function keeps spaces.
--
-- === __Examples__
-- >>> parseOnly (parseComment <* endOfInput) "<!-- comment -->"
-- Right [Comment " comment "]
parseComment :: Parser [Token]
parseComment :: Parser [Token]
parseComment = do
  comment <- Text -> Parser Text
string Text
"<!--" Parser Text -> Parser Text String -> Parser Text String
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"-->")
  return [Comment $ T.pack comment]

-- | Parse an old style reference to a virtual method, of the form
-- > #Struct.method()
--
-- === __Examples__
-- >>> parseOnly (parseOldVMethod <* endOfInput) "#Foo.bar()"
-- Right [SymbolRef (VMethodRef "Foo" "bar")]
parseOldVMethod :: Parser [Token]
parseOldVMethod :: Parser [Token]
parseOldVMethod = do
  _ <- Char -> Parser Char
char Char
'#'
  obj <- parseCIdent
  _ <- char '.'
  method <- parseCIdent
  _ <- string "()"
  return [SymbolRef (VMethodRef obj method)]

-- | Parse a new style reference to a virtual function, of the form
-- > [vfunc@Namespace.Object.vfunc_name]
--
-- >>> parseOnly (parseVFunc <* endOfInput) "[vfunc@Gtk.Widget.get_request_mode]"
-- Right [SymbolRef (VFuncRef (AbsoluteName "Gtk" "Widget") "get_request_mode")]
parseVFunc :: Parser [Token]
parseVFunc :: Parser [Token]
parseVFunc = do
  _ <- Text -> Parser Text
string Text
"[vfunc@"
  ns <- takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  _ <- char '.'
  n <- parseCIdent
  _ <- char '.'
  vfunc <- parseCIdent
  _ <- char ']'
  return [SymbolRef (VFuncRef (AbsoluteName ns n) vfunc)]

-- | Parse a reference to a virtual method
parseVMethod :: Parser [Token]
parseVMethod :: Parser [Token]
parseVMethod = Parser [Token]
parseOldVMethod Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseVFunc

-- | Parse a reference to a struct field, of the form
-- > #Struct.field
--
-- === __Examples__
-- >>> parseOnly (parseStructField <* endOfInput) "#Foo.bar"
-- Right [SymbolRef (StructFieldRef "Foo" "bar")]
parseStructField :: Parser [Token]
parseStructField :: Parser [Token]
parseStructField = do
  _ <- Char -> Parser Char
char Char
'#'
  obj <- parseCIdent
  _ <- char '.'
  field <- parseCIdent
  return [SymbolRef (StructFieldRef obj field)]

-- | Parse a reference to a C type, of the form
-- > #Type
--
-- === __Examples__
-- >>> parseOnly (parseCType <* endOfInput) "#Foo"
-- Right [SymbolRef (CTypeRef "Foo")]
parseCType :: Parser [Token]
parseCType :: Parser [Token]
parseCType = do
  _ <- Char -> Parser Char
char Char
'#'
  obj <- parseCIdent
  return [SymbolRef (CTypeRef obj)]

-- | Parse a constant, of the form
-- > %CONSTANT_NAME
--
-- === __Examples__
-- >>> parseOnly (parseConstant <* endOfInput) "%TEST_CONSTANT"
-- Right [SymbolRef (ConstantRef "TEST_CONSTANT")]
parseConstant :: Parser [Token]
parseConstant :: Parser [Token]
parseConstant = do
  _ <- Char -> Parser Char
char Char
'%'
  c <- parseCIdent
  return [SymbolRef (ConstantRef c)]

-- | Parse a reference to a parameter, of the form
-- > @param_name
--
-- === __Examples__
-- >>> parseOnly (parseParam <* endOfInput) "@test_param"
-- Right [SymbolRef (ParamRef "test_param")]
parseParam :: Parser [Token]
parseParam :: Parser [Token]
parseParam = do
  _ <- Char -> Parser Char
char Char
'@'
  param <- parseCIdent
  return [SymbolRef (ParamRef param)]

-- | Name of a signal or property name. Similar to a C identifier, but
-- hyphens are allowed too.
signalOrPropName :: Parser Text
signalOrPropName :: Parser Text
signalOrPropName = (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isSignalOrPropIdent
  where isSignalOrPropIdent :: Char -> Bool
        isSignalOrPropIdent :: Char -> Bool
isSignalOrPropIdent Char
'-' = Bool
True
        isSignalOrPropIdent Char
c = Char -> Bool
isCIdent Char
c

-- | Parse a escaped special character, i.e. one preceded by '\'.
parseEscaped :: Parser [Token]
parseEscaped :: Parser [Token]
parseEscaped = do
  _ <- Char -> Parser Char
char Char
'\\'
  c <- satisfy (`elem` ("#@%\\`" :: [Char]))
  return [Literal (T.singleton c)]

-- | Parse a literal, i.e. anything without a known special
-- meaning. Note that this parser always consumes the first character,
-- regardless of what it is.
parseBoringLiteral :: Parser [Token]
parseBoringLiteral :: Parser [Token]
parseBoringLiteral = do
  c <- Parser Char
anyChar
  boring <- takeWhile (not . special)
  return [Literal (T.cons c boring)]

-- | List of special characters from the point of view of the parser
-- (in the sense that they may be the beginning of something with a
-- special interpretation).
special :: Char -> Bool
special :: Char -> Bool
special Char
'#' = Bool
True
special Char
'@' = Bool
True
special Char
'%' = Bool
True
special Char
'\\' = Bool
True
special Char
'`' = Bool
True
special Char
'|' = Bool
True
special Char
'[' = Bool
True
special Char
'!' = Bool
True
special Char
'\n' = Bool
True
special Char
':' = Bool
True
special Char
'-' = Bool
True
special Char
c = Char -> Bool
isCIdent Char
c

-- | Parse a verbatim string, of the form
-- > `verbatim text`
--
-- === __Examples__
-- >>> parseOnly (parseVerbatim <* endOfInput) "`Example quote!`"
-- Right [Verbatim "Example quote!"]
parseVerbatim :: Parser [Token]
parseVerbatim :: Parser [Token]
parseVerbatim = do
  _ <- Char -> Parser Char
char Char
'`'
  v <- takeWhile1 (/= '`')
  _ <- char '`'
  return [Verbatim v]

-- | Parse a URL in Markdown syntax, of the form
-- > [name](url)
--
-- === __Examples__
-- >>> parseOnly (parseUrl <* endOfInput) "[haskell](http://haskell.org)"
-- Right [ExternalLink (Link {linkName = "haskell", linkAddress = "http://haskell.org"})]
parseUrl :: Parser [Token]
parseUrl :: Parser [Token]
parseUrl = do
  _ <- Char -> Parser Char
char Char
'['
  name <- takeWhile1 (/= ']')
  _ <- string "]("
  address <- takeWhile1 (/= ')')
  _ <- char ')'
  return [ExternalLink $ Link {linkName = name, linkAddress = address}]

-- | Parse an image reference, of the form
-- > ![label](url)
--
-- === __Examples__
-- >>> parseOnly (parseImage <* endOfInput) "![](diagram.png)"
-- Right [Image (Link {linkName = "", linkAddress = "diagram.png"})]
parseImage :: Parser [Token]
parseImage :: Parser [Token]
parseImage = do
  _ <- Text -> Parser Text
string Text
"!["
  name <- takeWhile (/= ']')
  _ <- string "]("
  address <- takeWhile1 (/= ')')
  _ <- char ')'
  return [Image $ Link {linkName = name, linkAddress = address}]

-- | Parse a code block embedded in the documentation.
parseCodeBlock :: Parser [Token]
parseCodeBlock :: Parser [Token]
parseCodeBlock = Parser [Token]
parseOldStyleCodeBlock Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
parseNewStyleCodeBlock

-- | Parse a new style code block, of the form
-- > ```c
-- > some c code
-- > ```
--
-- === __Examples__
-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "```c\nThis is C code\n```"
-- Right [CodeBlock (Just (Language "c")) "This is C code"]
--
-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "```\nThis is langless\n```"
-- Right [CodeBlock Nothing "This is langless"]
--
-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "   ```py\n   This has space in front\n   ```"
-- Right [CodeBlock (Just (Language "py")) "   This has space in front"]
--
-- >>> parseOnly (parseNewStyleCodeBlock <* endOfInput) "   ```c\n   new_type_id = g_type_register_dynamic (parent_type_id,\n                                          \"TypeName\",\n                                          new_type_plugin,\n                                          type_flags);\n   ```"
-- Right [CodeBlock (Just (Language "c")) "   new_type_id = g_type_register_dynamic (parent_type_id,\n                                          \"TypeName\",\n                                          new_type_plugin,\n                                          type_flags);"]
parseNewStyleCodeBlock :: Parser [Token]
parseNewStyleCodeBlock :: Parser [Token]
parseNewStyleCodeBlock = do
  _ <- (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isHorizontalSpace
  _ <- string "```"
  lang <- T.strip <$> takeWhile (/= '\n')
  _ <- char '\n'
  let maybeLang = if Text -> Bool
T.null Text
lang then Maybe Text
forall a. Maybe a
Nothing
                  else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
lang
  code <- T.pack <$> manyTill anyChar (string "\n" >>
                                       takeWhile isHorizontalSpace >>
                                       string "```")
  return [CodeBlock (Language <$> maybeLang) code]

-- | Parse an old style code block, of the form
-- > |[<!-- language="C" --> code ]|
--
-- === __Examples__
-- >>> parseOnly (parseOldStyleCodeBlock <* endOfInput) "|[this is code]|"
-- Right [CodeBlock Nothing "this is code"]
--
-- >>> parseOnly (parseOldStyleCodeBlock <* endOfInput) "|[<!-- language=\"C\"-->this is C code]|"
-- Right [CodeBlock (Just (Language "C")) "this is C code"]
parseOldStyleCodeBlock :: Parser [Token]
parseOldStyleCodeBlock :: Parser [Token]
parseOldStyleCodeBlock = do
  _ <- Text -> Parser Text
string Text
"|["
  lang <- (Just <$> parseLanguage) <|> return Nothing
  code <- T.pack <$> manyTill anyChar (string "]|")
  return [CodeBlock lang code]

-- | Parse the language of a code block, specified as a comment.
parseLanguage :: Parser Language
parseLanguage :: Parser Text Language
parseLanguage = do
  _ <- Text -> Parser Text
string Text
"<!--"
  skipSpace
  _ <- string "language=\""
  lang <- takeWhile1 (/= '"')
  _ <- char '"'
  skipSpace
  _ <- string "-->"
  return $ Language lang

-- | Parse at least one newline (or Start of String (SOS)), and keep
-- going while we see newlines. Return either the empty list (for the
-- case that we see a single SOS), or a singleton list with the
-- Literal representing the seen newlines, and removing the SOS.
parseInitialNewlines :: Parser [Token]
parseInitialNewlines :: Parser [Token]
parseInitialNewlines = do
  initial <- Char -> Parser Char
char Char
'\n' Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
startOfString
  let initialString = if Char
initial Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
                      then Text
"\n"
                      else Text
""
  others <- T.pack <$> many' (char '\n')
  let joint = Text
initialString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
others
  if T.null joint
    then return []
    else return [Literal joint]

-- | Parse a section header, given by a number of hash symbols, and
-- then ordinary text. Note that this parser "eats" the newline before
-- and after the section header.
parseSectionHeader :: Parser [Token]
parseSectionHeader :: Parser [Token]
parseSectionHeader = do
  initialNewlines <- Parser [Token]
parseInitialNewlines
  sectionHeader <- parseInitialSectionHeader
  return $ initialNewlines <> sectionHeader

-- | Parse a section header at the beginning of the text. I.e. this is
-- the same as `parseSectionHeader`, but we do not expect a newline as
-- a first character.
--
-- === __Examples__
-- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "### Hello! ###\n"
-- Right [SectionHeader 3 (GtkDoc [Literal "Hello! "])]
--
-- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "# Hello!\n"
-- Right [SectionHeader 1 (GtkDoc [Literal "Hello!"])]
parseInitialSectionHeader :: Parser [Token]
parseInitialSectionHeader :: Parser [Token]
parseInitialSectionHeader = do
  hashes <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
  _ <- many1 space
  heading <- takeWhile1 (notInClass "#\n")
  _ <- (string hashes >> char '\n') <|> (char '\n')
  return [SectionHeader (T.length hashes) (parseGtkDoc heading)]

{- | Parse an unnumbered list.

=== __Examples__
>>> :{
parseOnly (parseUnnumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
T.cons startOfString
"- First item",
"- Second item"
]
:}
Right [UnnumberedList [GtkDoc [Literal "First item"],GtkDoc [Literal "Second item"]]]

>>> :{
parseOnly (parseUnnumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
"",
"",
"- Two line",
"  item",
"",
"- Second item,",
"  with three lines",
"  of text."
]
:}
Right [Literal "\n\n",UnnumberedList [GtkDoc [Literal "Two line\nitem"],GtkDoc [Literal "Second item,\nwith three lines\nof text."]]]
-}
parseUnnumberedList :: Parser [Token]
parseUnnumberedList :: Parser [Token]
parseUnnumberedList = do
  (initialNewlines, entries) <- Parser Text -> (Text -> Int) -> Parser ([Token], [(Text, GtkDoc)])
parseList (Text -> Parser Text
string Text
"- ") Text -> Int
T.length
  return $ initialNewlines <> [UnnumberedList (map snd entries)]

{- | Parse a numbered list header.

=== __Examples__
>>> :{
parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
T.cons startOfString
"1. First item,",
"   written in two lines",
"",
"2. Second item,",
"   also in two lines"
]
:}
Right [NumberedList [("1",GtkDoc [Literal "First item,\nwritten in two lines"]),("2",GtkDoc [Literal "Second item,\nalso in two lines"])]]

>>> :{
parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
T.cons startOfString
"1. First item,",
"   written in two lines",
"2. Second item,",
"   now in three lines,",
"   written compactly"
]
:}
Right [NumberedList [("1",GtkDoc [Literal "First item,\nwritten in two lines"]),("2",GtkDoc [Literal "Second item,\nnow in three lines,\nwritten compactly"])]]

>>> :{
parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
T.cons startOfString
"9. This is a list entry with two lines,",
"   with the second line in its own line.",
"10. If the label width changes,",
"    the indentation of the second line should also be adjusted.",
"",
"11. You can optionally include an empty line between entries",
"    without stopping the list.",
"",
"    This also applies within list entries, this is still part of",
"    entry 11.",
"12. But you don't have to."
]
:}
Right [NumberedList [("9",GtkDoc [Literal "This is a list entry with two lines,\nwith the second line in its own line."]),("10",GtkDoc [Literal "If the label width changes,\nthe indentation of the second line should also be adjusted."]),("11",GtkDoc [Literal "You can optionally include an empty line between entries\nwithout stopping the list.\n\nThis also applies within list entries, this is still part of\nentry 11."]),("12",GtkDoc [Literal "But you don't have to."])]]

>>> :{
parseGtkDoc $ T.stripEnd $ T.unlines [
"1. A list with a single element",
"",
"And this is text not in the list, so we use parseGtkDoc."
]
:}
GtkDoc [NumberedList [("1",GtkDoc [Literal "A list with a single element"])],Literal "\n\nAnd this is text not in the list, so we use parseGtkDoc."]

>>> :{
parseOnly (parseNumberedList <* endOfInput) $ T.stripEnd $ T.unlines [
T.cons startOfString
"1. An example of a list in lenient mode,",
"where we don't require indenting this second line.",
"",
"2. In this mode entries can be optionally separated by an empty line.",
"3. But they don't need to"
]
:}
Right [NumberedList [("1",GtkDoc [Literal "An example of a list in lenient mode,\nwhere we don't require indenting this second line."]),("2",GtkDoc [Literal "In this mode entries can be optionally separated by an empty line."]),("3",GtkDoc [Literal "But they don't need to"])]]
-}
parseNumberedList :: Parser [Token]
parseNumberedList :: Parser [Token]
parseNumberedList = do
  (initialNewlines, list) <- Parser Text -> (Text -> Int) -> Parser ([Token], [(Text, GtkDoc)])
parseList (do idx <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isDigit
                                           _ <- string ". "
                                           return idx)
                                       (\Text
label -> Text -> Int
T.length Text
label Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
  return $ initialNewlines <> [NumberedList list]

{- | The indent parsing mode. In strict mode we require that all the
   text in the lines is indented relative to the label, as in the
   following example:

        1. The first line,
           and the second line

           In this mode we allow empty lines in the entry.
        2. This is the second entry.

   In lenient mode we drop this restriction, so the following is valid:
        1. The first line,
        and the second line
        In this mode we _do not_ allow empty lines in the entry.
        2. This is the second entry.
-}
data IndentParsingMode = Lenient | Strict
  deriving (IndentParsingMode -> IndentParsingMode -> Bool
(IndentParsingMode -> IndentParsingMode -> Bool)
-> (IndentParsingMode -> IndentParsingMode -> Bool)
-> Eq IndentParsingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndentParsingMode -> IndentParsingMode -> Bool
== :: IndentParsingMode -> IndentParsingMode -> Bool
$c/= :: IndentParsingMode -> IndentParsingMode -> Bool
/= :: IndentParsingMode -> IndentParsingMode -> Bool
Eq)

{- | Parse an unnumbered or numbered list. See 'parseNumberedList' and
   'parseUnnumberedList' for examples.
-}
parseList :: Parser Text -> (Text -> Int) ->
                    Parser ([Token], [(Text, GtkDoc)])
parseList :: Parser Text -> (Text -> Int) -> Parser ([Token], [(Text, GtkDoc)])
parseList Parser Text
labelParser Text -> Int
indent =
  IndentParsingMode -> Parser ([Token], [(Text, GtkDoc)])
doParseList IndentParsingMode
Lenient Parser ([Token], [(Text, GtkDoc)])
-> Parser ([Token], [(Text, GtkDoc)])
-> Parser ([Token], [(Text, GtkDoc)])
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IndentParsingMode -> Parser ([Token], [(Text, GtkDoc)])
doParseList IndentParsingMode
Strict
 where
   doParseList :: IndentParsingMode ->
                  Parser ([Token], [(Text, GtkDoc)])
   doParseList :: IndentParsingMode -> Parser ([Token], [(Text, GtkDoc)])
doParseList IndentParsingMode
mode = do
     -- Consume the initial newlines before parseListItem does, so we can
     -- restore the initial newlines after. We impose that there is at
     -- least a newline (or Start of String symbol) before the start of
     -- the list.
     initialNewlines <- Parser [Token]
parseInitialNewlines
     (initialSpace, first) <-
       parseListItem (takeWhile isHorizontalSpace) (pure ())
     -- We allow either one or zero empty lines between entries.
     let newlineParser = (Text -> Parser Text
string Text
"\n\n" Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"\n") Parser Text -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
     rest <- map snd <$>
             many' (parseListItem (string initialSpace) newlineParser)
     -- Validate the resulting entries, and assemble them into GtkDoc.
     validated <- forM (first : rest) $ \(Text
label, (Text
firstLine, [Text]
otherLines)) -> do
       Text -> [Text] -> Parser Text ()
validate Text
label [Text]
otherLines
       (Text, GtkDoc) -> Parser Text (Text, GtkDoc)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
label,
               Text -> GtkDoc
parseGtkDoc (Text -> GtkDoc) -> Text -> GtkDoc
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
firstLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
otherLines)

     return (initialNewlines, validated)

    where
      parseListItem :: Parser Text -> Parser () ->
                         Parser (Text, (Text, (Text, [Text])))
      parseListItem :: Parser Text
-> Parser Text () -> Parser (Text, (Text, (Text, [Text])))
parseListItem Parser Text
parseInitialSpace Parser Text ()
startingNewlines = do
        Parser Text ()
startingNewlines
        initialSpace <- Parser Text
parseInitialSpace
        label <- labelParser
        first <- takeWhile (/= '\n')
        let padding = case IndentParsingMode
mode of
              IndentParsingMode
Strict -> Text
initialSpace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Text -> Int
indent Text
label) Text
" "
              IndentParsingMode
Lenient -> Text
initialSpace
            paddingParser = Text -> Parser Text
string Text
padding

        rest <- many' (parseLine paddingParser)

        return (initialSpace, (label, (first, rest)))

      parseLine :: Parser Text -> Parser Text
      parseLine :: Parser Text -> Parser Text
parseLine Parser Text
paddingParser = do
        emptyLines <- case IndentParsingMode
mode of
          -- We do not allow empty lines in entries in the lenient
          -- indent parser, while the strict indent one allows one
          -- at most.
          IndentParsingMode
Strict -> Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Text
"" Parser Text
emptyLine
          IndentParsingMode
Lenient -> Text -> Parser Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
        _ <- char '\n' >> paddingParser
        contents <- takeWhile1 (/= '\n')
        when (startsWith labelParser contents) $
          fail "Line starting with a label"
        return $ emptyLines <> contents

      emptyLine :: Parser Text
emptyLine = do
        _ <- Char -> Parser Char
char Char
'\n'
        maybeNext <- peekChar
        guard $ maybeNext == Nothing || maybeNext == Just '\n'
        return ("\n" :: Text)

      startsWith :: Parser a -> Text -> Bool
      startsWith :: forall a. Parser a -> Text -> Bool
startsWith Parser a
p Text
l = Either String a -> Bool
forall a b. Either a b -> Bool
isRight (Either String a -> Bool) -> Either String a -> Bool
forall a b. (a -> b) -> a -> b
$ Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly Parser a
p Text
l

      validate :: Text -> [Text] -> Parser ()
      validate :: Text -> [Text] -> Parser Text ()
validate Text
_ [] = () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      validate Text
label [Text]
lines = case IndentParsingMode
mode of
        IndentParsingMode
Strict -> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        IndentParsingMode
Lenient -> do
          let extraIndent :: Parser Text
extraIndent = Text -> Parser Text
string (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Text -> Int
indent Text
label) Text
" "

          -- If every line has extra padding we are most likely in
          -- the wrong mode too.
          Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Parser Text -> Text -> Bool
forall a. Parser a -> Text -> Bool
startsWith Parser Text
extraIndent) [Text]
lines) (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$
            String -> Parser Text ()
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"All lines have extra indent"

-- | Turn an ordinary `Name` into a `DocSymbolName`
docName :: Name -> DocSymbolName
docName :: Name -> DocSymbolName
docName (Name Text
ns Text
n) = Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n

-- | Return a `Name` from a potentially relative `DocSymbolName`,
-- using the provided default namespace if the name is relative.
resolveDocSymbol :: DocSymbolName -> Text -> Name
resolveDocSymbol :: DocSymbolName -> Text -> Name
resolveDocSymbol (AbsoluteName Text
ns Text
n) Text
_ = Text -> Text -> Name
Name Text
ns Text
n
resolveDocSymbol (RelativeName Text
n) Text
defaultNS = Text -> Text -> Name
Name Text
defaultNS Text
n