packages feed

luka (empty) → 2012.7.7

raw patch · 12 files changed

+472/−0 lines, 12 filesdep +airdep +basedep +libffisetup-changed

Dependencies added: air, base, libffi

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2012, Jinjing Wang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jinjing Wang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Nemesis view
@@ -0,0 +1,26 @@+nemesis = do+  +  clean+    [ "**/*.hi"+    , "**/*.o"+    , "**/*_stub.h"+    ]+  +  desc "prepare cabal dist"+  task "dist" - do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"++  desc "interactive console"+  task "i" - do+    sh "ghci -isrc -lobjc -frameworkCocoa src/Main.hs"++  ++  desc "run main"+  task "run" - do+    sh "runghc -isrc -lobjc -frameworkCocoa src/Main.hs"++  +
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ changelog.md view
+ known-issues.md view
+ luka.cabal view
@@ -0,0 +1,36 @@+Name:                 luka+Version:              2012.7.7+Build-type:           Simple+Synopsis:             Simple ObjectiveC runtime binding+Description:          Simple ObjectiveC runtime binding+License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Language+homepage:             https://github.com/nfjinjing/luka+data-files:           readme.md+                    , changelog.md+                    , known-issues.md+                    , Nemesis+                    , src/Main.hs+                    , src/Init.hs++Library            + +  ghc-options:        -frameworkCocoa+  +  build-depends:      base < 99+                    , air+                    , libffi+                      +  hs-source-dirs:     src+  exposed-modules:    Language.ObjectiveC.Luka.RunTime+                      Language.ObjectiveC.Luka.API+                      Language.ObjectiveC.Luka+  +  +  other-modules:       +  extra-libraries:   objc
+ readme.md view
@@ -0,0 +1,23 @@+Simple ObjectiveC runtime binding++Tutorial+=========+    +    git clone $this+    +    cabal install nemesis+    +    pushd .+    +    cd vendor/libffi+    cabal install+    +    popd+    +    nemesis run+    ++License:+========++BSD3
+ src/Init.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ +module Init where++import Foreign hiding (void)+import Foreign.C.Types+import Foreign.C.String++import Prelude ()+import Air.Env+import Control.Monad ((>=>))++import Language.ObjectiveC.Luka.RunTime+import Language.ObjectiveC.Luka+import Foreign.LibFFI++++main = do+  with_pool - do+    ns_puts "Hello World!" []+  -- c_NSApplicationMain 0 nullPtr
+ src/Language/ObjectiveC/Luka.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ +module Language.ObjectiveC.Luka +(+  module Language.ObjectiveC.Luka.API+, module Language.ObjectiveC.Luka.RunTime+)+where++import Language.ObjectiveC.Luka.API+import Language.ObjectiveC.Luka.RunTime
+ src/Language/ObjectiveC/Luka/API.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ +module Language.ObjectiveC.Luka.API where++import Foreign hiding (void)+import Foreign.C.Types+import Foreign.C.String++import Prelude ()+import Air.Env+import Control.Monad ((>=>))++import Language.ObjectiveC.Luka.RunTime++import Foreign.LibFFI++++get_i :: String -> ID -> IO ID+get_i ivar_name obj = do+    object_getInstanceVariable obj ivar_name >>= object_getIvar obj+      ++from_ns_string :: ID -> IO String+from_ns_string = msg_cstring "UTF8String" [] >=> peekCString++++with_pool :: IO a -> IO ()+with_pool _io = do+  pool <- class_named "NSAutoreleasePool" >>= msg_obj "alloc" [] >>= msg_obj "init" []+  +  _io+  +  pool .msg "release" []+++msg         :: String -> [Arg] -> ID -> IO ()+msg         methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_void    obj sel args++msg_ptr     :: String -> [Arg] -> ID -> IO (Ptr ())                                         +msg_ptr     methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_ptr     obj sel args+                                                                                       +msg_obj     :: String -> [Arg] -> ID -> IO ID                                           +msg_obj     methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_obj     obj sel args+                                                                                        +msg_cint    :: String -> [Arg] -> ID -> IO CInt                                         +msg_cint    methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cint    obj sel args+                                                                                        +msg_cuint   :: String -> [Arg] -> ID -> IO CUInt                                        +msg_cuint   methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cuint   obj sel args+                                                                                        +msg_clong   :: String -> [Arg] -> ID -> IO CLong                                        +msg_clong   methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_clong   obj sel args+                                                                                        +msg_culong  :: String -> [Arg] -> ID -> IO CULong                                       +msg_culong  methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_culong  obj sel args+                                                                                        +msg_cfloat  :: String -> [Arg] -> ID -> IO CFloat                                       +msg_cfloat  methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cfloat  obj sel args+                                                                                        +msg_cdouble :: String -> [Arg] -> ID -> IO CDouble                                      +msg_cdouble methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cdouble obj sel args+                                                                                        +msg_cchar   :: String -> [Arg] -> ID -> IO CChar                                        +msg_cchar   methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cchar   obj sel args+                                                                                        +msg_uchar   :: String -> [Arg] -> ID -> IO CUChar                                       +msg_uchar   methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cuchar  obj sel args++msg_cstring :: String -> [Arg] -> ID -> IO CString                                       +msg_cstring methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cstring obj sel args+                                                                                            +++sel_named :: String -> IO SEL+sel_named = sel_getUid+++ns_string :: String -> IO ID+ns_string x = do+  class_named "NSString" >>= msg_obj "stringWithUTF8String:" [argString x]+++class_named :: String -> IO ID+class_named = objc_getClass++ns_puts :: String -> [Arg] -> IO ()+ns_puts x args = do+  ns_msg <- ns_string x+  ns_log - argPtr ns_msg : args++set_method :: String -> String -> FunPtr a -> IO (FunPtr ())+set_method class_name sel_name method_implementation = do+  class_pointer <- class_named class_name+  cmd <- sel_named sel_name+  +  method <- class_getInstanceMethod class_pointer cmd+  +  method_setImplementation method method_implementation+  
+ src/Language/ObjectiveC/Luka/RunTime.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+ ++module Language.ObjectiveC.Luka.RunTime where++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Foreign.LibFFI++++foreign import ccall safe "&object_getInstanceVariable"   funPtr_object_getInstanceVariable :: FunPtr ()+foreign import ccall safe "&object_getIvar"               funPtr_object_getIvar             :: FunPtr ()+foreign import ccall safe "&objc_getClass"                funPtr_objc_getClass              :: FunPtr ()+foreign import ccall safe "&method_setImplementation"     funPtr_method_setImplementation   :: FunPtr ()+foreign import ccall safe "&objc_msgSend"                 funPtr_objc_msgSend               :: FunPtr ()+foreign import ccall safe "&sel_registerName"             funPtr_sel_registerName           :: FunPtr ()+foreign import ccall safe "&sel_getUid"                   funPtr_sel_getUid                 :: FunPtr ()+foreign import ccall safe "&class_createInstance"         funPtr_class_createInstance       :: FunPtr ()+foreign import ccall safe "&object_dispose"               funPtr_object_dispose             :: FunPtr ()+foreign import ccall safe "&objc_allocateClassPair"       funPtr_objc_allocateClassPair     :: FunPtr ()+foreign import ccall safe "&objc_registerClassPair"       funPtr_objc_registerClassPair     :: FunPtr ()+foreign import ccall safe "&class_addMethod"              funPtr_class_addMethod            :: FunPtr ()+foreign import ccall safe "&class_getInstanceMethod"      funPtr_class_getInstanceMethod    :: FunPtr ()++foreign import ccall safe "&NSLog"                        funPtr_NSLog                      :: FunPtr ()+++foreign import ccall safe "NSApplicationMain"             c_NSApplicationMain :: CInt -> Ptr (Ptr CChar) -> IO CInt+foreign import ccall safe "method_getTypeEncoding"        method_getTypeEncoding :: Ptr a -> IO CString++++++data IDData+type ID = Ptr IDData++data SELData+type SEL = Ptr SELData++data IVarData+type IVar = Ptr IVarData++objc_False :: CChar+objc_False = 0x0++objc_True :: CChar+objc_True = 0x1++c2b :: CChar -> Bool+c2b = (== 0x1)++++retIdPtr :: RetType ID+retIdPtr = fmap castPtr $ retPtr retVoid++retSelPtr :: RetType SEL+retSelPtr = fmap castPtr $ retPtr retVoid++retIVarPtr :: RetType IVar+retIVarPtr = fmap castPtr $ retPtr retVoid++retVoidPtr :: RetType (Ptr ())+retVoidPtr = fmap castPtr $ retPtr retVoid+++object_getInstanceVariable :: ID -> String -> IO IVar+object_getInstanceVariable objectPtr instanceName = callFFI funPtr_object_getInstanceVariable retIVarPtr [argPtr objectPtr, argString instanceName]++object_getIvar :: ID -> IVar -> IO ID+object_getIvar objectPtr ivarPtr = callFFI funPtr_object_getIvar retIdPtr [argPtr objectPtr, argPtr ivarPtr]+++objc_getClass :: String -> IO ID+objc_getClass className = callFFI funPtr_objc_getClass retIdPtr [argString className]++method_setImplementation :: Ptr a -> FunPtr b -> IO (FunPtr ())+method_setImplementation methodPtr funPtr = callFFI funPtr_method_setImplementation (retFunPtr retVoid) [argPtr methodPtr, argFunPtr funPtr]+++sel_registerName :: String -> IO SEL+sel_registerName methodName = callFFI funPtr_sel_registerName retSelPtr [argString methodName]++sel_getUid :: String -> IO SEL+sel_getUid methodName = callFFI funPtr_sel_getUid retSelPtr [argString methodName]+++class_createInstance :: ID -> IO ID+class_createInstance classPtr = callFFI funPtr_class_createInstance retIdPtr [argPtr classPtr, argCSize 0]++object_dispose :: ID -> IO ID+object_dispose objectPtr = callFFI funPtr_object_dispose retIdPtr [argPtr objectPtr]+++objc_allocateClassPair :: ID -> String -> IO ID+objc_allocateClassPair super name = callFFI funPtr_objc_allocateClassPair retIdPtr [argPtr super, argString name, argCSize 0]++objc_registerClassPair :: ID -> IO ()+objc_registerClassPair classPtr = callFFI funPtr_objc_registerClassPair retVoid [argPtr classPtr]++class_addMethod :: ID -> SEL -> FunPtr a -> String -> IO Bool+class_addMethod classPtr methodPtr methodImplPtr types = callFFI funPtr_class_addMethod (fmap c2b retCChar) [argPtr classPtr, argPtr methodPtr, argFunPtr methodImplPtr, argString types]++ns_log :: [Arg] -> IO ()+ns_log = callFFI funPtr_NSLog retVoid+++class_getInstanceMethod :: Ptr a -> Ptr b -> IO ID+class_getInstanceMethod classPtr selectorPtr = callFFI funPtr_class_getInstanceMethod retIdPtr [argPtr classPtr, argPtr selectorPtr]+++objc_msgSend_void :: ID -> SEL -> [Arg] -> IO ()+objc_msgSend_void objectPtr selPtr args = callFFI funPtr_objc_msgSend retVoid (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_ptr :: ID -> SEL -> [Arg] -> IO (Ptr ())+objc_msgSend_ptr objectPtr selPtr args = callFFI funPtr_objc_msgSend retVoidPtr (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_obj :: ID -> SEL -> [Arg] -> IO ID+objc_msgSend_obj objectPtr selPtr args = callFFI funPtr_objc_msgSend retIdPtr (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cint :: ID -> SEL -> [Arg] -> IO CInt+objc_msgSend_cint objectPtr selPtr args = callFFI funPtr_objc_msgSend retCInt (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cuint :: ID -> SEL -> [Arg] -> IO CUInt+objc_msgSend_cuint objectPtr selPtr args = callFFI funPtr_objc_msgSend retCUInt (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_clong :: ID -> SEL -> [Arg] -> IO CLong+objc_msgSend_clong objectPtr selPtr args = callFFI funPtr_objc_msgSend retCLong (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_culong :: ID -> SEL -> [Arg] -> IO CULong+objc_msgSend_culong objectPtr selPtr args = callFFI funPtr_objc_msgSend retCULong (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cfloat :: ID -> SEL -> [Arg] -> IO CFloat+objc_msgSend_cfloat objectPtr selPtr args = callFFI funPtr_objc_msgSend retCFloat (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cdouble :: ID -> SEL -> [Arg] -> IO CDouble+objc_msgSend_cdouble objectPtr selPtr args = callFFI funPtr_objc_msgSend retCDouble (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cchar :: ID -> SEL -> [Arg] -> IO CChar+objc_msgSend_cchar objectPtr selPtr args = callFFI funPtr_objc_msgSend retCChar (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cuchar :: ID -> SEL -> [Arg] -> IO CUChar+objc_msgSend_cuchar objectPtr selPtr args = callFFI funPtr_objc_msgSend retCUChar (argPtr objectPtr : argPtr selPtr : args)++objc_msgSend_cstring :: ID -> SEL -> [Arg] -> IO CString+objc_msgSend_cstring objectPtr selPtr args = callFFI funPtr_objc_msgSend retCString (argPtr objectPtr : argPtr selPtr : args)+++{-+retCInt     :: RetType CInt+retCInt     = mkStorableRetType ffi_type_sint+retCUInt    :: RetType CUInt+retCUInt    = mkStorableRetType ffi_type_uint+retCLong    :: RetType CLong+retCLong    = mkStorableRetType ffi_type_slong+retCULong   :: RetType CULong+retCULong   = mkStorableRetType ffi_type_ulong++retInt      :: RetType Int+retInt      = mkStorableRetType ffi_type_hs_int+retInt8     :: RetType Int8+retInt8     = mkStorableRetType ffi_type_sint8+retInt16    :: RetType Int16+retInt16    = mkStorableRetType ffi_type_sint16+retInt32    :: RetType Int32+retInt32    = mkStorableRetType ffi_type_sint32+retInt64    :: RetType Int64+retInt64    = mkStorableRetType ffi_type_sint64++retWord     :: RetType Word+retWord     = mkStorableRetType ffi_type_hs_word+retWord8    :: RetType Word8+retWord8    = mkStorableRetType ffi_type_uint8+retWord16   :: RetType Word16+retWord16   = mkStorableRetType ffi_type_uint16+retWord32   :: RetType Word32+retWord32   = mkStorableRetType ffi_type_uint32+retWord64   :: RetType Word64+retWord64   = mkStorableRetType ffi_type_uint64++retCFloat   :: RetType CFloat+retCFloat   = mkStorableRetType ffi_type_float+retCDouble  :: RetType CDouble+retCDouble  = mkStorableRetType ffi_type_double++retCSize    :: RetType CSize+retCSize    = mkStorableRetType ffi_type_size+retCTime    :: RetType CTime+retCTime    = mkStorableRetType ffi_type_time++retCChar    :: RetType CChar+retCChar    = mkStorableRetType ffi_type_schar+retCUChar   :: RetType CUChar+retCUChar   = mkStorableRetType ffi_type_uchar++retCWchar   :: RetType CWchar+retCWchar   = mkStorableRetType ffi_type_schar++retFunPtr   :: RetType a -> RetType (FunPtr a)+retFunPtr _ = mkStorableRetType ffi_type_pointer++retPtr      :: RetType a -> RetType (Ptr a)+retPtr _    = mkStorableRetType ffi_type_pointer++retCString          :: RetType CString+retCString          = retPtr retCChar+-}
+ src/Main.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ +module Main where++import qualified Init as Init++main = Init.main