-- | 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(..)
  ) 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.Attoparsec.Text
import Data.Char (isAsciiUpper, isAsciiLower, 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
           | List [ListItem]
           | 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
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: 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
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: 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 -> String
(Int -> ListItem -> ShowS)
-> (ListItem -> String) -> ([ListItem] -> ShowS) -> Show ListItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItem] -> ShowS
$cshowList :: [ListItem] -> ShowS
show :: ListItem -> String
$cshow :: ListItem -> String
showsPrec :: Int -> ListItem -> ShowS
$cshowsPrec :: Int -> ListItem -> ShowS
Show, ListItem -> ListItem -> Bool
(ListItem -> ListItem -> Bool)
-> (ListItem -> ListItem -> Bool) -> Eq ListItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItem -> ListItem -> Bool
$c/= :: ListItem -> ListItem -> Bool
== :: ListItem -> ListItem -> Bool
$c== :: ListItem -> ListItem -> 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
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq)

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

-- | A parsed representation of gtk-doc formatted documentation.
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
showList :: [GtkDoc] -> ShowS
$cshowList :: [GtkDoc] -> ShowS
show :: GtkDoc -> String
$cshow :: GtkDoc -> String
showsPrec :: Int -> GtkDoc -> ShowS
$cshowsPrec :: Int -> GtkDoc -> ShowS
Show, GtkDoc -> GtkDoc -> Bool
(GtkDoc -> GtkDoc -> Bool)
-> (GtkDoc -> GtkDoc -> Bool) -> Eq GtkDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GtkDoc -> GtkDoc -> Bool
$c/= :: GtkDoc -> GtkDoc -> Bool
== :: GtkDoc -> GtkDoc -> Bool
$c== :: GtkDoc -> GtkDoc -> Bool
Eq)

-- | Parse the given gtk-doc formatted documentation.
--
-- === __Examples__
-- >>> parseGtkDoc ""
-- GtkDoc []
--
-- >>> parseGtkDoc "func()"
-- GtkDoc [SymbolRef (FunctionRef "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 (FunctionRef "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 (FunctionRef "gtk_button_activate"),Literal "."]
--
-- >>> parseGtkDoc "The signal ##%#GtkButton::activate is related to gtk_button_activate()."
-- GtkDoc [Literal "The signal ##%",SymbolRef (SignalRef "GtkButton" "activate"),Literal " is related to ",SymbolRef (FunctionRef "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 raw :: 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
raw of
    Left e :: String
e ->
      String -> GtkDoc
forall a. HasCallStack => String -> a
error (String -> GtkDoc) -> String -> GtkDoc
forall a b. (a -> b) -> a -> b
$ "gtk-doc parsing failed with error \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\" on the input \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
raw String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\""
    Right tks :: [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 (i :: Token
i : rest :: [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 _ _) : rest :: [Token]
rest) =
          Text -> Token
Literal "\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 (x :: Token
x : rest :: [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 _) : rest :: [Token]
rest) =
  Text -> Token
Literal "\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 (x :: Token
x : rest :: [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 tks :: [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 Nothing  [] = []
    go (Just l :: Text
l) [] = [Text -> Token
Literal Text
l]
    go Nothing (Literal l :: Text
l : rest :: [Token]
rest) = Maybe Text -> [Token] -> [Token]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l) [Token]
rest
    go (Just l :: Text
l) (Literal l' :: Text
l' : rest :: [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 Nothing (tk :: Token
tk : rest :: [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 l :: Text
l) (tk :: Token
tk : rest :: [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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Token
header Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
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 (FunctionRef "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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseSignal
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseLocalSignal
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseProperty
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseVMethod
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseStructField
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseType
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseConstant
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseParam
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseEscaped
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseVerbatim
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseCodeBlock
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseUrl
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseImage
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseSectionHeader
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseList
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseComment
             Parser Token -> Parser Token -> Parser Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseBoringLiteral

-- | Parse a signal name, of the form
-- > #Object::signal
--
-- === __Examples__
-- >>> parseOnly (parseSignal <* endOfInput) "#GtkButton::activate"
-- Right (SymbolRef (SignalRef "GtkButton" "activate"))
parseSignal :: Parser Token
parseSignal :: Parser Token
parseSignal = do
  Char
_ <- Char -> Parser Char
char '#'
  Text
obj <- Parser Text
parseCIdent
  Text
_ <- Text -> Parser Text
string "::"
  Text
signal <- Parser Text
signalOrPropName
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> Text -> CRef
SignalRef Text
obj 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
signal <- Parser Text
signalOrPropName
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> CRef
LocalSignalRef Text
signal))

-- | Parse a property name, of the form
-- > #Object:property
--
-- === __Examples__
-- >>> parseOnly (parseProperty <* endOfInput) "#GtkButton:always-show-image"
-- Right (SymbolRef (PropertyRef "GtkButton" "always-show-image"))
parseProperty :: Parser Token
parseProperty :: Parser Token
parseProperty = do
  Char
_ <- Char -> Parser Char
char '#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char ':'
  Text
property <- Parser Text
signalOrPropName
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> Text -> CRef
PropertyRef Text
obj Text
property))

-- | 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 "<!--" Parser Text -> Parser Text String -> Parser Text String
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 "-->")
  Token -> Parser Token
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 a reference to a virtual method, of the form
-- > #Struct.method()
--
-- === __Examples__
-- >>> parseOnly (parseVMethod <* endOfInput) "#Foo.bar()"
-- Right (SymbolRef (VMethodRef "Foo" "bar"))
parseVMethod :: Parser Token
parseVMethod :: Parser Token
parseVMethod = do
  Char
_ <- Char -> Parser Char
char '#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char '.'
  Text
method <- Parser Text
parseCIdent
  Text
_ <- Text -> Parser Text
string "()"
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> Text -> CRef
VMethodRef Text
obj Text
method))

-- | 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 '#'
  Text
obj <- Parser Text
parseCIdent
  Char
_ <- Char -> Parser Char
char '.'
  Text
field <- Parser Text
parseCIdent
  Token -> Parser Token
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 (parseType <* endOfInput) "#Foo"
-- Right (SymbolRef (TypeRef "Foo"))
parseType :: Parser Token
parseType :: Parser Token
parseType = do
  Char
_ <- Char -> Parser Char
char '#'
  Text
obj <- Parser Text
parseCIdent
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> CRef
TypeRef 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 '%'
  Text
c <- Parser Text
parseCIdent
  Token -> Parser Token
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 '@'
  Text
param <- Parser Text
parseCIdent
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> CRef
ParamRef Text
param))

-- | Whether the given character is valid in a C identifier.
isCIdent :: Char -> Bool
isCIdent :: Char -> Bool
isCIdent '_' = Bool
True
isCIdent c :: Char
c   = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c

-- | 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 '-' = Bool
True
        isSignalOrPropIdent c :: Char
c = Char -> Bool
isCIdent 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, 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 (FunctionRef "test_func"))
--
-- >>> parseOnly (parseFunctionRef <* endOfInput) "not_a_func"
-- Right (Literal "not_a_func")
parseFunctionRef :: Parser Token
parseFunctionRef :: Parser Token
parseFunctionRef = 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 "()" Parser Text -> Parser Token -> Parser Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (CRef -> Token
SymbolRef (Text -> CRef
FunctionRef Text
ident)))

-- | Parse a escaped special character, i.e. one preceded by '\'.
parseEscaped :: Parser Token
parseEscaped :: Parser Token
parseEscaped = do
  Char
_ <- Char -> Parser Char
char '\\'
  Char
c <- (Char -> Bool) -> Parser Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("#@%\\`" :: [Char]))
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ 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 '#' = Bool
True
special '@' = Bool
True
special '%' = Bool
True
special '\\' = Bool
True
special '`' = Bool
True
special '|' = Bool
True
special '[' = Bool
True
special '!' = Bool
True
special '\n' = Bool
True
special ':' = Bool
True
special c :: 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 '`'
  Text
v <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '`')
  Char
_ <- Char -> Parser Char
char '`'
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ 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 '['
  Text
name <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ']')
  Text
_ <- Text -> Parser Text
string "]("
  Text
address <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ')')
  Char
_ <- Char -> Parser Char
char ')'
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ Link -> Token
ExternalLink (Link -> Token) -> Link -> Token
forall a b. (a -> b) -> a -> b
$ Link :: Text -> Text -> Link
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
name <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ']')
  Text
_ <- Text -> Parser Text
string "]("
  Text
address <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ')')
  Char
_ <- Char -> Parser Char
char ')'
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ Link -> Token
Image (Link -> Token) -> Link -> Token
forall a b. (a -> b) -> a -> b
$ Link :: Text -> Text -> Link
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 = do
  Text
_ <- Text -> Parser Text
string "|["
  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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Language -> Parser Text (Maybe Language)
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 "]|")
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ 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 "<!--"
  Parser Text ()
skipSpace
  Text
_ <- Text -> Parser Text
string "language=\""
  Text
lang <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"')
  Char
_ <- Char -> Parser Char
char '"'
  Parser Text ()
skipSpace
  Text
_ <- Text -> Parser Text
string "-->"
  Language -> Parser Text Language
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 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 '\n' Parser Char -> Parser Token -> Parser Token
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
  Text
hashes <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#')
  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 "#\n")
  Char
_ <- (Text -> Parser Text
string Text
hashes Parser Text -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char '\n') Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char '\n')
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ Int -> GtkDoc -> Token
SectionHeader (Text -> Int
T.length Text
hashes) (Text -> GtkDoc
parseGtkDoc Text
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
  [ListItem]
items <- Parser Text ListItem -> Parser Text [ListItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text ListItem
parseListItem
  Token -> Parser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ [ListItem] -> Token
List [ListItem]
items
  where parseListItem :: Parser ListItem
        parseListItem :: Parser Text ListItem
parseListItem = do
          Char
_ <- Char -> Parser Char
char '\n'
          Text
_ <- Text -> Parser Text
string "\n- " Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string "- "
          Text
first <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')
          [Text]
rest <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text
parseLine
          ListItem -> Parser Text ListItem
forall (m :: * -> *) a. Monad m => a -> m a
return (ListItem -> Parser Text ListItem)
-> ListItem -> Parser Text ListItem
forall a b. (a -> b) -> a -> b
$ GtkDoc -> [GtkDoc] -> ListItem
ListItem (Text -> GtkDoc
parseGtkDoc Text
first) ((Text -> GtkDoc) -> [Text] -> [GtkDoc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> GtkDoc
parseGtkDoc [Text]
rest)

        parseLine :: Parser Text
        parseLine :: Parser Text
parseLine = Text -> Parser Text
string "\n  " Parser Text -> Parser Text -> Parser Text
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
/= '\n')