-- | 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(..)
  , ListItem(..)
  , CRef(..)
  , DocSymbolName(..)
  , docName
  , resolveDocSymbol
  ) where

import Prelude hiding (takeWhile)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*))
#endif
#if !MIN_VERSION_base(4,13,0)
import Data.Monoid ((<>))
#endif
import Control.Applicative ((<|>))

import Data.GI.GIR.BasicTypes (Name(Name))

import Data.Attoparsec.Text
import Data.Char (isAlphaNum, isAlpha, isAscii)
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
           | List [ListItem]
           | SectionHeader Int GtkDoc -- ^ A section header of the given depth.
           | SymbolRef CRef
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> [Char]
(Int -> Token -> ShowS)
-> (Token -> [Char]) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> [Char]
show :: Token -> [Char]
$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 -> [Char]
(Int -> Link -> ShowS)
-> (Link -> [Char]) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Link -> ShowS
showsPrec :: Int -> Link -> ShowS
$cshow :: Link -> [Char]
show :: Link -> [Char]
$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)

-- | An item in a list, given by a list of lines (not including ending
-- newlines). The list is always non-empty, so we represent it by the
-- first line and then a possibly empty list with the rest of the
-- lines.
data ListItem = ListItem GtkDoc [GtkDoc]
  deriving (Int -> ListItem -> ShowS
[ListItem] -> ShowS
ListItem -> [Char]
(Int -> ListItem -> ShowS)
-> (ListItem -> [Char]) -> ([ListItem] -> ShowS) -> Show ListItem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListItem -> ShowS
showsPrec :: Int -> ListItem -> ShowS
$cshow :: ListItem -> [Char]
show :: ListItem -> [Char]
$cshowList :: [ListItem] -> ShowS
showList :: [ListItem] -> ShowS
Show, ListItem -> ListItem -> Bool
(ListItem -> ListItem -> Bool)
-> (ListItem -> ListItem -> Bool) -> Eq ListItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListItem -> ListItem -> Bool
== :: ListItem -> ListItem -> Bool
$c/= :: ListItem -> ListItem -> Bool
/= :: ListItem -> ListItem -> Bool
Eq)

-- | The language for an embedded code block.
newtype Language = Language Text
  deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> [Char]
(Int -> Language -> ShowS)
-> (Language -> [Char]) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> [Char]
show :: Language -> [Char]
$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
          | CTypeRef Text
          | TypeRef DocSymbolName
          deriving (Int -> CRef -> ShowS
[CRef] -> ShowS
CRef -> [Char]
(Int -> CRef -> ShowS)
-> (CRef -> [Char]) -> ([CRef] -> ShowS) -> Show CRef
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRef -> ShowS
showsPrec :: Int -> CRef -> ShowS
$cshow :: CRef -> [Char]
show :: CRef -> [Char]
$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 -> [Char]
(Int -> DocSymbolName -> ShowS)
-> (DocSymbolName -> [Char])
-> ([DocSymbolName] -> ShowS)
-> Show DocSymbolName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocSymbolName -> ShowS
showsPrec :: Int -> DocSymbolName -> ShowS
$cshow :: DocSymbolName -> [Char]
show :: DocSymbolName -> [Char]
$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 -> [Char]
(Int -> GtkDoc -> ShowS)
-> (GtkDoc -> [Char]) -> ([GtkDoc] -> ShowS) -> Show GtkDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GtkDoc -> ShowS
showsPrec :: Int -> GtkDoc -> ShowS
$cshow :: GtkDoc -> [Char]
show :: GtkDoc -> [Char]
$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",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]
--
-- >>> parseGtkDoc "Spaced list:\n\n- First item\n\n- Second item"
-- GtkDoc [Literal "Spaced list:\n",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]
--
-- >>> parseGtkDoc "List with urls:\n- [test](http://test)\n- ![](image.png)"
-- GtkDoc [Literal "List with urls:\n",List [ListItem (GtkDoc [ExternalLink (Link {linkName = "test", linkAddress = "http://test"})]) [],ListItem (GtkDoc [Image (Link {linkName = "", linkAddress = "image.png"})]) []]]
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc Text
raw =
  case Parser [Token] -> Text -> Either [Char] [Token]
forall a. Parser a -> Text -> Either [Char] 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 [Char]
e ->
      [Char] -> GtkDoc
forall a. HasCallStack => [Char] -> a
error ([Char] -> GtkDoc) -> [Char] -> GtkDoc
forall a b. (a -> b) -> a -> b
$ [Char]
"gtk-doc parsing failed with error \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
e
      [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\" on the input \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
raw [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
    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]
restoreSHPreNewlines ([Token] -> [Token]) -> ([Token] -> [Token]) -> [Token] -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
restoreListPreNewline ([Token] -> GtkDoc) -> [Token] -> GtkDoc
forall a b. (a -> b) -> a -> b
$ [Token]
tks

-- | `parseSectionHeader` eats the newline before the section header,
-- but `parseInitialSectionHeader` does not, since it only matches at
-- the beginning of the text. This restores the newlines eaten by
-- `parseSectionHeader`, so a `SectionHeader` returned by the parser
-- can always be assumed /not/ to have an implicit starting newline.
restoreSHPreNewlines :: [Token] -> [Token]
restoreSHPreNewlines :: [Token] -> [Token]
restoreSHPreNewlines [] = []
restoreSHPreNewlines (Token
i : [Token]
rest) = Token
i Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreNewlines [Token]
rest
  where restoreNewlines :: [Token] -> [Token]
        restoreNewlines :: [Token] -> [Token]
restoreNewlines [] = []
        restoreNewlines (s :: Token
s@(SectionHeader Int
_ GtkDoc
_) : [Token]
rest) =
          Text -> Token
Literal Text
"\n" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
s Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreNewlines [Token]
rest
        restoreNewlines (Token
x : [Token]
rest) = Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreNewlines [Token]
rest

-- | `parseList` eats the newline before the list, restore it.
restoreListPreNewline :: [Token] -> [Token]
restoreListPreNewline :: [Token] -> [Token]
restoreListPreNewline [] = []
restoreListPreNewline (l :: Token
l@(List [ListItem]
_) : [Token]
rest) =
  Text -> Token
Literal Text
"\n" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
l Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreListPreNewline [Token]
rest
restoreListPreNewline (Token
x : [Token]
rest) = Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreListPreNewline [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 = Parser Token -> Parser [Token]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Token
parseToken

-- | Parse a single token.
--
-- === __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
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
parseList
             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"))
parseMethod :: Parser Token
parseMethod :: Parser Token
parseMethod = do
  _ <- Text -> Parser Text
string Text
"[method@"
  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 enum type:
-- > [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")))
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@"
  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)

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"))
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 [Char] -> Parser Text [Char]
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 [Char]
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
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")
parseNewStyleCodeBlock :: Parser Token
parseNewStyleCodeBlock :: Parser Token
parseNewStyleCodeBlock = do
  _ <- Text -> Parser Text
string Text
"```"
  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```")
  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 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 = Char -> Parser Char
char Char
'\n' Parser Char -> Parser Token -> Parser Token
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 Token
parseInitialSectionHeader

-- | 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 a list header. Note that the newline before the start of
-- the list is "eaten" by this parser, but is restored later by
-- `parseGtkDoc`.
--
-- === __Examples__
-- >>> parseOnly (parseList <* endOfInput) "\n- First item\n- Second item"
-- Right (List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []])
--
-- >>> parseOnly (parseList <* endOfInput) "\n\n- Two line\n  item\n\n- Second item,\n  also two lines"
-- Right (List [ListItem (GtkDoc [Literal "Two line"]) [GtkDoc [Literal "item"]],ListItem (GtkDoc [Literal "Second item,"]) [GtkDoc [Literal "also two lines"]]])
parseList :: Parser Token
parseList :: Parser Token
parseList = do
  items <- Parser Text ListItem -> Parser Text [ListItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text ListItem
parseListItem
  return $ List items
  where parseListItem :: Parser ListItem
        parseListItem :: Parser Text ListItem
parseListItem = do
          _ <- Char -> Parser Char
char Char
'\n'
          _ <- string "\n- " <|> string "- "
          first <- takeWhile1 (/= '\n')
          rest <- many' parseLine
          return $ ListItem (parseGtkDoc first) (map parseGtkDoc rest)

        parseLine :: Parser Text
        parseLine :: Parser Text
parseLine = 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
>> (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')

-- | 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