57 lines
No EOL
1.4 KiB
Haskell
57 lines
No EOL
1.4 KiB
Haskell
{-
|
|
|
|
install my lib: https://github.com/KonstantinDjairo/haskell-obj-c
|
|
|
|
then:
|
|
|
|
$ ghc 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)) |