module Data.GI.GIR.Constant
( Constant(..)
, parseConstant
) where
import Data.Text (Text)
import Data.GI.GIR.BasicTypes (Type)
import Data.GI.GIR.Type (parseType)
import Data.GI.GIR.Parser
data Constant = Constant {
Constant -> Type
constantType :: Type,
Constant -> ParseError
constantValue :: Text,
Constant -> ParseError
constantCType :: Text,
Constant -> Documentation
constantDocumentation :: Documentation,
Constant -> Maybe DeprecationInfo
constantDeprecated :: Maybe DeprecationInfo
} deriving (Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
(Int -> Constant -> ShowS)
-> (Constant -> String) -> ([Constant] -> ShowS) -> Show Constant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constant -> ShowS
showsPrec :: Int -> Constant -> ShowS
$cshow :: Constant -> String
show :: Constant -> String
$cshowList :: [Constant] -> ShowS
showList :: [Constant] -> ShowS
Show)
parseConstant :: Parser (Name, Constant)
parseConstant :: Parser (Name, Constant)
parseConstant = do
Name
name <- Parser Name
parseName
Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
ParseError
value <- Name -> Parser ParseError
getAttr Name
"value"
Type
t <- Parser Type
parseType
ParseError
ctype <- GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
CGIRNS Name
"type" Parser (Maybe ParseError)
-> (Maybe ParseError -> Parser ParseError) -> Parser ParseError
forall a b.
ReaderT ParseContext (Except ParseError) a
-> (a -> ReaderT ParseContext (Except ParseError) b)
-> ReaderT ParseContext (Except ParseError) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
i -> ParseError -> Parser ParseError
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ParseError
i
Maybe ParseError
Nothing -> GIRXMLNamespace -> Name -> Parser ParseError
getAttrWithNamespace GIRXMLNamespace
CGIRNS Name
"identifier"
Documentation
doc <- Parser Documentation
parseDocumentation
(Name, Constant) -> Parser (Name, Constant)
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Constant { constantType :: Type
constantType = Type
t
, constantValue :: ParseError
constantValue = ParseError
value
, constantCType :: ParseError
constantCType = ParseError
ctype
, constantDocumentation :: Documentation
constantDocumentation = Documentation
doc
, constantDeprecated :: Maybe DeprecationInfo
constantDeprecated = Maybe DeprecationInfo
deprecated
})