module Data.GI.GIR.Field
( Field(..)
, FieldInfoFlag
, parseFields
) where
import Control.Monad.Except (catchError, throwError)
import Data.Maybe (isJust, catMaybes)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text, isSuffixOf)
import Data.GI.GIR.BasicTypes (Type(..))
import Data.GI.GIR.Callback (Callback, parseCallback)
import Data.GI.GIR.Type (parseType, queryElementCType)
import Data.GI.GIR.Parser
data Field = Field {
Field -> ParseError
fieldName :: Text,
Field -> Bool
fieldVisible :: Bool,
Field -> Type
fieldType :: Type,
Field -> Maybe Bool
fieldIsPointer :: Maybe Bool,
Field -> Maybe Callback
fieldCallback :: Maybe Callback,
Field -> Int
fieldOffset :: Int,
Field -> [FieldInfoFlag]
fieldFlags :: [FieldInfoFlag],
Field -> Documentation
fieldDocumentation :: Documentation,
Field -> Maybe DeprecationInfo
fieldDeprecated :: Maybe DeprecationInfo }
deriving Int -> Field -> ShowS
[Field] -> ShowS
Field -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> [Char]
$cshow :: Field -> [Char]
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show
data FieldInfoFlag = FieldIsReadable | FieldIsWritable
deriving Int -> FieldInfoFlag -> ShowS
[FieldInfoFlag] -> ShowS
FieldInfoFlag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FieldInfoFlag] -> ShowS
$cshowList :: [FieldInfoFlag] -> ShowS
show :: FieldInfoFlag -> [Char]
$cshow :: FieldInfoFlag -> [Char]
showsPrec :: Int -> FieldInfoFlag -> ShowS
$cshowsPrec :: Int -> FieldInfoFlag -> ShowS
Show
parseField :: Parser (Maybe Field)
parseField :: Parser (Maybe Field)
parseField = do
ParseError
name <- Name -> Parser ParseError
getAttr Name
"name"
Maybe DeprecationInfo
deprecated <- Parser (Maybe DeprecationInfo)
parseDeprecation
Bool
readable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"readable" Bool
True ParseError -> Parser Bool
parseBool
Bool
writable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"writable" Bool
False ParseError -> Parser Bool
parseBool
let flags :: [FieldInfoFlag]
flags = if Bool
readable then [FieldInfoFlag
FieldIsReadable] else []
forall a. Semigroup a => a -> a -> a
<> if Bool
writable then [FieldInfoFlag
FieldIsWritable] else []
Bool
introspectable <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"introspectable" Bool
True ParseError -> Parser Bool
parseBool
Bool
private <- forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
optionalAttr Name
"private" Bool
False ParseError -> Parser Bool
parseBool
Documentation
doc <- Parser Documentation
parseDocumentation
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (\ParseError
e -> if (Bool -> Bool
not Bool
introspectable) Bool -> Bool -> Bool
&& Bool
private
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParseError
e) forall a b. (a -> b) -> a -> b
$ do
(Type
t, Maybe Bool
isPtr, Maybe Callback
callback) <-
if Bool
introspectable
then do
[(Name, Callback)]
callbacks <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"callback" Parser (Name, Callback)
parseCallback
(Maybe Name
cbn, Maybe Callback
callback) <- case [(Name, Callback)]
callbacks of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
[(Name
n, Callback
cb)] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Name
n, forall a. a -> Maybe a
Just Callback
cb)
[(Name, Callback)]
_ -> forall a. ParseError -> Parser a
parseError ParseError
"Multiple callbacks in field"
(Type
t, Maybe Bool
isPtr) <- case Maybe Name
cbn of
Maybe Name
Nothing -> do
Type
t <- Parser Type
parseType
Maybe ParseError
ct <- Parser (Maybe ParseError)
queryElementCType
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError
"*" ParseError -> ParseError -> Bool
`isSuffixOf`) Maybe ParseError
ct)
Just Name
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
TInterface Name
n, forall a. Maybe a
Nothing)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, Maybe Bool
isPtr, Maybe Callback
callback)
else do
[Name]
callbacks <- forall a. ParseError -> Parser a -> Parser [a]
parseAllChildrenWithLocalName ParseError
"callback" Parser Name
parseName
case [Name]
callbacks of
[] -> do
Type
t <- Parser Type
parseType
Maybe ParseError
ct <- Parser (Maybe ParseError)
queryElementCType
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseError
"*" ParseError -> ParseError -> Bool
`isSuffixOf`) Maybe ParseError
ct, forall a. Maybe a
Nothing)
[Name
n] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
TInterface Name
n, forall a. a -> Maybe a
Just Bool
True, forall a. Maybe a
Nothing)
[Name]
_ -> forall a. ParseError -> Parser a
parseError ParseError
"Multiple callbacks in field"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Field {
fieldName :: ParseError
fieldName = ParseError
name
, fieldVisible :: Bool
fieldVisible = Bool
introspectable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
private
, fieldType :: Type
fieldType = Type
t
, fieldIsPointer :: Maybe Bool
fieldIsPointer = if forall a. Maybe a -> Bool
isJust Maybe Callback
callback
then forall a. a -> Maybe a
Just Bool
True
else Maybe Bool
isPtr
, fieldCallback :: Maybe Callback
fieldCallback = Maybe Callback
callback
, fieldOffset :: Int
fieldOffset = forall a. HasCallStack => [Char] -> a
error ([Char]
"unfixed field offset " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ParseError
name)
, fieldFlags :: [FieldInfoFlag]
fieldFlags = [FieldInfoFlag]
flags
, fieldDocumentation :: Documentation
fieldDocumentation = Documentation
doc
, fieldDeprecated :: Maybe DeprecationInfo
fieldDeprecated = Maybe DeprecationInfo
deprecated
}
parseFields :: Parser [Field]
parseFields :: Parser [Field]
parseFields = forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ParseError -> Parser a -> Parser [a]
parseAllChildrenWithLocalName ParseError
"field" Parser (Maybe Field)
parseField