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