map Value to Type
[haskell-gi:haskell-gi.git] / GI / Value.chs
1
2 module GI.Value
3     ( BasicType(..)
4     , Type(..)
5     , Value(..)
6     , typeFromTypeInfo
7     , fromArgument
8     , valueType
9     ) where
10
11 import Control.Applicative ((<$>))
12 import Data.Int
13 import Data.Word
14 import Foreign
15 import Foreign.C
16
17 import GI.Internal.BaseInfo
18 import GI.Internal.TypeInfo
19 import GI.Internal.Types
20
21 #include <girepository.h>
22
23 data BasicType
24      = TVoid
25      | TBoolean
26      | TInt8
27      | TUInt8
28      | TInt16
29      | TUInt16
30      | TInt32
31      | TUInt32
32      | TInt64
33      | TUInt64
34      | TFloat
35      | TDouble
36      | TGType
37      | TUTF8
38      | TFileName
39     deriving (Eq, Enum, Show)
40
41 data Type
42     = TBasicType BasicType
43     | TArray Type
44     | TInterface String
45     | TGList Type
46     | TGSList Type
47     | TGHash Type Type
48     | TError
49     deriving (Eq, Show)
50
51 data Value
52     = VVoid
53     | VBoolean Bool
54     | VInt8 Int8
55     | VUInt8 Word8
56     | VInt16 Int16
57     | VUInt16 Word16
58     | VInt32 Int32
59     | VUInt32 Word32
60     | VInt64 Int64
61     | VUInt64 Word64
62     | VFloat Float
63     | VDouble Double
64     | VGType Word32
65     | VUTF8 String
66     | VFileName String
67     deriving (Eq, Show)
68
69 valueType :: Value -> Type
70 valueType VVoid           = TBasicType TVoid
71 valueType (VBoolean _)    = TBasicType TBoolean
72 valueType (VInt8 _)       = TBasicType TInt8
73 valueType (VUInt8 _)      = TBasicType TUInt8
74 valueType (VInt16 _)      = TBasicType TInt16
75 valueType (VUInt16 _)     = TBasicType TUInt16
76 valueType (VInt32 _)      = TBasicType TInt32
77 valueType (VUInt32 _)     = TBasicType TUInt32
78 valueType (VInt64 _)      = TBasicType TInt64
79 valueType (VUInt64 _)     = TBasicType TUInt64
80 valueType (VFloat _)      = TBasicType TFloat
81 valueType (VDouble _)     = TBasicType TDouble
82 valueType (VGType _)      = TBasicType TGType
83 valueType (VUTF8 _)       = TBasicType TUTF8
84 valueType (VFileName _)   = TBasicType TFileName
85
86 typeFromTypeInfo :: TypeInfo -> Type
87 typeFromTypeInfo ti =
88     if fromEnum tag < fromEnum TypeTagArray
89         then TBasicType $ toEnum $ fromEnum tag
90         else case tag of
91                  TypeTagArray -> TArray p1
92                  -- TypeTagInterface -> TInterface (typeTagToString . typeInfoTag $ ti)
93                  TypeTagInterface -> TInterface $
94                      baseInfoName . baseInfo . typeInfoInterface $ ti
95                  TypeTagGlist -> TGList p1
96                  TypeTagGslist -> TGSList p1
97                  TypeTagGhash -> TGHash p1 p2
98                  -- XXX: Include more information.
99                  TypeTagError -> TError
100                  _ -> error $ "implement me: " ++ show tag
101
102     where tag = typeInfoTag ti
103           p1 = typeFromTypeInfo $ typeInfoParamType ti 0
104           p2 = typeFromTypeInfo $ typeInfoParamType ti 1
105
106 fromArgument :: TypeInfo -> Argument -> Value
107 fromArgument typeInfo (Argument arg) =
108     case typeFromTypeInfo typeInfo of
109         TBasicType t -> unsafePerformIO $ basic t
110
111     where
112
113     basic TInt32 = VInt32 <$> fromIntegral <$> {# get GIArgument->v_int32 #} arg
114     basic TUTF8 = VUTF8 <$> (peekCString =<< {# get GIArgument->v_string #} arg)
115     basic t = error $ "implement me: " ++ show t
116