{-# LANGUAGE RecordWildCards, PatternGuards #-}
module Data.GI.GIR.Type
( parseType
, queryCType
, parseCType
, queryElementCType
, parseOptionalType
) where
import Data.Maybe (catMaybes)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Foreign.Storable (sizeOf)
import Foreign.C (CShort, CUShort, CSize)
import System.Posix.Types (CSsize)
import Data.GI.GIR.BasicTypes (Type(..), BasicType(..))
import Data.GI.GIR.Parser
nameToBasicType :: Text -> Maybe BasicType
nameToBasicType :: ParseError -> Maybe BasicType
nameToBasicType ParseError
"gpointer" = forall a. a -> Maybe a
Just BasicType
TPtr
nameToBasicType ParseError
"gboolean" = forall a. a -> Maybe a
Just BasicType
TBoolean
nameToBasicType ParseError
"gchar" = forall a. a -> Maybe a
Just BasicType
TInt8
nameToBasicType ParseError
"gint" = forall a. a -> Maybe a
Just BasicType
TInt
nameToBasicType ParseError
"guint" = forall a. a -> Maybe a
Just BasicType
TUInt
nameToBasicType ParseError
"glong" = forall a. a -> Maybe a
Just BasicType
TLong
nameToBasicType ParseError
"gulong" = forall a. a -> Maybe a
Just BasicType
TULong
nameToBasicType ParseError
"gint8" = forall a. a -> Maybe a
Just BasicType
TInt8
nameToBasicType ParseError
"guint8" = forall a. a -> Maybe a
Just BasicType
TUInt8
nameToBasicType ParseError
"gint16" = forall a. a -> Maybe a
Just BasicType
TInt16
nameToBasicType ParseError
"guint16" = forall a. a -> Maybe a
Just BasicType
TUInt16
nameToBasicType ParseError
"gint32" = forall a. a -> Maybe a
Just BasicType
TInt32
nameToBasicType ParseError
"guint32" = forall a. a -> Maybe a
Just BasicType
TUInt32
nameToBasicType ParseError
"gint64" = forall a. a -> Maybe a
Just BasicType
TInt64
nameToBasicType ParseError
"guint64" = forall a. a -> Maybe a
Just BasicType
TUInt64
nameToBasicType ParseError
"gfloat" = forall a. a -> Maybe a
Just BasicType
TFloat
nameToBasicType ParseError
"gdouble" = forall a. a -> Maybe a
Just BasicType
TDouble
nameToBasicType ParseError
"gunichar" = forall a. a -> Maybe a
Just BasicType
TUniChar
nameToBasicType ParseError
"GType" = forall a. a -> Maybe a
Just BasicType
TGType
nameToBasicType ParseError
"utf8" = forall a. a -> Maybe a
Just BasicType
TUTF8
nameToBasicType ParseError
"filename" = forall a. a -> Maybe a
Just BasicType
TFileName
nameToBasicType ParseError
"gintptr" = forall a. a -> Maybe a
Just BasicType
TIntPtr
nameToBasicType ParseError
"guintptr" = forall a. a -> Maybe a
Just BasicType
TUIntPtr
nameToBasicType ParseError
"gshort" = case forall a. Storable a => a -> Int
sizeOf (CShort
0 :: CShort) of
Int
2 -> forall a. a -> Maybe a
Just BasicType
TInt16
Int
4 -> forall a. a -> Maybe a
Just BasicType
TInt32
Int
8 -> forall a. a -> Maybe a
Just BasicType
TInt64
Int
n -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected short size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
nameToBasicType ParseError
"gushort" = case forall a. Storable a => a -> Int
sizeOf (CUShort
0 :: CUShort) of
Int
2 -> forall a. a -> Maybe a
Just BasicType
TUInt16
Int
4 -> forall a. a -> Maybe a
Just BasicType
TUInt32
Int
8 -> forall a. a -> Maybe a
Just BasicType
TUInt64
Int
n -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected ushort size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
nameToBasicType ParseError
"gssize" = case forall a. Storable a => a -> Int
sizeOf (CSsize
0 :: CSsize) of
Int
4 -> forall a. a -> Maybe a
Just BasicType
TInt32
Int
8 -> forall a. a -> Maybe a
Just BasicType
TInt64
Int
n -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected ssize length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
nameToBasicType ParseError
"gsize" = case forall a. Storable a => a -> Int
sizeOf (CSize
0 :: CSize) of
Int
4 -> forall a. a -> Maybe a
Just BasicType
TUInt32
Int
8 -> forall a. a -> Maybe a
Just BasicType
TUInt64
Int
n -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected size length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
nameToBasicType ParseError
_ = forall a. Maybe a
Nothing
parseArrayInfo :: Parser Type
parseArrayInfo :: Parser Type
parseArrayInfo = Name -> Parser (Maybe ParseError)
queryAttr Name
"name" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
"GLib.Array" -> Type -> Type
TGArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Type
parseType
Just ParseError
"GLib.PtrArray" -> Type -> Type
TPtrArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Type
parseType
Just ParseError
"GLib.ByteArray" -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
TByteArray
Just ParseError
other -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Unsupported array type: \"" forall a. Semigroup a => a -> a -> a
<> ParseError
other forall a. Semigroup a => a -> a -> a
<> ParseError
"\""
Maybe ParseError
Nothing -> Parser Type
parseCArrayType
parseCArrayType :: Parser Type
parseCArrayType :: Parser Type
parseCArrayType = do
Bool
zeroTerminated <- Name -> Parser (Maybe ParseError)
queryAttr Name
"zero-terminated" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
b -> ParseError -> ReaderT ParseContext (Except ParseError) Bool
parseBool ParseError
b
Maybe ParseError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Int
length <- Name -> Parser (Maybe ParseError)
queryAttr Name
"length" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
l -> forall a. Integral a => ParseError -> Parser a
parseIntegral ParseError
l
Maybe ParseError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
Int
fixedSize <- Name -> Parser (Maybe ParseError)
queryAttr Name
"fixed-size" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
s -> forall a. Integral a => ParseError -> Parser a
parseIntegral ParseError
s
Maybe ParseError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
Type
elementType <- Parser Type
parseType
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> Type -> Type
TCArray Bool
zeroTerminated Int
fixedSize Int
length Type
elementType
parseHashTable :: Parser Type
parseHashTable :: Parser Type
parseHashTable = Parser [Maybe Type]
parseTypeElements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
TGHash (BasicType -> Type
TBasicType BasicType
TPtr) (BasicType -> Type
TBasicType BasicType
TPtr)
[Just Type
key, Just Type
value] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
TGHash Type
key Type
value
[Maybe Type]
other -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Unsupported hash type: "
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParseError
T.pack (forall a. Show a => a -> [Char]
show [Maybe Type]
other)
parseClosure :: Parser Type
parseClosure :: Parser Type
parseClosure = Name -> Parser (Maybe ParseError)
queryAttr Name
"closure-type" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ParseError
t -> (Maybe Type -> Type
TGClosure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseError -> Parser Type
parseTypeName ParseError
t
Maybe ParseError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Type -> Type
TGClosure forall a. Maybe a
Nothing
parseListType :: Parser Type
parseListType :: Parser Type
parseListType = Parser (Maybe Type)
queryType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Type
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
Maybe Type
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (BasicType -> Type
TBasicType BasicType
TPtr)
parseFundamentalType :: Text -> Text -> Parser Type
parseFundamentalType :: ParseError -> ParseError -> Parser Type
parseFundamentalType ParseError
"GLib" ParseError
"List" = Type -> Type
TGList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Type
parseListType
parseFundamentalType ParseError
"GLib" ParseError
"SList" = Type -> Type
TGSList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Type
parseListType
parseFundamentalType ParseError
"GLib" ParseError
"HashTable" = Parser Type
parseHashTable
parseFundamentalType ParseError
"GLib" ParseError
"Error" = forall (m :: * -> *) a. Monad m => a -> m a
return Type
TError
parseFundamentalType ParseError
"GLib" ParseError
"Variant" = forall (m :: * -> *) a. Monad m => a -> m a
return Type
TVariant
parseFundamentalType ParseError
"GObject" ParseError
"ParamSpec" = forall (m :: * -> *) a. Monad m => a -> m a
return Type
TParamSpec
parseFundamentalType ParseError
"GObject" ParseError
"Value" = forall (m :: * -> *) a. Monad m => a -> m a
return Type
TGValue
parseFundamentalType ParseError
"GObject" ParseError
"Closure" = Parser Type
parseClosure
parseFundamentalType ParseError
ns ParseError
n = Name -> Parser Type
resolveQualifiedTypeName (ParseError -> ParseError -> Name
Name ParseError
ns ParseError
n)
parseTypeName :: Text -> Parser Type
parseTypeName :: ParseError -> Parser Type
parseTypeName ParseError
typeName = case ParseError -> Maybe BasicType
nameToBasicType ParseError
typeName of
Just BasicType
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (BasicType -> Type
TBasicType BasicType
b)
Maybe BasicType
Nothing -> case (Char -> Bool) -> ParseError -> [ParseError]
T.split (Char
'.' forall a. Eq a => a -> a -> Bool
==) ParseError
typeName of
[ParseError
ns, ParseError
n] -> ParseError -> ParseError -> Parser Type
parseFundamentalType ParseError
ns ParseError
n
[ParseError
n] -> do
ParseError
ns <- Parser ParseError
currentNamespace
ParseError -> ParseError -> Parser Type
parseFundamentalType ParseError
ns ParseError
n
[ParseError]
_ -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Unsupported type form: \""
forall a. Semigroup a => a -> a -> a
<> ParseError
typeName forall a. Semigroup a => a -> a -> a
<> ParseError
"\""
parseTypeInfo :: Parser (Maybe Type)
parseTypeInfo :: Parser (Maybe Type)
parseTypeInfo = do
ParseError
typeName <- Name -> Parser ParseError
getAttr Name
"name"
if ParseError
typeName forall a. Eq a => a -> a -> Bool
== ParseError
"none"
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseError -> Parser Type
parseTypeName ParseError
typeName
parseTypeElements :: Parser [Maybe Type]
parseTypeElements :: Parser [Maybe Type]
parseTypeElements = do
[Maybe Type]
types <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"type" Parser (Maybe Type)
parseTypeInfo
[Type]
arrays <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"array" Parser Type
parseArrayInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Type]
types forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [Type]
arrays)
queryCType :: Parser (Maybe Text)
queryCType :: Parser (Maybe ParseError)
queryCType = GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
queryAttrWithNamespace GIRXMLNamespace
CGIRNS Name
"type"
parseCType :: Parser Text
parseCType :: Parser ParseError
parseCType = GIRXMLNamespace -> Name -> Parser ParseError
getAttrWithNamespace GIRXMLNamespace
CGIRNS Name
"type"
parseCTypeNameElements :: Parser [Text]
parseCTypeNameElements :: Parser [ParseError]
parseCTypeNameElements = do
[Maybe ParseError]
types <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"type" Parser (Maybe ParseError)
queryCType
[Maybe ParseError]
arrays <- forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"array" Parser (Maybe ParseError)
queryCType
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Maybe a] -> [a]
catMaybes ([Maybe ParseError]
types forall a. [a] -> [a] -> [a]
++ [Maybe ParseError]
arrays))
queryType :: Parser (Maybe Type)
queryType :: Parser (Maybe Type)
queryType = Parser [Maybe Type]
parseTypeElements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Just Type
e] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Type
e)
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
[Maybe Type
Nothing] -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Unexpected \"none\" type."
[Maybe Type]
_ -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Found more than one type for the element."
parseType :: Parser Type
parseType :: Parser Type
parseType = Parser [Maybe Type]
parseTypeElements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Just Type
e] -> forall (m :: * -> *) a. Monad m => a -> m a
return Type
e
[] -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Did not find a type for the element."
[Maybe Type
Nothing] -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Unexpected \"none\" type."
[Maybe Type]
_ -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Found more than one type for the element."
parseOptionalType :: Parser (Maybe Type)
parseOptionalType :: Parser (Maybe Type)
parseOptionalType =
Parser [Maybe Type]
parseTypeElements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Maybe Type
e] -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
e
[] -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Did not find a type for the element."
[Maybe Type]
_ -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Found more than one type for the element."
queryElementCType :: Parser (Maybe Text)
queryElementCType :: Parser (Maybe ParseError)
queryElementCType = Parser [ParseError]
parseCTypeNameElements forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[ParseError
ctype] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ParseError
ctype)
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
[ParseError]
_ -> forall a. ParseError -> Parser a
parseError forall a b. (a -> b) -> a -> b
$ ParseError
"Found more than one type for the element."