module Graphics.QML.Internal.MetaObj where

import Graphics.QML.Internal.Types

import Control.Monad
import Control.Monad.Trans.State (State, execState, get, put)
import Data.Bits
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Array

--
-- Counted Reverse List
--

data CRList a = CRList {
  forall a. CRList a -> Int
crlLen  :: !Int,
  forall a. CRList a -> [a]
crlList :: [a]
}

crlEmpty :: CRList a
crlEmpty :: forall a. CRList a
crlEmpty = Int -> [a] -> CRList a
forall a. Int -> [a] -> CRList a
CRList Int
0 []

crlSingle :: a -> CRList a
crlSingle :: forall a. a -> CRList a
crlSingle a
x = Int -> [a] -> CRList a
forall a. Int -> [a] -> CRList a
CRList Int
1 [a
x]

crlAppend1 :: CRList a -> a -> CRList a
crlAppend1 :: forall a. CRList a -> a -> CRList a
crlAppend1 (CRList Int
n [a]
xs) a
x = Int -> [a] -> CRList a
forall a. Int -> [a] -> CRList a
CRList (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

crlAppend :: CRList a -> [a] -> CRList a
crlAppend :: forall a. CRList a -> [a] -> CRList a
crlAppend (CRList Int
n [a]
xs) [a]
ys = Int -> [a] -> CRList a
forall a. Int -> [a] -> CRList a
CRList Int
n' [a]
xs'
  where ([a]
xs', Int
n')       = [a] -> [a] -> Int -> ([a], Int)
forall {t} {a}. Num t => [a] -> [a] -> t -> ([a], t)
rev [a]
ys [a]
xs Int
n
        rev :: [a] -> [a] -> t -> ([a], t)
rev []     [a]
vs t
m = ([a]
vs, t
m)
        rev (a
u:[a]
us) [a]
vs t
m = [a] -> [a] -> t -> ([a], t)
rev [a]
us (a
ua -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs) (t
mt -> t -> t
forall a. Num a => a -> a -> a
+t
1)

crlToNewArray :: (Storable b) => (a -> IO b) -> CRList a -> IO (Ptr b)
crlToNewArray :: forall b a. Storable b => (a -> IO b) -> CRList a -> IO (Ptr b)
crlToNewArray a -> IO b
f (CRList Int
len [a]
lst) = do
  Ptr b
ptr <- Int -> IO (Ptr b)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
len
  Ptr b -> [a] -> Int -> IO ()
pokeRev Ptr b
ptr [a]
lst Int
len
  Ptr b -> IO (Ptr b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr b
ptr
  where pokeRev :: Ptr b -> [a] -> Int -> IO ()
pokeRev Ptr b
_ []     Int
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        pokeRev Ptr b
p (a
x:[a]
xs) Int
n = do
          let n' :: Int
n' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
          b
x' <- a -> IO b
f a
x
          Ptr b -> Int -> b -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr b
p Int
n' b
x'
          Ptr b -> [a] -> Int -> IO ()
pokeRev Ptr b
p [a]
xs Int
n'

crlToList :: CRList a -> [a]
crlToList :: forall a. CRList a -> [a]
crlToList (CRList Int
_ [a]
lst) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
lst

--
-- Meta Object Compiler
--

data MemberKind
    = MethodMember
    | ConstPropertyMember
    | PropertyMember
    | SignalMember
    deriving MemberKind -> MemberKind -> Bool
(MemberKind -> MemberKind -> Bool)
-> (MemberKind -> MemberKind -> Bool) -> Eq MemberKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemberKind -> MemberKind -> Bool
== :: MemberKind -> MemberKind -> Bool
$c/= :: MemberKind -> MemberKind -> Bool
/= :: MemberKind -> MemberKind -> Bool
Eq

-- | Represents a named member of the QML class which wraps type @tt@.
data Member tt = Member {
    forall tt. Member tt -> MemberKind
memberKind   :: MemberKind,
    forall tt. Member tt -> String
memberName   :: String,
    forall tt. Member tt -> TypeId
memberType   :: TypeId,
    forall tt. Member tt -> [(String, TypeId)]
memberParams :: [(String, TypeId)],
    forall tt. Member tt -> UniformFunc
memberFun    :: UniformFunc,
    forall tt. Member tt -> Maybe UniformFunc
memberFunAux :: Maybe UniformFunc,
    forall tt. Member tt -> Maybe MemberKey
memberKey    :: Maybe MemberKey
}

data MOCState = MOCState {
  MOCState -> CRList CUInt
mData            :: CRList CUInt,
  MOCState -> Maybe Int
mDataMethodsIdx  :: Maybe Int,
  MOCState -> Maybe Int
mDataPropsIdx    :: Maybe Int,
  MOCState -> CRList CChar
mStrChar         :: CRList CChar,
  MOCState -> CRList CUInt
mStrInfo         :: CRList CUInt,
  MOCState -> Map String CUInt
mStrMap          :: Map String CUInt,
  MOCState -> Map [TypeId] CUInt
mParamMap        :: Map [TypeId] CUInt,
  MOCState -> Map MemberKey CUInt
mSigMap          :: Map MemberKey CUInt,
  MOCState -> CRList (Maybe UniformFunc)
mFuncMethods     :: CRList (Maybe UniformFunc),
  MOCState -> CRList (Maybe UniformFunc)
mFuncProperties  :: CRList (Maybe UniformFunc),
  MOCState -> Int
mMethodCount     :: Int,
  MOCState -> Int
mSignalCount     :: Int,
  MOCState -> Int
mPropertyCount   :: Int
}

-- | Generate MOC meta-data from a class name and member list.
compileClass :: String -> [Member tt] -> MOCState
compileClass :: forall tt. String -> [Member tt] -> MOCState
compileClass String
name [Member tt]
ms = 
  let enc :: MOCState
enc = (State MOCState () -> MOCState -> MOCState)
-> MOCState -> State MOCState () -> MOCState
forall a b c. (a -> b -> c) -> b -> a -> c
flip State MOCState () -> MOCState -> MOCState
forall s a. State s a -> s -> s
execState (MOCState -> MOCState
newMOCState MOCState
enc) (State MOCState () -> MOCState) -> State MOCState () -> MOCState
forall a b. (a -> b) -> a -> b
$ do
        CUInt -> State MOCState ()
writeInt CUInt
7                           -- Revision
        String -> State MOCState ()
writeString String
name                     -- Class name
        CUInt -> State MOCState ()
writeInt CUInt
0 State MOCState () -> State MOCState () -> State MOCState ()
forall a b.
StateT MOCState Identity a
-> StateT MOCState Identity b -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CUInt -> State MOCState ()
writeInt CUInt
0             -- Class info
        Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$
          MOCState -> Int
mMethodCount MOCState
enc Int -> Int -> Int
forall a. Num a => a -> a -> a
+
          MOCState -> Int
mSignalCount MOCState
enc                   -- Methods
        Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MOCState -> Maybe Int
mDataMethodsIdx MOCState
enc  -- Methods (data index)
        Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState -> Int
mPropertyCount MOCState
enc   -- Properties
        Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ MOCState -> Maybe Int
mDataPropsIdx MOCState
enc    -- Properties (data index)
        CUInt -> State MOCState ()
writeInt CUInt
0 State MOCState () -> State MOCState () -> State MOCState ()
forall a b.
StateT MOCState Identity a
-> StateT MOCState Identity b -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CUInt -> State MOCState ()
writeInt CUInt
0             -- Enums
        CUInt -> State MOCState ()
writeInt CUInt
0 State MOCState () -> State MOCState () -> State MOCState ()
forall a b.
StateT MOCState Identity a
-> StateT MOCState Identity b -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CUInt -> State MOCState ()
writeInt CUInt
0             -- Constructors
        CUInt -> State MOCState ()
writeInt CUInt
0                           -- Flags
        Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState -> Int
mSignalCount MOCState
enc     -- Signals
        let mms :: [Member tt]
mms = MemberKind -> [Member tt] -> [Member tt]
forall tt. MemberKind -> [Member tt] -> [Member tt]
filterMembers MemberKind
SignalMember [Member tt]
ms [Member tt] -> [Member tt] -> [Member tt]
forall a. [a] -> [a] -> [a]
++
                  MemberKind -> [Member tt] -> [Member tt]
forall tt. MemberKind -> [Member tt] -> [Member tt]
filterMembers MemberKind
MethodMember [Member tt]
ms
        (Member tt -> State MOCState ())
-> [Member tt] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Member tt -> State MOCState ()
forall tt. Member tt -> State MOCState ()
writeMethodParams [Member tt]
mms
        (Member tt -> State MOCState ())
-> [Member tt] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Member tt -> State MOCState ()
forall tt. Member tt -> State MOCState ()
writeMethod [Member tt]
mms
        let pms :: [Member tt]
pms = MemberKind -> [Member tt] -> [Member tt]
forall tt. MemberKind -> [Member tt] -> [Member tt]
filterMembers MemberKind
ConstPropertyMember [Member tt]
ms [Member tt] -> [Member tt] -> [Member tt]
forall a. [a] -> [a] -> [a]
++
                  MemberKind -> [Member tt] -> [Member tt]
forall tt. MemberKind -> [Member tt] -> [Member tt]
filterMembers MemberKind
PropertyMember [Member tt]
ms
        (Member tt -> State MOCState ())
-> [Member tt] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Member tt -> State MOCState ()
forall tt. Member tt -> State MOCState ()
writeProperty [Member tt]
pms
        (Member tt -> State MOCState ())
-> [Member tt] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Member tt -> State MOCState ()
forall tt. Member tt -> State MOCState ()
writePropertySig [Member tt]
pms
        CUInt -> State MOCState ()
writeInt CUInt
0
  in MOCState
enc

filterMembers :: MemberKind -> [Member tt] -> [Member tt]
filterMembers :: forall tt. MemberKind -> [Member tt] -> [Member tt]
filterMembers MemberKind
k = (Member tt -> Bool) -> [Member tt] -> [Member tt]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Member tt
m -> MemberKind
k MemberKind -> MemberKind -> Bool
forall a. Eq a => a -> a -> Bool
== Member tt -> MemberKind
forall tt. Member tt -> MemberKind
memberKind Member tt
m)

newMOCState :: MOCState -> MOCState
newMOCState :: MOCState -> MOCState
newMOCState MOCState
enc = CRList CUInt
-> Maybe Int
-> Maybe Int
-> CRList CChar
-> CRList CUInt
-> Map String CUInt
-> Map [TypeId] CUInt
-> Map MemberKey CUInt
-> CRList (Maybe UniformFunc)
-> CRList (Maybe UniformFunc)
-> Int
-> Int
-> Int
-> MOCState
MOCState
    CRList CUInt
forall a. CRList a
crlEmpty Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing CRList CChar
forall a. CRList a
crlEmpty (CUInt -> CRList CUInt
forall a. a -> CRList a
crlSingle CUInt
strCount) Map String CUInt
forall k a. Map k a
Map.empty
    Map [TypeId] CUInt
forall k a. Map k a
Map.empty Map MemberKey CUInt
forall k a. Map k a
Map.empty CRList (Maybe UniformFunc)
forall a. CRList a
crlEmpty CRList (Maybe UniformFunc)
forall a. CRList a
crlEmpty Int
0 Int
0 Int
0
    where strCount :: CUInt
strCount = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ Map String CUInt -> Int
forall k a. Map k a -> Int
Map.size (Map String CUInt -> Int) -> Map String CUInt -> Int
forall a b. (a -> b) -> a -> b
$ MOCState -> Map String CUInt
mStrMap MOCState
enc
 
writeInt :: CUInt -> State MOCState ()
writeInt :: CUInt -> State MOCState ()
writeInt CUInt
int = do
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  MOCState -> State MOCState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (MOCState -> State MOCState ()) -> MOCState -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState
state {mData = mData state `crlAppend1` int}
  () -> State MOCState ()
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

writeIntegral :: (Integral a) => a -> State MOCState ()
writeIntegral :: forall a. Integral a => a -> State MOCState ()
writeIntegral a
int =
  CUInt -> State MOCState ()
writeInt (a -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
int)

writeString :: String -> State MOCState ()
writeString :: String -> State MOCState ()
writeString String
str = do
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let msChr :: CRList CChar
msChr = MOCState -> CRList CChar
mStrChar MOCState
state
      msInf :: CRList CUInt
msInf = MOCState -> CRList CUInt
mStrInfo MOCState
state
      msMap :: Map String CUInt
msMap = MOCState -> Map String CUInt
mStrMap MOCState
state
  case String -> Map String CUInt -> Maybe CUInt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
str Map String CUInt
msMap of
    Just CUInt
idx -> CUInt -> State MOCState ()
writeInt CUInt
idx
    Maybe CUInt
Nothing  -> do
      let idx :: Int
idx = CRList CUInt -> Int
forall a. CRList a -> Int
crlLen CRList CUInt
msInf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          msChr' :: CRList CChar
msChr' = CRList CChar
msChr CRList CChar -> [CChar] -> CRList CChar
forall a. CRList a -> [a] -> CRList a
`crlAppend` (Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
str CRList CChar -> CChar -> CRList CChar
forall a. CRList a -> a -> CRList a
`crlAppend1` CChar
0
          msInf' :: CRList CUInt
msInf' = CRList CUInt
msInf CRList CUInt -> CUInt -> CRList CUInt
forall a. CRList a -> a -> CRList a
`crlAppend1` Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CRList CChar -> Int
forall a. CRList a -> Int
crlLen CRList CChar
msChr')
          msMap' :: Map String CUInt
msMap' = String -> CUInt -> Map String CUInt -> Map String CUInt
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
str (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Map String CUInt
msMap
      MOCState -> State MOCState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (MOCState -> State MOCState ()) -> MOCState -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState
state {
        mStrChar = msChr',
        mStrInfo = msInf',
        mStrMap = msMap'}
      Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral Int
idx

writeMethodParams :: Member tt -> State MOCState ()
writeMethodParams :: forall tt. Member tt -> State MOCState ()
writeMethodParams Member tt
m = do
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let types :: [TypeId]
types = Member tt -> [TypeId]
forall tt. Member tt -> [TypeId]
memberTypes Member tt
m
      datal :: CRList CUInt
datal = MOCState -> CRList CUInt
mData MOCState
state
      mpMap :: Map [TypeId] CUInt
mpMap = MOCState -> Map [TypeId] CUInt
mParamMap MOCState
state
  case [TypeId] -> Map [TypeId] CUInt -> Maybe CUInt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [TypeId]
types Map [TypeId] CUInt
mpMap of
    Just CUInt
_ -> () -> State MOCState ()
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe CUInt
Nothing  -> do
      let idx :: Int
idx = CRList CUInt -> Int
forall a. CRList a -> Int
crlLen CRList CUInt
datal
          mpMap' :: Map [TypeId] CUInt
mpMap' = [TypeId] -> CUInt -> Map [TypeId] CUInt -> Map [TypeId] CUInt
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [TypeId]
types (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Map [TypeId] CUInt
mpMap
      MOCState -> State MOCState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (MOCState -> State MOCState ()) -> MOCState -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState
state {
        mParamMap = mpMap'}
      (TypeId -> State MOCState ()) -> [TypeId] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CUInt -> State MOCState ()
writeInt (CUInt -> State MOCState ())
-> (TypeId -> CUInt) -> TypeId -> State MOCState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeId -> CUInt
typeId) [TypeId]
types
      ((String, TypeId) -> State MOCState ())
-> [(String, TypeId)] -> State MOCState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> State MOCState ()
writeString (String -> State MOCState ())
-> ((String, TypeId) -> String)
-> (String, TypeId)
-> State MOCState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, TypeId) -> String
forall a b. (a, b) -> a
fst) ([(String, TypeId)] -> State MOCState ())
-> [(String, TypeId)] -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ Member tt -> [(String, TypeId)]
forall tt. Member tt -> [(String, TypeId)]
memberParams Member tt
m

writeMethod :: Member tt -> State MOCState ()
writeMethod :: forall tt. Member tt -> State MOCState ()
writeMethod Member tt
m = do
  Int
idx <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT MOCState Identity MOCState
-> (MOCState -> StateT MOCState Identity Int)
-> StateT MOCState Identity Int
forall a b.
StateT MOCState Identity a
-> (a -> StateT MOCState Identity b) -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT MOCState Identity Int
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> StateT MOCState Identity Int)
-> (MOCState -> Int) -> MOCState -> StateT MOCState Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRList CUInt -> Int
forall a. CRList a -> Int
crlLen (CRList CUInt -> Int)
-> (MOCState -> CRList CUInt) -> MOCState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MOCState -> CRList CUInt
mData
  Map [TypeId] CUInt
paramMap <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT MOCState Identity MOCState
-> (MOCState -> StateT MOCState Identity (Map [TypeId] CUInt))
-> StateT MOCState Identity (Map [TypeId] CUInt)
forall a b.
StateT MOCState Identity a
-> (a -> StateT MOCState Identity b) -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map [TypeId] CUInt -> StateT MOCState Identity (Map [TypeId] CUInt)
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [TypeId] CUInt
 -> StateT MOCState Identity (Map [TypeId] CUInt))
-> (MOCState -> Map [TypeId] CUInt)
-> MOCState
-> StateT MOCState Identity (Map [TypeId] CUInt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MOCState -> Map [TypeId] CUInt
mParamMap
  String -> State MOCState ()
writeString (String -> State MOCState ()) -> String -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ Member tt -> String
forall tt. Member tt -> String
memberName Member tt
m
  Int -> State MOCState ()
forall a. Integral a => a -> State MOCState ()
writeIntegral (Int -> State MOCState ()) -> Int -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ [(String, TypeId)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(String, TypeId)] -> Int) -> [(String, TypeId)] -> Int
forall a b. (a -> b) -> a -> b
$ Member tt -> [(String, TypeId)]
forall tt. Member tt -> [(String, TypeId)]
memberParams Member tt
m
  CUInt -> State MOCState ()
writeInt (CUInt -> State MOCState ()) -> CUInt -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ CUInt -> Maybe CUInt -> CUInt
forall a. a -> Maybe a -> a
fromMaybe CUInt
0 (Maybe CUInt -> CUInt) -> Maybe CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$ ([TypeId] -> Map [TypeId] CUInt -> Maybe CUInt)
-> Map [TypeId] CUInt -> [TypeId] -> Maybe CUInt
forall a b c. (a -> b -> c) -> b -> a -> c
flip [TypeId] -> Map [TypeId] CUInt -> Maybe CUInt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map [TypeId] CUInt
paramMap ([TypeId] -> Maybe CUInt) -> [TypeId] -> Maybe CUInt
forall a b. (a -> b) -> a -> b
$ Member tt -> [TypeId]
forall tt. Member tt -> [TypeId]
memberTypes Member tt
m
  String -> State MOCState ()
writeString String
""
  let (Int
mc,Int
sc,CUInt
flags) = case Member tt -> MemberKind
forall tt. Member tt -> MemberKind
memberKind Member tt
m of
        MemberKind
SignalMember -> (Int
0,Int
1,CUInt
mfMethodSignal)
        MemberKind
_            -> (Int
1,Int
0,CUInt
mfMethodMethod)
  CUInt -> State MOCState ()
writeInt (CUInt
mfAccessPublic CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
mfMethodScriptable CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
flags)
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  MOCState -> State MOCState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (MOCState -> State MOCState ()) -> MOCState -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState
state {
    mDataMethodsIdx = mplus (mDataMethodsIdx state) (Just idx),
    mMethodCount = mc + mMethodCount state,
    mSignalCount = sc + mSignalCount state,
    mSigMap = maybe (mSigMap state) (\MemberKey
k ->
      MemberKey -> CUInt -> Map MemberKey CUInt -> Map MemberKey CUInt
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert MemberKey
k (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ MOCState -> Int
mSignalCount MOCState
state) (MOCState -> Map MemberKey CUInt
mSigMap MOCState
state)) $
      memberKey m,
    mFuncMethods = mFuncMethods state `crlAppend1` (Just $ memberFun m)}
  () -> State MOCState ()
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

writeProperty :: Member tt -> State MOCState ()
writeProperty :: forall tt. Member tt -> State MOCState ()
writeProperty Member tt
p = do
  Int
idx <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT MOCState Identity MOCState
-> (MOCState -> StateT MOCState Identity Int)
-> StateT MOCState Identity Int
forall a b.
StateT MOCState Identity a
-> (a -> StateT MOCState Identity b) -> StateT MOCState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT MOCState Identity Int
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> StateT MOCState Identity Int)
-> (MOCState -> Int) -> MOCState -> StateT MOCState Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRList CUInt -> Int
forall a. CRList a -> Int
crlLen (CRList CUInt -> Int)
-> (MOCState -> CRList CUInt) -> MOCState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MOCState -> CRList CUInt
mData
  String -> State MOCState ()
writeString (String -> State MOCState ()) -> String -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ Member tt -> String
forall tt. Member tt -> String
memberName Member tt
p
  CUInt -> State MOCState ()
writeInt (CUInt -> State MOCState ()) -> CUInt -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ TypeId -> CUInt
typeId (TypeId -> CUInt) -> TypeId -> CUInt
forall a b. (a -> b) -> a -> b
$ Member tt -> TypeId
forall tt. Member tt -> TypeId
memberType Member tt
p
  CUInt -> State MOCState ()
writeInt (CUInt
pfReadable CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
pfScriptable CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
    (if MemberKind
ConstPropertyMember MemberKind -> MemberKind -> Bool
forall a. Eq a => a -> a -> Bool
== Member tt -> MemberKind
forall tt. Member tt -> MemberKind
memberKind Member tt
p then CUInt
pfConstant else CUInt
0) CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
    (if Maybe UniformFunc -> Bool
forall a. Maybe a -> Bool
isJust (Member tt -> Maybe UniformFunc
forall tt. Member tt -> Maybe UniformFunc
memberFunAux Member tt
p) then CUInt
pfWritable else CUInt
0) CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
    (if Maybe MemberKey -> Bool
forall a. Maybe a -> Bool
isJust (Member tt -> Maybe MemberKey
forall tt. Member tt -> Maybe MemberKey
memberKey Member tt
p) then CUInt
pfNotify else CUInt
0))
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  MOCState -> State MOCState ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (MOCState -> State MOCState ()) -> MOCState -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ MOCState
state {
    mDataPropsIdx = mplus (mDataPropsIdx state) (Just idx),
    mPropertyCount = 1 + mPropertyCount state,
    mFuncProperties = mFuncProperties state
      `crlAppend1` (Just $ memberFun p) `crlAppend1` memberFunAux p
  }
  () -> State MOCState ()
forall a. a -> StateT MOCState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

writePropertySig :: Member tt -> State MOCState ()
writePropertySig :: forall tt. Member tt -> State MOCState ()
writePropertySig Member tt
p = do
  MOCState
state <- StateT MOCState Identity MOCState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  CUInt -> State MOCState ()
writeInt (CUInt -> State MOCState ()) -> CUInt -> State MOCState ()
forall a b. (a -> b) -> a -> b
$ CUInt -> Maybe CUInt -> CUInt
forall a. a -> Maybe a -> a
fromMaybe CUInt
0 (Maybe CUInt -> CUInt) -> Maybe CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$ Maybe CUInt
-> (MemberKey -> Maybe CUInt) -> Maybe MemberKey -> Maybe CUInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe CUInt
forall a. Maybe a
Nothing ((MemberKey -> Map MemberKey CUInt -> Maybe CUInt)
-> Map MemberKey CUInt -> MemberKey -> Maybe CUInt
forall a b c. (a -> b -> c) -> b -> a -> c
flip MemberKey -> Map MemberKey CUInt -> Maybe CUInt
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Map MemberKey CUInt -> MemberKey -> Maybe CUInt)
-> Map MemberKey CUInt -> MemberKey -> Maybe CUInt
forall a b. (a -> b) -> a -> b
$ MOCState -> Map MemberKey CUInt
mSigMap MOCState
state) (Maybe MemberKey -> Maybe CUInt) -> Maybe MemberKey -> Maybe CUInt
forall a b. (a -> b) -> a -> b
$
    Member tt -> Maybe MemberKey
forall tt. Member tt -> Maybe MemberKey
memberKey Member tt
p

memberTypes :: Member tt -> [TypeId]
memberTypes :: forall tt. Member tt -> [TypeId]
memberTypes Member tt
m = Member tt -> TypeId
forall tt. Member tt -> TypeId
memberType Member tt
m TypeId -> [TypeId] -> [TypeId]
forall a. a -> [a] -> [a]
: (((String, TypeId) -> TypeId) -> [(String, TypeId)] -> [TypeId]
forall a b. (a -> b) -> [a] -> [b]
map (String, TypeId) -> TypeId
forall a b. (a, b) -> b
snd ([(String, TypeId)] -> [TypeId]) -> [(String, TypeId)] -> [TypeId]
forall a b. (a -> b) -> a -> b
$ Member tt -> [(String, TypeId)]
forall tt. Member tt -> [(String, TypeId)]
memberParams Member tt
m)

typeId :: TypeId -> CUInt
typeId :: TypeId -> CUInt
typeId (TypeId Int
tyid) = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tyid

--
-- Constants
--

ofDynamicMetaObject :: CUInt
ofDynamicMetaObject :: CUInt
ofDynamicMetaObject = CUInt
0x01

mfAccessPrivate, mfAccessProtected, mfAccessPublic, mfAccessMask,
  mfMethodMethod, mfMethodSignal, mfMethodSlot, mfMethodConstructor,
  mfMethodTypeMask, mfMethodCompatibility, mfMethodCloned, mfMethodScriptable
  :: CUInt
mfAccessPrivate :: CUInt
mfAccessPrivate   = CUInt
0x00
mfAccessProtected :: CUInt
mfAccessProtected = CUInt
0x01
mfAccessPublic :: CUInt
mfAccessPublic    = CUInt
0x02
mfAccessMask :: CUInt
mfAccessMask      = CUInt
0x03
mfMethodMethod :: CUInt
mfMethodMethod      = CUInt
0x00
mfMethodSignal :: CUInt
mfMethodSignal      = CUInt
0x04
mfMethodSlot :: CUInt
mfMethodSlot        = CUInt
0x08
mfMethodConstructor :: CUInt
mfMethodConstructor = CUInt
0x0c
mfMethodTypeMask :: CUInt
mfMethodTypeMask    = CUInt
0x0c
mfMethodCompatibility :: CUInt
mfMethodCompatibility = CUInt
0x10
mfMethodCloned :: CUInt
mfMethodCloned        = CUInt
0x20
mfMethodScriptable :: CUInt
mfMethodScriptable    = CUInt
0x40

pfInvalid, pfReadable, pfWritable, pfResettable, pfEnumOrFlag, pfStdCppSet,
  pfConstant, pfFinal, pfDesignable, pfResolveDesignable, pfScriptable,
  pfResolveScriptable, pfStored, pfResolveStored, pfEditable,
  pfResolveEditable, pfUser, pfResolveUser, pfNotify :: CUInt
pfInvalid :: CUInt
pfInvalid           = CUInt
0x00000000
pfReadable :: CUInt
pfReadable          = CUInt
0x00000001
pfWritable :: CUInt
pfWritable          = CUInt
0x00000002
pfResettable :: CUInt
pfResettable        = CUInt
0x00000004
pfEnumOrFlag :: CUInt
pfEnumOrFlag        = CUInt
0x00000008
pfStdCppSet :: CUInt
pfStdCppSet         = CUInt
0x00000100
pfConstant :: CUInt
pfConstant          = CUInt
0x00000400
pfFinal :: CUInt
pfFinal             = CUInt
0x00000800
pfDesignable :: CUInt
pfDesignable        = CUInt
0x00001000
pfResolveDesignable :: CUInt
pfResolveDesignable = CUInt
0x00002000
pfScriptable :: CUInt
pfScriptable        = CUInt
0x00004000
pfResolveScriptable :: CUInt
pfResolveScriptable = CUInt
0x00008000
pfStored :: CUInt
pfStored            = CUInt
0x00010000
pfResolveStored :: CUInt
pfResolveStored     = CUInt
0x00020000
pfEditable :: CUInt
pfEditable          = CUInt
0x00040000
pfResolveEditable :: CUInt
pfResolveEditable   = CUInt
0x00080000
pfUser :: CUInt
pfUser              = CUInt
0x00100000
pfResolveUser :: CUInt
pfResolveUser       = CUInt
0x00200000
pfNotify :: CUInt
pfNotify            = CUInt
0x00400000