Add appleKit.hs

appleKit.hs

@@ -0,0 +1,57 @@
+{-  
+  
+install my lib: https://github.com/KonstantinDjairo/haskell-obj-c
+
+then:
+
+  $ appleKit.hs -o hello \
+  -package haskell-obj-c \
+  -package libffi \
+  -framework AppKit
+  
+  
+-}
+
+
+import Foreign.C.String (withCString)
+import Foreign.LibFFI (argPtr, retPtr, retVoid, retCULong)
+import Foreign.Ptr (castPtr)
+import ObjC.Runtime
+
+main :: IO ()
+main = withAutoreleasePool $ do
+  loadFramework "AppKit"
+
+  appClass <- getRequiredClass "NSApplication"
+  _ <- sendClassMsg appClass (mkSelector "sharedApplication")
+         (retPtr retVoid) []
+
+  alertClass <- getRequiredClass "NSAlert"
+  alertPtr <- sendClassMsg alertClass (mkSelector "new")
+                (retPtr retVoid) []
+  let alert = RawId (castPtr alertPtr)
+
+  stringClass <- getRequiredClass "NSString"
+  title <- makeString stringClass "Hello from Haskell"
+  detail <- makeString stringClass "RawId-only AppKit test."
+
+  let RawId titlePtr = title
+      RawId detailPtr = detail
+
+  _ <- sendRawMsg alert (mkSelector "setMessageText:")
+         retVoid [argPtr titlePtr]
+
+  _ <- sendRawMsg alert (mkSelector "setInformativeText:")
+         retVoid [argPtr detailPtr]
+
+  _ <- sendRawMsg alert (mkSelector "runModal")
+         retCULong []
+
+  pure ()
+
+makeString :: Class -> String -> IO RawId
+makeString cls s =
+  withCString s $ \cs -> do
+    ptr <- sendClassMsg cls (mkSelector "stringWithUTF8String:")
+             (retPtr retVoid) [argPtr cs]
+    pure (RawId (castPtr ptr))