-- | 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
          [Token]
header <- Parser [Token]
parseInitialSectionHeader
          [Token]
tokens <- Parser [Token]
justTokens
          [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token]
header [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token]
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
_ <- Text -> Parser Text
string Text
"[id@"
  Text
ident <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
OldFunctionRef Text
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
  Text
ident <- Parser Text
parseCIdent
  [Token] -> Parser [Token] -> Parser [Token]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [Text -> Token
Literal Text
ident] (Text -> Parser Text
string Text
"()" Parser Text -> 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
>>
                          [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
OldFunctionRef Text
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
_ <- Text -> Parser Text
string Text
"[func@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ DocSymbolName -> CRef
FunctionRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
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
_ <- 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@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
method <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ DocSymbolName -> Text -> CRef
MethodRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) Text
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
_ <- Text -> Parser Text
string Text
"[ctor@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
method <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ DocSymbolName -> Text -> CRef
MethodRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) Text
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
_ <- 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@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ DocSymbolName -> CRef
TypeRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
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
_ <- Text -> Parser Text
string Text
"[enum@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
member <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isCIdent
  Char
_ <- Char -> Parser Char
char 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.)
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ DocSymbolName -> Text -> CRef
EnumMemberRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) (Text -> Text
T.toLower Text
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
_ <- Char -> Parser Char
char Char
'#'
  Text
obj <- Parser Text
parseCIdent
  Text
_ <- Text -> Parser Text
string Text
"::"
  Text
signal <- Parser Text
signalOrPropName
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> Text -> CRef
OldSignalRef Text
obj Text
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
_ <- Text -> Parser Text
string Text
"[signal@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- Parser Text
parseCIdent
  Text
_ <- Text -> Parser Text
string Text
"::"
  Text
signal <- (Char -> Bool) -> Parser Text
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
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (DocSymbolName -> Text -> CRef
SignalRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) Text
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
_ <- Text -> Parser Text
string Text
"::"
  Text
signal <- Parser Text
signalOrPropName
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
LocalSignalRef Text
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
_ <- Char -> Parser Char
char Char
'#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
':'
  Text
property <- Parser Text
signalOrPropName
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> Text -> CRef
OldPropertyRef Text
obj Text
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
_ <- Text -> Parser Text
string Text
"[property@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
':'
  Text
property <- (Char -> Bool) -> Parser Text
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
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (DocSymbolName -> Text -> CRef
PropertyRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) Text
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
  String
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
"-->")
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Token
Comment (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
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
_ <- Char -> Parser Char
char Char
'#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
method <- Parser Text
parseCIdent
  Text
_ <- Text -> Parser Text
string Text
"()"
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> Text -> CRef
VMethodRef Text
obj Text
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
_ <- Text -> Parser Text
string Text
"[vfunc@"
  Text
ns <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
c)
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
n <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
vfunc <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
']'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (DocSymbolName -> Text -> CRef
VFuncRef (Text -> Text -> DocSymbolName
AbsoluteName Text
ns Text
n) Text
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
_ <- Char -> Parser Char
char Char
'#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char Char
'.'
  Text
field <- Parser Text
parseCIdent
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> Text -> CRef
StructFieldRef Text
obj Text
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
_ <- Char -> Parser Char
char Char
'#'
  Text
obj <- Parser Text
parseCIdent
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
CTypeRef Text
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
_ <- Char -> Parser Char
char Char
'%'
  Text
c <- Parser Text
parseCIdent
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
ConstantRef Text
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
_ <- Char -> Parser Char
char Char
'@'
  Text
param <- Parser Text
parseCIdent
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [CRef -> Token
SymbolRef (Text -> CRef
ParamRef Text
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
_ <- Char -> Parser Char
char Char
'\\'
  Char
c <- (Char -> Bool) -> Parser Char
satisfy (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"#@%\\`" :: [Char]))
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Token
Literal (Char -> Text
T.singleton Char
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
  Char
c <- Parser Char
anyChar
  Text
boring <- (Char -> Bool) -> Parser Text
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
special)
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Token
Literal (Char -> Text -> Text
T.cons Char
c Text
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
_ <- Char -> Parser Char
char Char
'`'
  Text
v <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`')
  Char
_ <- Char -> Parser Char
char Char
'`'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Token
Verbatim Text
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
_ <- Char -> Parser Char
char Char
'['
  Text
name <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
  Text
_ <- Text -> Parser Text
string Text
"]("
  Text
address <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
  Char
_ <- Char -> Parser Char
char Char
')'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Link -> Token
ExternalLink (Link -> Token) -> Link -> Token
forall a b. (a -> b) -> a -> b
$ Link {linkName :: Text
linkName = Text
name, linkAddress :: Text
linkAddress = Text
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
_ <- Text -> Parser Text
string Text
"!["
  Text
name <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
  Text
_ <- Text -> Parser Text
string Text
"]("
  Text
address <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
  Char
_ <- Char -> Parser Char
char Char
')'
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Link -> Token
Image (Link -> Token) -> Link -> Token
forall a b. (a -> b) -> a -> b
$ Link {linkName :: Text
linkName = Text
name, linkAddress :: Text
linkAddress = Text
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
  Text
_ <- (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isHorizontalSpace
  Text
_ <- Text -> Parser Text
string Text
"```"
  Text
lang <- Text -> Text
T.strip (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  Char
_ <- Char -> Parser Char
char Char
'\n'
  let maybeLang :: Maybe Text
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
  Text
code <- String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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
"\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
takeWhile Char -> Bool
isHorizontalSpace 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
>>
                                       Text -> Parser Text
string Text
"```")
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Language -> Text -> Token
CodeBlock (Text -> Language
Language (Text -> Language) -> Maybe Text -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
maybeLang) Text
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
_ <- Text -> Parser Text
string Text
"|["
  Maybe Language
lang <- (Language -> Maybe Language
forall a. a -> Maybe a
Just (Language -> Maybe Language)
-> Parser Text Language -> Parser Text (Maybe Language)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Language
parseLanguage) Parser Text (Maybe Language)
-> Parser Text (Maybe Language) -> Parser Text (Maybe Language)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Language -> Parser Text (Maybe Language)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Language
forall a. Maybe a
Nothing
  Text
code <- String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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
"]|")
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe Language -> Text -> Token
CodeBlock Maybe Language
lang Text
code]

-- | Parse the language of a code block, specified as a comment.
parseLanguage :: Parser Language
parseLanguage :: Parser Text Language
parseLanguage = do
  Text
_ <- Text -> Parser Text
string Text
"<!--"
  Parser Text ()
skipSpace
  Text
_ <- Text -> Parser Text
string Text
"language=\""
  Text
lang <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"')
  Char
_ <- Char -> Parser Char
char Char
'"'
  Parser Text ()
skipSpace
  Text
_ <- Text -> Parser Text
string Text
"-->"
  Language -> Parser Text Language
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Language -> Parser Text Language)
-> Language -> Parser Text Language
forall a b. (a -> b) -> a -> b
$ Text -> Language
Language Text
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
  Char
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 :: Text
initialString = if Char
initial Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
                      then Text
"\n"
                      else Text
""
  Text
others <- String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Char
char Char
'\n')
  let joint :: Text
joint = Text
initialString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
others
  if Text -> Bool
T.null Text
joint
    then [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Token
Literal Text
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
  [Token]
initialNewlines <- Parser [Token]
parseInitialNewlines
  [Token]
sectionHeader <- Parser [Token]
parseInitialSectionHeader
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> Parser [Token]) -> [Token] -> Parser [Token]
forall a b. (a -> b) -> a -> b
$ [Token]
initialNewlines [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token]
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
  Text
hashes <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
  String
_ <- Parser Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
space
  Text
heading <- (Char -> Bool) -> Parser Text
takeWhile1 (String -> Char -> Bool
notInClass String
"#\n")
  Char
_ <- (Text -> Parser Text
string Text
hashes Parser Text -> Parser Char -> Parser Char
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 -> 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
'\n')
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> GtkDoc -> Token
SectionHeader (Text -> Int
T.length Text
hashes) (Text -> GtkDoc
parseGtkDoc Text
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
  ([Token]
initialNewlines, [(Text, GtkDoc)]
entries) <- Parser Text -> (Text -> Int) -> Parser ([Token], [(Text, GtkDoc)])
parseList (Text -> Parser Text
string Text
"- ") Text -> Int
T.length
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> Parser [Token]) -> [Token] -> Parser [Token]
forall a b. (a -> b) -> a -> b
$ [Token]
initialNewlines [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [[GtkDoc] -> Token
UnnumberedList (((Text, GtkDoc) -> GtkDoc) -> [(Text, GtkDoc)] -> [GtkDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, GtkDoc) -> GtkDoc
forall a b. (a, b) -> b
snd [(Text, GtkDoc)]
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
  ([Token]
initialNewlines, [(Text, GtkDoc)]
list) <- Parser Text -> (Text -> Int) -> Parser ([Token], [(Text, GtkDoc)])
parseList (do Text
idx <- (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
isDigit
                                           Text
_ <- Text -> Parser Text
string Text
". "
                                           Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
idx)
                                       (\Text
label -> Text -> Int
T.length Text
label Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
  [Token] -> Parser [Token]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> Parser [Token]) -> [Token] -> Parser [Token]
forall a b. (a -> b) -> a -> b
$ [Token]
initialNewlines [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [[(Text, GtkDoc)] -> Token
NumberedList [(Text, GtkDoc)]
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.
     [Token]
initialNewlines <- Parser [Token]
parseInitialNewlines
     (Text
initialSpace, (Text, (Text, [Text]))
first) <-
       Parser Text
-> Parser Text () -> Parser (Text, (Text, (Text, [Text])))
parseListItem ((Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isHorizontalSpace) (() -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
     -- We allow either one or zero empty lines between entries.
     let newlineParser :: Parser Text ()
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 ()
     [(Text, (Text, [Text]))]
rest <- ((Text, (Text, (Text, [Text]))) -> (Text, (Text, [Text])))
-> [(Text, (Text, (Text, [Text])))] -> [(Text, (Text, [Text]))]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, (Text, [Text]))) -> (Text, (Text, [Text]))
forall a b. (a, b) -> b
snd ([(Text, (Text, (Text, [Text])))] -> [(Text, (Text, [Text]))])
-> Parser Text [(Text, (Text, (Text, [Text])))]
-> Parser Text [(Text, (Text, [Text]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             Parser (Text, (Text, (Text, [Text])))
-> Parser Text [(Text, (Text, (Text, [Text])))]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text
-> Parser Text () -> Parser (Text, (Text, (Text, [Text])))
parseListItem (Text -> Parser Text
string Text
initialSpace) Parser Text ()
newlineParser)
     -- Validate the resulting entries, and assemble them into GtkDoc.
     [(Text, GtkDoc)]
validated <- [(Text, (Text, [Text]))]
-> ((Text, (Text, [Text])) -> Parser Text (Text, GtkDoc))
-> Parser Text [(Text, GtkDoc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((Text, (Text, [Text]))
first (Text, (Text, [Text]))
-> [(Text, (Text, [Text]))] -> [(Text, (Text, [Text]))]
forall a. a -> [a] -> [a]
: [(Text, (Text, [Text]))]
rest) (((Text, (Text, [Text])) -> Parser Text (Text, GtkDoc))
 -> Parser Text [(Text, GtkDoc)])
-> ((Text, (Text, [Text])) -> Parser Text (Text, GtkDoc))
-> Parser Text [(Text, GtkDoc)]
forall a b. (a -> b) -> a -> b
$ \(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)

     ([Token], [(Text, GtkDoc)]) -> Parser ([Token], [(Text, GtkDoc)])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token]
initialNewlines, [(Text, GtkDoc)]
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
        Text
initialSpace <- Parser Text
parseInitialSpace
        Text
label <- Parser Text
labelParser
        Text
first <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
        let padding :: Text
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 :: Parser Text
paddingParser = Text -> Parser Text
string Text
padding

        [Text]
rest <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text -> Parser Text
parseLine Parser Text
paddingParser)

        (Text, (Text, (Text, [Text])))
-> Parser (Text, (Text, (Text, [Text])))
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
initialSpace, (Text
label, (Text
first, [Text]
rest)))

      parseLine :: Parser Text -> Parser Text
      parseLine :: Parser Text -> Parser Text
parseLine Parser Text
paddingParser = do
        Text
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
""
        Text
_ <- Char -> Parser Char
char Char
'\n' Parser Char -> 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
paddingParser
        Text
contents <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
        Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Parser Text -> Text -> Bool
forall a. Parser a -> Text -> Bool
startsWith Parser Text
labelParser Text
contents) (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
"Line starting with a label"
        Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
emptyLines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents

      emptyLine :: Parser Text
emptyLine = do
        Char
_ <- Char -> Parser Char
char Char
'\n'
        Maybe Char
maybeNext <- Parser (Maybe Char)
peekChar
        Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Text ()) -> Bool -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Maybe Char
maybeNext Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| Maybe Char
maybeNext Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\n'
        Text -> Parser Text
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"\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