-- | 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.GI.GIR.BasicTypes (Name(Name))

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

-- | A parsed gtk-doc token.
data Token = Literal Text
           | Comment Text
           | Verbatim Text
           | CodeBlock (Maybe Language) Text
           | ExternalLink Link
           | Image Link
           | List [ListItem]
           | SectionHeader Int GtkDoc -- ^ A section header of the given depth.
           | SymbolRef CRef
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> [Char]
(Int -> Token -> ShowS)
-> (Token -> [Char]) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> [Char]
show :: Token -> [Char]
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq)

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

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

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

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

-- | A parsed representation of gtk-doc formatted documentation.
newtype GtkDoc = GtkDoc [Token]
  deriving (Int -> GtkDoc -> ShowS
[GtkDoc] -> ShowS
GtkDoc -> [Char]
(Int -> GtkDoc -> ShowS)
-> (GtkDoc -> [Char]) -> ([GtkDoc] -> ShowS) -> Show GtkDoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GtkDoc -> ShowS
showsPrec :: Int -> GtkDoc -> ShowS
$cshow :: GtkDoc -> [Char]
show :: GtkDoc -> [Char]
$cshowList :: [GtkDoc] -> ShowS
showList :: [GtkDoc] -> ShowS
Show, GtkDoc -> GtkDoc -> Bool
(GtkDoc -> GtkDoc -> Bool)
-> (GtkDoc -> GtkDoc -> Bool) -> Eq GtkDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GtkDoc -> GtkDoc -> Bool
== :: GtkDoc -> GtkDoc -> Bool
$c/= :: GtkDoc -> GtkDoc -> Bool
/= :: GtkDoc -> GtkDoc -> Bool
Eq)

-- | Parse the given gtk-doc formatted documentation.
--
-- === __Examples__
-- >>> parseGtkDoc ""
-- GtkDoc []
--
-- >>> parseGtkDoc "func()"
-- GtkDoc [SymbolRef (OldFunctionRef "func")]
--
-- >>> parseGtkDoc "literal"
-- GtkDoc [Literal "literal"]
--
-- >>> parseGtkDoc "This is a long literal"
-- GtkDoc [Literal "This is a long literal"]
--
-- >>> parseGtkDoc "Call foo() for free cookies"
-- GtkDoc [Literal "Call ",SymbolRef (OldFunctionRef "foo"),Literal " for free cookies"]
--
-- >>> parseGtkDoc "The signal ::activate is related to gtk_button_activate()."
-- GtkDoc [Literal "The signal ",SymbolRef (LocalSignalRef "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."]
--
-- >>> parseGtkDoc "The signal ##%#GtkButton::activate is related to gtk_button_activate()."
-- GtkDoc [Literal "The signal ##%",SymbolRef (OldSignalRef "GtkButton" "activate"),Literal " is related to ",SymbolRef (OldFunctionRef "gtk_button_activate"),Literal "."]
--
-- >>> parseGtkDoc "# A section\n\n## and a subsection ##\n"
-- GtkDoc [SectionHeader 1 (GtkDoc [Literal "A section"]),Literal "\n",SectionHeader 2 (GtkDoc [Literal "and a subsection "])]
--
-- >>> parseGtkDoc "Compact list:\n- First item\n- Second item"
-- GtkDoc [Literal "Compact list:\n",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]
--
-- >>> parseGtkDoc "Spaced list:\n\n- First item\n\n- Second item"
-- GtkDoc [Literal "Spaced list:\n",List [ListItem (GtkDoc [Literal "First item"]) [],ListItem (GtkDoc [Literal "Second item"]) []]]
--
-- >>> parseGtkDoc "List with urls:\n- [test](http://test)\n- ![](image.png)"
-- GtkDoc [Literal "List with urls:\n",List [ListItem (GtkDoc [ExternalLink (Link {linkName = "test", linkAddress = "http://test"})]) [],ListItem (GtkDoc [Image (Link {linkName = "", linkAddress = "image.png"})]) []]]
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc :: Text -> GtkDoc
parseGtkDoc Text
raw =
  case Parser [Token] -> Text -> Either [Char] [Token]
forall a. Parser a -> Text -> Either [Char] a
parseOnly (Parser [Token]
parseTokens Parser [Token] -> Parser Text () -> Parser [Token]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
raw of
    Left [Char]
e ->
      [Char] -> GtkDoc
forall a. HasCallStack => [Char] -> a
error ([Char] -> GtkDoc) -> [Char] -> GtkDoc
forall a b. (a -> b) -> a -> b
$ [Char]
"gtk-doc parsing failed with error \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
e
      [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\" on the input \"" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
raw [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\""
    Right [Token]
tks -> [Token] -> GtkDoc
GtkDoc ([Token] -> GtkDoc) -> ([Token] -> [Token]) -> [Token] -> GtkDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
coalesceLiterals
                 ([Token] -> [Token]) -> ([Token] -> [Token]) -> [Token] -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
restoreSHPreNewlines ([Token] -> [Token]) -> ([Token] -> [Token]) -> [Token] -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
restoreListPreNewline ([Token] -> GtkDoc) -> [Token] -> GtkDoc
forall a b. (a -> b) -> a -> b
$ [Token]
tks

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

-- | `parseList` eats the newline before the list, restore it.
restoreListPreNewline :: [Token] -> [Token]
restoreListPreNewline :: [Token] -> [Token]
restoreListPreNewline [] = []
restoreListPreNewline (l :: Token
l@(List [ListItem]
_) : [Token]
rest) =
  Text -> Token
Literal Text
"\n" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
l Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreListPreNewline [Token]
rest
restoreListPreNewline (Token
x : [Token]
rest) = Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
restoreListPreNewline [Token]
rest

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

-- | Parser for tokens.
parseTokens :: Parser [Token]
parseTokens :: Parser [Token]
parseTokens = Parser [Token]
headerAndTokens Parser [Token] -> Parser [Token] -> Parser [Token]
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Token]
justTokens
  where -- In case the input starts by a section header.
        headerAndTokens :: Parser [Token]
        headerAndTokens :: Parser [Token]
headerAndTokens = do
          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. 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 (OldFunctionRef "func"))
parseToken :: Parser Token
parseToken :: Parser Token
parseToken = -- Note that the parsers overlap, so this is not as
             -- efficient as it could be (if we had combined parsers
             -- and then branched, so that there is no
             -- backtracking). But speed is not an issue here, so for
             -- clarity we keep the parsers distinct. The exception
             -- is parseFunctionRef, since it does not complicate the
             -- parser much, and it is the main source of
             -- backtracking.
                 Parser Token
parseFunctionRef
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseMethod
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseConstructor
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseSignal
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseId
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseLocalSignal
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseProperty
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseVMethod
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseStructField
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseClass
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseCType
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseConstant
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseParam
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseEscaped
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseCodeBlock
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseVerbatim
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseUrl
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseImage
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseSectionHeader
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseList
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseComment
             Parser Token -> Parser Token -> Parser Token
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Token
parseBoringLiteral

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

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

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

-- | Parse an unresolved reference to a C symbol in new gtk-doc notation.
parseId :: Parser Token
parseId :: Parser Token
parseId = do
  Text
_ <- 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 (Name {namespace = "Gtk", name = "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 (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ Name -> CRef
FunctionRef (Text -> Text -> Name
Name 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 (Name {namespace = "Gtk", name = "Button"}) "set_child"))
parseMethod :: Parser Token
parseMethod :: Parser Token
parseMethod = do
  Text
_ <- Text -> Parser Text
string Text
"[method@"
  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 (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ Name -> Text -> CRef
MethodRef (Text -> Text -> Name
Name 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 (Name {namespace = "Gtk", name = "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 (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ Name -> Text -> CRef
MethodRef (Text -> Text -> Name
Name 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 enum type:
-- > [enum@Namespace.Name]
--
-- === __Examples__
-- >>> parseOnly (parseClass <* endOfInput) "[class@Gtk.Dialog]"
-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "Dialog"})))
--
-- >>> parseOnly (parseClass <* endOfInput) "[iface@Gtk.Editable]"
-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "Editable"})))
--
-- >>> parseOnly (parseClass <* endOfInput) "[enum@Gtk.SizeRequestMode]"
-- Right (SymbolRef (TypeRef (Name {namespace = "Gtk", name = "SizeRequestMode"})))
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@"
  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 (Token -> Parser Token) -> Token -> Parser Token
forall a b. (a -> b) -> a -> b
$ CRef -> Token
SymbolRef (CRef -> Token) -> CRef -> Token
forall a b. (a -> b) -> a -> b
$ Name -> CRef
TypeRef (Text -> Text -> Name
Name Text
ns Text
n)

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

-- | Parse an old style signal name, of the form
-- > #Object::signal
--
-- === __Examples__
-- >>> parseOnly (parseOldSignal <* endOfInput) "#GtkButton::activate"
-- Right (SymbolRef (OldSignalRef "GtkButton" "activate"))
parseOldSignal :: Parser Token
parseOldSignal :: Parser Token
parseOldSignal = do
  Char
_ <- 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 (Name {namespace = "Gtk", name = "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 (Name -> Text -> CRef
SignalRef (Text -> Text -> Name
Name 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 (Name {namespace = "Gtk", name = "ProgressBar"}) "show-text"))
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 (Name -> Text -> CRef
PropertyRef (Text -> Text -> Name
Name 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
  [Char]
comment <- Text -> Parser Text
string Text
"<!--" Parser Text -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser Text -> Parser Text [Char]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"-->")
  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
$ [Char] -> Text
T.pack [Char]
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 (Name {namespace = "Gtk", name = "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 (Name -> Text -> CRef
VFuncRef (Text -> Text -> Name
Name 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 -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"#@%\\`" :: [Char]))
  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
$ 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 (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 Char
'#' = Bool
True
special Char
'@' = Bool
True
special Char
'%' = Bool
True
special Char
'\\' = Bool
True
special Char
'`' = Bool
True
special Char
'|' = Bool
True
special Char
'[' = Bool
True
special Char
'!' = Bool
True
special Char
'\n' = Bool
True
special Char
':' = Bool
True
special Char
c = Char -> Bool
isCIdent Char
c

-- | Parse a verbatim string, of the form
-- > `verbatim text`
--
-- === __Examples__
-- >>> parseOnly (parseVerbatim <* endOfInput) "`Example quote!`"
-- Right (Verbatim "Example quote!")
parseVerbatim :: Parser Token
parseVerbatim :: Parser Token
parseVerbatim = do
  Char
_ <- 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 (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 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 (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 {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 (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 {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")
parseNewStyleCodeBlock :: Parser Token
parseNewStyleCodeBlock :: Parser Token
parseNewStyleCodeBlock = do
  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 <- [Char] -> Text
T.pack ([Char] -> Text) -> Parser Text [Char] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text -> Parser Text [Char]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"\n```")
  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
$ 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 <- [Char] -> Text
T.pack ([Char] -> Text) -> Parser Text [Char] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text -> Parser Text [Char]
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text
string Text
"]|")
  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
$ 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 a section header, given by a number of hash symbols, and
-- then ordinary text. Note that this parser "eats" the newline before
-- and after the section header.
parseSectionHeader :: Parser Token
parseSectionHeader :: Parser Token
parseSectionHeader = Char -> Parser Char
char Char
'\n' Parser Char -> Parser Token -> Parser Token
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Token
parseInitialSectionHeader

-- | Parse a section header at the beginning of the text. I.e. this is
-- the same as `parseSectionHeader`, but we do not expect a newline as
-- a first character.
--
-- === __Examples__
-- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "### Hello! ###\n"
-- Right (SectionHeader 3 (GtkDoc [Literal "Hello! "]))
--
-- >>> parseOnly (parseInitialSectionHeader <* endOfInput) "# Hello!\n"
-- Right (SectionHeader 1 (GtkDoc [Literal "Hello!"]))
parseInitialSectionHeader :: Parser Token
parseInitialSectionHeader :: Parser Token
parseInitialSectionHeader = do
  Text
hashes <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
  [Char]
_ <- Parser Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Char
space
  Text
heading <- (Char -> Bool) -> Parser Text
takeWhile1 ([Char] -> Char -> Bool
notInClass [Char]
"#\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 (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 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
$ [ListItem] -> Token
List [ListItem]
items
  where parseListItem :: Parser ListItem
        parseListItem :: Parser Text ListItem
parseListItem = do
          Char
_ <- Char -> Parser Char
char Char
'\n'
          Text
_ <- Text -> Parser Text
string Text
"\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
"- "
          Text
first <- (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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 a. a -> Parser Text a
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 Text
"\n  " Parser Text -> Parser Text -> Parser Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')