packages feed

macos-corelibs (empty) → 0.0.1.0

raw patch · 47 files changed

+5447/−0 lines, 47 filesdep +basedep +containersdep +managedsetup-changed

Dependencies added: base, containers, managed, mtl, profunctors, tagged, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+0.0.1.0+-------+* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Filippo Sestini (c) 2018++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 Filippo Sestini 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.
+ README view
@@ -0,0 +1,15 @@+# Mac OS core libraries++Type-safe Haskell bindings to C-based frameworks of the Apple Mac OS SDK. Most+notably, the library offers bindings to++* CoreFoundation+* CoreGraphics+* Carbon Accessibility++This library is unstable, experimental, WIP, and under active testing. Rely upon+it with great care, and definitely avoid it in serious/production code.++The bindings do not cover the all of the target frameworks, and it is likely+they will never reach 100% coverage. Additions may nevertheless happen, and PRs+adding functionality or even additional frameworks are very welcome.
+ Setup.hs view
@@ -0,0 +1,9 @@+import Distribution.Simple+main = defaultMain++-- import Distribution.Simple+-- import System.Environment++-- main = do+--   args <- getArgs+--   defaultMainArgs $ ["--with-gcc=clang++"] ++ args
+ cbits/constants.m view
@@ -0,0 +1,472 @@+#include <Carbon/Carbon.h>++CG_EXTERN const CFStringRef kCGWindowAlpha;+CFStringRef kCGWindowNumber_() { return kCGWindowNumber; }+CFStringRef kCGWindowStoreType_() { return kCGWindowStoreType; }+CFStringRef kCGWindowLayer_() { return kCGWindowLayer; }+CFStringRef kCGWindowBounds_() { return kCGWindowBounds; }+CFStringRef kCGWindowSharingState_() { return kCGWindowSharingState; }+CFStringRef kCGWindowAlpha_() { return kCGWindowAlpha; }+CFStringRef kCGWindowOwnerPID_() { return kCGWindowOwnerPID; }+CFStringRef kCGWindowMemoryUsage_() { return kCGWindowMemoryUsage; }+CFStringRef kCGWindowOwnerName_() { return kCGWindowOwnerName; }+CFStringRef kCGWindowName_() { return kCGWindowName; }+CFStringRef kCGWindowIsOnscreen_() { return kCGWindowIsOnscreen; }+CFStringRef kCGWindowBackingLocationVideoMemory_() {+  return kCGWindowBackingLocationVideoMemory;+}++CFStringRef kCFRunLoopCommonModes_() { return kCFRunLoopCommonModes; }+CFStringRef kCFRunLoopDefaultMode_() { return kCFRunLoopDefaultMode; }++CFStringRef kAXRoleAttribute_ () {+  return kAXRoleAttribute;+}+CFStringRef kAXSubroleAttribute_ () {+  return kAXSubroleAttribute;+}+CFStringRef kAXRoleDescriptionAttribute_ () {+  return kAXRoleDescriptionAttribute;+}+CFStringRef kAXHelpAttribute_ () {+  return kAXHelpAttribute;+}+CFStringRef kAXTitleAttribute_ () {+  return kAXTitleAttribute;+}+CFStringRef kAXValueAttribute_ () {+  return kAXValueAttribute;+}+CFStringRef kAXMinValueAttribute_ () {+  return kAXMinValueAttribute;+}+CFStringRef kAXMaxValueAttribute_ () {+  return kAXMaxValueAttribute;+}+CFStringRef kAXValueIncrementAttribute_ () {+  return kAXValueIncrementAttribute;+}+CFStringRef kAXAllowedValuesAttribute_ () {+  return kAXAllowedValuesAttribute;+}+CFStringRef kAXEnabledAttribute_ () {+  return kAXEnabledAttribute;+}+CFStringRef kAXFocusedAttribute_ () {+  return kAXFocusedAttribute;+}+CFStringRef kAXParentAttribute_ () {+  return kAXParentAttribute;+}+CFStringRef kAXChildrenAttribute_ () {+  return kAXChildrenAttribute;+}+CFStringRef kAXSelectedChildrenAttribute_ () {+  return kAXSelectedChildrenAttribute;+}+CFStringRef kAXVisibleChildrenAttribute_ () {+  return kAXVisibleChildrenAttribute;+}+CFStringRef kAXWindowAttribute_ () {+  return kAXWindowAttribute;+}+CFStringRef kAXPositionAttribute_ () {+  return kAXPositionAttribute;+}+CFStringRef kAXTopLevelUIElementAttribute_ () {+  return kAXTopLevelUIElementAttribute;+}+CFStringRef kAXSizeAttribute_ () {+  return kAXSizeAttribute;+}+CFStringRef kAXOrientationAttribute_ () {+  return kAXOrientationAttribute;+}+CFStringRef kAXDescriptionAttribute_ () {+  return kAXDescriptionAttribute;+}+CFStringRef kAXSelectedTextAttribute_ () {+  return kAXSelectedTextAttribute;+}+CFStringRef kAXSelectedTextRangeAttribute_ () {+  return kAXSelectedTextRangeAttribute;+}+CFStringRef kAXVisibleCharacterRangeAttribute_ () {+  return kAXVisibleCharacterRangeAttribute;+}+CFStringRef kAXNumberOfCharactersAttribute_ () {+  return kAXNumberOfCharactersAttribute;+}+CFStringRef kAXSharedTextUIElementsAttribute_ () {+  return kAXSharedTextUIElementsAttribute;+}+CFStringRef kAXSharedCharacterRangeAttribute_ () {+  return kAXSharedCharacterRangeAttribute;+}+CFStringRef kAXMainAttribute_ () {+  return kAXMainAttribute;+}+CFStringRef kAXMinimizedAttribute_ () {+  return kAXMinimizedAttribute;+}+CFStringRef kAXCloseButtonAttribute_ () {+  return kAXCloseButtonAttribute;+}+CFStringRef kAXZoomButtonAttribute_ () {+  return kAXZoomButtonAttribute;+}+CFStringRef kAXMinimizeButtonAttribute_ () {+  return kAXMinimizeButtonAttribute;+}+CFStringRef kAXToolbarButtonAttribute_ () {+  return kAXToolbarButtonAttribute;+}+CFStringRef kAXGrowAreaAttribute_ () {+  return kAXGrowAreaAttribute;+}+CFStringRef kAXProxyAttribute_ () {+  return kAXProxyAttribute;+}+CFStringRef kAXModalAttribute_ () {+  return kAXModalAttribute;+}+CFStringRef kAXDefaultButtonAttribute_ () {+  return kAXDefaultButtonAttribute;+}+CFStringRef kAXCancelButtonAttribute_ () {+  return kAXCancelButtonAttribute;+}+CFStringRef kAXMenuItemCmdCharAttribute_ () {+  return kAXMenuItemCmdCharAttribute;+}+CFStringRef kAXMenuItemCmdVirtualKeyAttribute_ () {+  return kAXMenuItemCmdVirtualKeyAttribute;+}+CFStringRef kAXMenuItemCmdGlyphAttribute_ () {+  return kAXMenuItemCmdGlyphAttribute;+}+CFStringRef kAXMenuItemCmdModifiersAttribute_ () {+  return kAXMenuItemCmdModifiersAttribute;+}+CFStringRef kAXMenuItemMarkCharAttribute_ () {+  return kAXMenuItemMarkCharAttribute;+}+CFStringRef kAXMenuItemPrimaryUIElementAttribute_ () {+  return kAXMenuItemPrimaryUIElementAttribute;+}+CFStringRef kAXMenuBarAttribute_ () {+  return kAXMenuBarAttribute;+}+CFStringRef kAXWindowsAttribute_ () {+  return kAXWindowsAttribute;+}+CFStringRef kAXFrontmostAttribute_ () {+  return kAXFrontmostAttribute;+}+CFStringRef kAXHiddenAttribute_ () {+  return kAXHiddenAttribute;+}+CFStringRef kAXMainWindowAttribute_ () {+  return kAXMainWindowAttribute;+}+CFStringRef kAXFocusedWindowAttribute_ () {+  return kAXFocusedWindowAttribute;+}+/* CFStringRef kAXFocusedUIElemenAttribute_ () { */+/*   return kAXFocusedUIElemenAttribute; */+/* } */+CFStringRef kAXHeaderAttribute_ () {+  return kAXHeaderAttribute;+}+CFStringRef kAXEditedAttribute_ () {+  return kAXEditedAttribute;+}+CFStringRef kAXTitleUIElementAttribute_ () {+  return kAXTitleUIElementAttribute;+}+CFStringRef kAXValueWrapsAttribute_ () {+  return kAXValueWrapsAttribute;+}+CFStringRef kAXTabsAttribute_ () {+  return kAXTabsAttribute;+}+CFStringRef kAXHorizontalScrollBarAttribute_ () {+  return kAXHorizontalScrollBarAttribute;+}+CFStringRef kAXVerticalScrollBarAttribute_ () {+  return kAXVerticalScrollBarAttribute;+}+CFStringRef kAXOverflowButtonAttribute_ () {+  return kAXOverflowButtonAttribute;+}+CFStringRef kAXFilenameAttribute_ () {+  return kAXFilenameAttribute;+}+CFStringRef kAXExpandedAttribute_ () {+  return kAXExpandedAttribute;+}+CFStringRef kAXSelectedAttribute_ () {+  return kAXSelectedAttribute;+}+CFStringRef kAXSplittersAttribute_ () {+  return kAXSplittersAttribute;+}+CFStringRef kAXNextContentsAttribute_ () {+  return kAXNextContentsAttribute;+}+CFStringRef kAXPreviousContentsAttribute_ () {+  return kAXPreviousContentsAttribute;+}+CFStringRef kAXDocumentAttribute_ () {+  return kAXDocumentAttribute;+}+CFStringRef kAXIncrementButtonAttribute_ () {+  return kAXIncrementButtonAttribute;+}+CFStringRef kAXDecrementButtonAttribute_ () {+  return kAXDecrementButtonAttribute;+}+CFStringRef kAXContentsAttribute_ () {+  return kAXContentsAttribute;+}+CFStringRef kAXIncrementorAttribute_ () {+  return kAXIncrementorAttribute;+}+CFStringRef kAXHourFieldAttribute_ () {+  return kAXHourFieldAttribute;+}+CFStringRef kAXMinuteFieldAttribute_ () {+  return kAXMinuteFieldAttribute;+}+CFStringRef kAXSecondFieldAttribute_ () {+  return kAXSecondFieldAttribute;+}+CFStringRef kAXAMPMFieldAttribute_ () {+  return kAXAMPMFieldAttribute;+}+CFStringRef kAXDayFieldAttribute_ () {+  return kAXDayFieldAttribute;+}+CFStringRef kAXMonthFieldAttribute_ () {+  return kAXMonthFieldAttribute;+}+CFStringRef kAXYearFieldAttribute_ () {+  return kAXYearFieldAttribute;+}+CFStringRef kAXColumnTitleAttribute_ () {+  return kAXColumnTitleAttribute;+}+CFStringRef kAXURLAttribute_ () {+  return kAXURLAttribute;+}+CFStringRef kAXLabelUIElementsAttribute_ () {+  return kAXLabelUIElementsAttribute;+}+CFStringRef kAXLabelValueAttribute_ () {+  return kAXLabelValueAttribute;+}+CFStringRef kAXShownMenuUIElementAttribute_ () {+  return kAXShownMenuUIElementAttribute;+}+CFStringRef kAXServesAsTitleForUIElementsAttribute_ () {+  return kAXServesAsTitleForUIElementsAttribute;+}+CFStringRef kAXLinkedUIElementsAttribute_ () {+  return kAXLinkedUIElementsAttribute;+}+CFStringRef kAXRowsAttribute_ () {+  return kAXRowsAttribute;+}+CFStringRef kAXVisibleRowsAttribute_ () {+  return kAXVisibleRowsAttribute;+}+CFStringRef kAXSelectedRowsAttribute_ () {+  return kAXSelectedRowsAttribute;+}+CFStringRef kAXColumnsAttribute_ () {+  return kAXColumnsAttribute;+}+CFStringRef kAXVisibleColumnsAttribute_ () {+  return kAXVisibleColumnsAttribute;+}+CFStringRef kAXSelectedColumnsAttribute_ () {+  return kAXSelectedColumnsAttribute;+}+CFStringRef kAXSortDirectionAttribute_ () {+  return kAXSortDirectionAttribute;+}+CFStringRef kAXColumnHeaderUIElementsAttribute_ () {+  return kAXColumnHeaderUIElementsAttribute;+}+CFStringRef kAXIndexAttribute_ () {+  return kAXIndexAttribute;+}+CFStringRef kAXDisclosingAttribute_ () {+  return kAXDisclosingAttribute;+}+CFStringRef kAXDisclosedRowsAttribute_ () {+  return kAXDisclosedRowsAttribute;+}+CFStringRef kAXDisclosedByRowAttribute_ () {+  return kAXDisclosedByRowAttribute;+}+CFStringRef kAXMatteHoleAttribute_ () {+  return kAXMatteHoleAttribute;+}+CFStringRef kAXMatteContentUIElementAttribute_ () {+  return kAXMatteContentUIElementAttribute;+}+CFStringRef kAXIsApplicationRunningAttribute_ () {+  return kAXIsApplicationRunningAttribute;+}+CFStringRef kAXFocusedApplicationAttribute_ () {+  return kAXFocusedApplicationAttribute;+}+CFStringRef kAXInsertionPointLineNumberAttribute_ () {+  return kAXInsertionPointLineNumberAttribute;+}++const CFArrayCallBacks *cfCallbs() { return &kCFTypeArrayCallBacks; }+++#define kAXValueTypeCGPoint 1+#define kAXValueTypeCGSize 2++CFStringRef ax_ui_element_destroyed_notification() {+  return kAXUIElementDestroyedNotification; }+CFStringRef ax_window_miniaturized_notification() {+  return kAXWindowMiniaturizedNotification; }+CFStringRef ax_window_deminiaturized_notification() {+  return kAXWindowDeminiaturizedNotification; }++CFStringRef window_created_notif() { return kAXWindowCreatedNotification; }+CFStringRef focused_window_changed_notif() {+  return kAXFocusedWindowChangedNotification; }+CFStringRef window_moved_notif() { return kAXWindowMovedNotification; }+CFStringRef window_resized_notif() { return kAXWindowResizedNotification; }+CFStringRef title_changed_notif() { return kAXTitleChangedNotification; }++typedef int CGSConnectionID;+extern CGSConnectionID _CGSDefaultConnection(void);+extern CGError CGSGetWindowLevel(+  const CGSConnectionID Connection, uint32_t WindowId, uint32_t *WindowLevel);++CFStringRef ax_size_attribute() { return kAXSizeAttribute; }+CFStringRef ax_window_role() { return kAXWindowRole; }+CFStringRef ax_standard_window_subrole() { return kAXStandardWindowSubrole; }+CFStringRef ax_windows_attribute() { return kAXWindowsAttribute; }+CFStringRef ax_minimized_attribute() { return kAXMinimizedAttribute; }+CFStringRef ax_position_attribute() { return kAXPositionAttribute; }++const CFDictionaryKeyCallBacks *cfCopyStringDictionaryKeyCallBacks() {+  return &kCFCopyStringDictionaryKeyCallBacks; }+const CFDictionaryValueCallBacks *cfTypeDictionaryValueCallBacks() {+  return &kCFTypeDictionaryValueCallBacks; }++CFStringRef axTrustedCheckOptionPrompt() { return kAXTrustedCheckOptionPrompt; }++CFStringEncoding uif8enc() { return kCFStringEncodingUTF8; }++CFStringRef ax_focused_window_attribute() { return kAXFocusedWindowAttribute; }+CFStringRef ax_main_attribute() { return kAXMainAttribute; }+CFStringRef ax_focused_attribute() { return kAXFocusedAttribute; }++CFBooleanRef cf_boolean_true() { return kCFBooleanTrue; }+CFBooleanRef cf_boolean_false() { return kCFBooleanFalse; }++CFTypeRef create_cfpoint(CGPoint *point) {+  return (CFTypeRef) AXValueCreate(kAXValueTypeCGPoint, (void *)point); }+CFTypeRef create_cfsize(CGSize *size) {+  return (CFTypeRef) AXValueCreate(kAXValueTypeCGSize, (void *)size); }++CFStringRef ax_press_action() { return kAXPressAction; }+CFStringRef ax_fullscreen_attribute() { return CFSTR("AXFullScreen"); }+CFStringRef ax_close_button_attribute() { return kAXCloseButtonAttribute; }++CFStringRef ax_title_attribute() { return kAXTitleAttribute; }++Boolean ax_value_get_cgpoint(AXValueRef value, void *valuePtr) {+  return AXValueGetValue(value, kAXValueTypeCGPoint, valuePtr); }++Boolean ax_value_get_cgsize(AXValueRef value, void *valuePtr) {+  return AXValueGetValue(value, kAXValueTypeCGSize, valuePtr); }++CFStringRef ax_role_attribute() { return kAXRoleAttribute; }+CFStringRef ax_subrole_attribute() { return kAXSubroleAttribute; }++CFStringRef kAXApplicationRole_() { return kAXApplicationRole; }+CFStringRef kAXSystemWideRole_() { return kAXSystemWideRole; }+CFStringRef kAXWindowRole_() { return kAXWindowRole; }+CFStringRef kAXSheetRole_() { return kAXSheetRole; }+CFStringRef kAXDrawerRole_() { return kAXDrawerRole; }+CFStringRef kAXGrowAreaRole_() { return kAXGrowAreaRole; }+CFStringRef kAXImageRole_() { return kAXImageRole; }+CFStringRef kAXUnknownRole_() { return kAXUnknownRole; }+CFStringRef kAXButtonRole_() { return kAXButtonRole; }+CFStringRef kAXRadioButtonRole_() { return kAXRadioButtonRole; }+CFStringRef kAXCheckBoxRole_() { return kAXCheckBoxRole; }+CFStringRef kAXPopUpButtonRole_() { return kAXPopUpButtonRole; }+CFStringRef kAXMenuButtonRole_() { return kAXMenuButtonRole; }+CFStringRef kAXTabGroupRole_() { return kAXTabGroupRole; }+CFStringRef kAXTableRole_() { return kAXTableRole; }+CFStringRef kAXColumnRole_() { return kAXColumnRole; }+CFStringRef kAXRowRole_() { return kAXRowRole; }+CFStringRef kAXOutlineRole_() { return kAXOutlineRole; }+CFStringRef kAXBrowserRole_() { return kAXBrowserRole; }+CFStringRef kAXScrollAreaRole_() { return kAXScrollAreaRole; }+CFStringRef kAXScrollBarRole_() { return kAXScrollBarRole; }+CFStringRef kAXRadioGroupRole_() { return kAXRadioGroupRole; }+CFStringRef kAXListRole_() { return kAXListRole; }+CFStringRef kAXGroupRole_() { return kAXGroupRole; }+CFStringRef kAXValueIndicatorRole_() { return kAXValueIndicatorRole; }+CFStringRef kAXComboBoxRole_() { return kAXComboBoxRole; }+CFStringRef kAXSliderRole_() { return kAXSliderRole; }+CFStringRef kAXIncrementorRole_() { return kAXIncrementorRole; }+CFStringRef kAXBusyIndicatorRole_() { return kAXBusyIndicatorRole; }+CFStringRef kAXProgressIndicatorRole_() { return kAXProgressIndicatorRole; }+CFStringRef kAXRelevanceIndicatorRole_() { return kAXRelevanceIndicatorRole; }+CFStringRef kAXToolbarRole_() { return kAXToolbarRole; }+CFStringRef kAXDisclosureTriangleRole_() { return kAXDisclosureTriangleRole; }+CFStringRef kAXTextFieldRole_() { return kAXTextFieldRole; }+CFStringRef kAXTextAreaRole_() { return kAXTextAreaRole; }+CFStringRef kAXStaticTextRole_() { return kAXStaticTextRole; }+CFStringRef kAXMenuBarRole_() { return kAXMenuBarRole; }+CFStringRef kAXMenuBarItemRole_() { return kAXMenuBarItemRole; }+CFStringRef kAXMenuRole_() { return kAXMenuRole; }+CFStringRef kAXMenuItemRole_() { return kAXMenuItemRole; }+CFStringRef kAXSplitGroupRole_() { return kAXSplitGroupRole; }+CFStringRef kAXSplitterRole_() { return kAXSplitterRole; }+CFStringRef kAXColorWellRole_() { return kAXColorWellRole; }+CFStringRef kAXTimeFieldRole_() { return kAXTimeFieldRole; }+CFStringRef kAXDateFieldRole_() { return kAXDateFieldRole; }+CFStringRef kAXHelpTagRole_() { return kAXHelpTagRole; }+CFStringRef kAXMatteRole_() { return kAXMatteRole; }+CFStringRef kAXDockItemRole_() { return kAXDockItemRole; }++CFStringRef kAXCloseButtonSubrole_() { return kAXCloseButtonSubrole; }+CFStringRef kAXMinimizeButtonSubrole_() { return kAXMinimizeButtonSubrole; }+CFStringRef kAXZoomButtonSubrole_() { return kAXZoomButtonSubrole; }+CFStringRef kAXToolbarButtonSubrole_() { return kAXToolbarButtonSubrole; }+CFStringRef kAXSecureTextFieldSubrole_() { return kAXSecureTextFieldSubrole; }+CFStringRef kAXTableRowSubrole_() { return kAXTableRowSubrole; }+CFStringRef kAXOutlineRowSubrole_() { return kAXOutlineRowSubrole; }+CFStringRef kAXUnknownSubrole_() { return kAXUnknownSubrole; }+CFStringRef kAXStandardWindowSubrole_() { return kAXStandardWindowSubrole; }+CFStringRef kAXDialogSubrole_() { return kAXDialogSubrole; }+CFStringRef kAXSystemDialogSubrole_() { return kAXSystemDialogSubrole; }+CFStringRef kAXFloatingWindowSubrole_() { return kAXFloatingWindowSubrole; }+CFStringRef kAXSystemFloatingWindowSubrole_() { return kAXSystemFloatingWindowSubrole; }+CFStringRef kAXIncrementArrowSubrole_() { return kAXIncrementArrowSubrole; }+CFStringRef kAXDecrementArrowSubrole_() { return kAXDecrementArrowSubrole; }+CFStringRef kAXIncrementPageSubrole_() { return kAXIncrementPageSubrole; }+CFStringRef kAXDecrementPageSubrole_() { return kAXDecrementPageSubrole; }+CFStringRef kAXSortButtonSubrole_() { return kAXSortButtonSubrole; }+CFStringRef kAXSearchFieldSubrole_() { return kAXSearchFieldSubrole; }+CFStringRef kAXApplicationDockItemSubrole_() { return kAXApplicationDockItemSubrole; }+CFStringRef kAXDocumentDockItemSubrole_() { return kAXDocumentDockItemSubrole; }+CFStringRef kAXFolderDockItemSubrole_() { return kAXFolderDockItemSubrole; }+CFStringRef kAXMinimizedWindowDockItemSubrole_() { return kAXMinimizedWindowDockItemSubrole; }+CFStringRef kAXURLDockItemSubrole_() { return kAXURLDockItemSubrole; }+CFStringRef kAXDockExtraDockItemSubrole_() { return kAXDockExtraDockItemSubrole; }+CFStringRef kAXTrashDockItemSubrole_() { return kAXTrashDockItemSubrole; }+CFStringRef kAXProcessSwitcherListSubrole_() { return kAXProcessSwitcherListSubrole; }
+ cbits/functions.m view
@@ -0,0 +1,45 @@+#include <Carbon/Carbon.h>++CGError CGWarpMouseCursorPosition_(CGPoint *pos) {+  return CGWarpMouseCursorPosition(*pos);+}++CGEventRef CGEventCreateMouseEvent_(+  CGEventSourceRef source,+  CGEventType mouseType,+  CGPoint *position,+  CGMouseButton mouseButton) {+  return CGEventCreateMouseEvent(source, mouseType, *position, mouseButton);+}++typedef int CGSConnectionID;++extern CGSConnectionID _CGSDefaultConnection(void);+#define CGSDefaultConnection _CGSDefaultConnection()++extern CFStringRef CGSCopyManagedDisplayForWindow(+  const CGSConnectionID Connection, uint32_t WindowId);++void cgDisplayBounds_(uint32_t d_id, CGRect *rect)+{ *rect = CGDisplayBounds(d_id); }++CFStringRef display_for_window(uint32_t window) {+  return CGSCopyManagedDisplayForWindow(CGSDefaultConnection, window);+}++bool get_isback(ProcessSerialNumber *psn) {+  ProcessInfoRec ProcessInfo = {};+  ProcessInfo.processInfoLength = sizeof(ProcessInfoRec);+  GetProcessInformation(psn, &ProcessInfo);+  return (ProcessInfo.processMode & modeOnlyBackground) != 0;+}++typedef OSStatus (carbon_event_callback_t)+  (EventHandlerCallRef HandlerCallRef, EventRef Event, void *Refcon);++EventHandlerUPP handler_upp(carbon_event_callback_t *callb) {+  return NewEventHandlerUPP(callb); }++CGEventMask event_type_to_mask_bit(CGEventType ety) {+  return CGEventMaskBit(ety);+}
+ macos-corelibs.cabal view
@@ -0,0 +1,106 @@+name:           macos-corelibs+version:        0.0.1.0+synopsis:       Haskell bindings to C-based Mac OS SDK frameworks+description:    Type-safe Haskell bindings to C-based frameworks of the Apple+                Mac OS SDK, including CoreFoundation, CoreGraphics, and Carbon+                Accessibility APIs. Please see the README on Github for more+                information.+category:       System+author:         Filippo Sestini+copyright:      2018 Filippo Sestini+maintainer:     sestini.filippo@gmail.com+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  2.0++extra-source-files:+    cbits/constants.m+    cbits/functions.m+    README+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/fsestini/macos-corelibs++library+  exposed-modules:+      MacSdk+      MacSdk.Framework.Accessibility+      MacSdk.Framework.Accessibility.Action+      MacSdk.Framework.Accessibility.Attribute+      MacSdk.Framework.Accessibility.Attribute.Types+      MacSdk.Framework.Accessibility.Error+      MacSdk.Framework.Accessibility.Observer+      MacSdk.Framework.Accessibility.Role+      MacSdk.Framework.Accessibility.Types+      MacSdk.Framework.Accessibility.UIElement+      MacSdk.Framework.Accessibility.UINotification+      MacSdk.Framework.Accessibility.Value+      MacSdk.Framework.CoreFoundation+      MacSdk.Framework.CoreFoundation.Allocator+      MacSdk.Framework.CoreFoundation.Array+      MacSdk.Framework.CoreFoundation.Boolean+      MacSdk.Framework.CoreFoundation.Dictionary+      MacSdk.Framework.CoreFoundation.Number+      MacSdk.Framework.CoreFoundation.Object+      MacSdk.Framework.CoreFoundation.RunLoop+      MacSdk.Framework.CoreFoundation.String+      MacSdk.Framework.CoreFoundation.UUID+      MacSdk.Framework.CoreGraphics+      MacSdk.Framework.CoreGraphics.Connection+      MacSdk.Framework.CoreGraphics.Display+      MacSdk.Framework.CoreGraphics.Dock+      MacSdk.Framework.CoreGraphics.Error+      MacSdk.Framework.CoreGraphics.Event+      MacSdk.Framework.CoreGraphics.Event.Field+      MacSdk.Framework.CoreGraphics.Event.Flag+      MacSdk.Framework.CoreGraphics.Event.Location+      MacSdk.Framework.CoreGraphics.Event.Mask+      MacSdk.Framework.CoreGraphics.Event.Type+      MacSdk.Framework.CoreGraphics.Mouse+      MacSdk.Framework.CoreGraphics.Rect+      MacSdk.Framework.CoreGraphics.Space+      MacSdk.Framework.CoreGraphics.Window+      MacSdk.Framework.CoreGraphics.Window.Types+      MacSdk.Framework.Types+      MacSdk.Prism+  other-modules:+      Paths_macos_corelibs+  autogen-modules:+      Paths_macos_corelibs+  hs-source-dirs:+      src+  default-extensions:+      RecordWildCards+      TupleSections+      LambdaCase+      GeneralizedNewtypeDeriving+  ghc-options:+      -Wall+      -Wno-unused-top-binds+      -Wcompat+      -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wredundant-constraints+      -Wno-unticked-promoted-constructors+      -- -Werror+  cc-options: -Wno-deprecated -Wno-int-to-void-pointer-cast+  include-dirs:+      cbits+  c-sources:+      cbits/constants.m+      cbits/functions.m+  frameworks:+      Carbon, Cocoa+  build-depends:+      base >=4.7 && <5+    , containers          >= 0.6.0 && < 0.7+    , managed             >= 1.0.6 && < 1.1+    , transformers        >= 0.5.5 && < 0.6+    , mtl                 >= 2.2.2 && < 2.3+    , profunctors         >= 5.3 && < 5.4+    , tagged              >= 0.8.6 && < 0.9++  default-language: Haskell2010
+ src/MacSdk.hs view
@@ -0,0 +1,11 @@+module MacSdk+  ( module MacSdk.Framework.CoreGraphics+  , module MacSdk.Framework.CoreFoundation+  , module MacSdk.Framework.Accessibility+  , module MacSdk.Framework.Types+  ) where++import MacSdk.Framework.CoreGraphics+import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.Accessibility+import MacSdk.Framework.Types
+ src/MacSdk/Framework/Accessibility.hs view
@@ -0,0 +1,45 @@+module MacSdk.Framework.Accessibility+  ( module MacSdk.Framework.Accessibility.Action+  , module MacSdk.Framework.Accessibility.Attribute+  , module MacSdk.Framework.Accessibility.Error+  , module MacSdk.Framework.Accessibility.Observer+  , module MacSdk.Framework.Accessibility.UIElement+  , module MacSdk.Framework.Accessibility.UINotification+  , module MacSdk.Framework.Accessibility.Value+  , trustedCheckOptionPrompt+  , isProcessTrustedWithOptions+  , checkAXPrivileges+  ) where++import MacSdk.Framework.Accessibility.Action+import MacSdk.Framework.Accessibility.Attribute+import MacSdk.Framework.Accessibility.Error (AXError(..), AsAXError(..))+import MacSdk.Framework.Accessibility.Observer+import MacSdk.Framework.Accessibility.UIElement+import MacSdk.Framework.Accessibility.UINotification+import MacSdk.Framework.Accessibility.Value++import MacSdk.Framework.CoreFoundation+import Foreign+import Foreign.C.Types (CBool(..))++foreign import ccall unsafe axTrustedCheckOptionPrompt :: IO CFStringRef++trustedCheckOptionPrompt :: IO CFString+trustedCheckOptionPrompt = axTrustedCheckOptionPrompt >>= manageCFObj++foreign import ccall unsafe "AXIsProcessTrustedWithOptions"+  axIsProcessTrustedWithOptions :: Ptr () -> IO CBool++isProcessTrustedWithOptions :: Dictionary -> IO Bool+isProcessTrustedWithOptions =+  fmap Foreign.toBool . flip withCFPtr (axIsProcessTrustedWithOptions . castPtr)++-- | Check whether the current process has been granted Accessibility privileges+-- by the operating system.+checkAXPrivileges :: IO Bool+checkAXPrivileges = do+  allo <- nullAllocator+  s <- trustedCheckOptionPrompt+  b <- booleanTrue+  createDictionary allo [s] [b] >>= isProcessTrustedWithOptions
+ src/MacSdk/Framework/Accessibility/Action.hs view
@@ -0,0 +1,60 @@+module MacSdk.Framework.Accessibility.Action where++import MacSdk.Framework.Accessibility.Error+import MacSdk.Framework.Accessibility.UIElement+import MacSdk.Framework.Accessibility.Types+import MacSdk.Framework.CoreFoundation++import Foreign hiding (with)+import Foreign.C.Types (CInt(..))++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Managed++foreign import ccall unsafe "Carbon/Carbon.h AXUIElementPerformAction"+  ax_ui_element_perform_action+  :: AXUIElementRef -> CFStringRef -> IO ForeignAXError++foreign import ccall unsafe ax_press_action :: IO CFStringRef++-- actionString :: AXAction -> IO CFStringRef+-- actionString AXPressAction = ax_press_action++-- axUIElementPerformAction :: AXUIElementRef -> AXAction -> IO AXResult+-- axUIElementPerformAction ref =+--   actionString >=> fmap toAXResult . ax_ui_element_perform_action ref++-- axUIElementPerformAction'+--   :: MonadError' AXError m => AXUIElementRef -> AXAction -> m ()+-- axUIElementPerformAction' ref = resultAction . axUIElementPerformAction ref++-- performAction :: (MonadIO m, MonadError' AXError m) => UIElement -> AXAction -> m ()+-- performAction el =+--   except . liftIO . withCFPtr el .+--   flip (\ref -> actionString >=> fmap toAXResult . ax_ui_element_perform_action ref)++performAction+  :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> CFStringRef -> m ()+performAction el str = except . liftIO . withCFPtr el $ \p ->+  fmap toAXResult (ax_ui_element_perform_action p str)++-- | Performs the action of pressing a button.+actionPress :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> m ()+actionPress b = liftIO ax_press_action >>= performAction b++foreign import ccall unsafe "AXUIElementCopyActionNames"+  axUIElementCopyActionNames+  :: AXUIElementRef -> Ptr CFArrayRef -> IO ForeignAXError++-- | Returns a list of all the actions the specified accessibility object can+-- perform.+copyActionNames+  :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> m (Array CFString)+copyActionNames el = fmap Array . except . liftIO . flip with pure $ do+  elptr <- managed (withCFPtr el)+  arrptr <- managed alloca+  liftIO $ do+    err <- axUIElementCopyActionNames elptr arrptr+    either (pure . Left) (const (peek arrptr >>= fmap Right . manageCFObj))+      (toAXResult err)+
+ src/MacSdk/Framework/Accessibility/Attribute.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE KindSignatures #-}++module MacSdk.Framework.Accessibility.Attribute+  ( Attribute(..)+  , setAttribute+  , attributeValue+  , isAttributeSettable+  , role+  , subrole+  , copyAttributeNames+  , Role(..)+  , Subrole(..)+  ) where++import Control.Monad.Managed+import Control.Monad.Except+import Foreign hiding (with)+import Foreign.C.Types (CInt(..), CBool(..))+import MacSdk.Framework.Accessibility.Error+import MacSdk.Framework.Accessibility.UIElement+import MacSdk.Framework.Accessibility.Types+import MacSdk.Framework.Accessibility.Role+import MacSdk.Framework.Accessibility.Attribute.Types+import MacSdk.Framework.CoreFoundation++--------------------------------------------------------------------------------++foreign import ccall "Carbon/Carbon.h AXUIElementSetAttributeValue"+  ax_ui_element_set_attribute_value+  :: AXUIElementRef -> CFStringRef -> CFTypeRef -> IO ForeignAXError++setAttribute+  :: (MonadIO m, MonadError e m, AsAXError e)+  => UIElement -> Attribute a -> a -> m ()+setAttribute el at ob = except . liftIO $ withCFPtr el $ \el' -> do+  str <- liftIO $ toAttributeString' at+  p <- fst (attrGetterSetter at) ob+  fmap toAXResult (ax_ui_element_set_attribute_value el' str p)++--------------------------------------------------------------------------------++foreign import ccall "Carbon/Carbon.h AXUIElementCopyAttributeValue"+  ax_ui_element_copy_attribute_value+  :: AXUIElementRef -> CFStringRef -> Ptr CFTypeRef -> IO ForeignAXError++-- | Retrieves the role of a UIElement.+--+-- @+-- role = flip attributeValue RoleAttribute+-- @+role :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> m Role+role = flip attributeValue RoleAttribute++-- | Retrieves the subrole of a UIElement.+--+-- @+-- subrole = flip attributeValue SubroleAttribute+-- @+subrole :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> m Subrole+subrole = flip attributeValue SubroleAttribute++attributeValue+  :: (MonadIO m, MonadError e m, AsAXError e)+  => UIElement -> Attribute a -> m a+attributeValue uiel attr = except . liftIO . flip with pure $ do+  el <- managed (withCFPtr uiel)+  p <- managed alloca+  liftIO $ do+    str <- toAttributeString' attr+    res <- ax_ui_element_copy_attribute_value el str p+    either (pure . Left)+           (const (peek p >>= fmap Right . snd (attrGetterSetter attr)))+           (toAXResult res)++safeAttributeValue+  :: (MonadError e m, AsAXError e, MonadIO m)+  => UIElement -> Attribute a -> m (Maybe a)+safeAttributeValue el attr = do+  eith <- runExceptT (attributeValue el attr)+  case eith of+    Left AXErrorNoValue -> pure Nothing+    Left e -> throwing _AXError e+    Right x -> pure (Just x)++--------------------------------------------------------------------------------++foreign import ccall unsafe "Carbon/Carbon.h AXUIElementIsAttributeSettable"+  ax_ui_element_is_attribute_settable+  :: AXUIElementRef -> CFStringRef -> Ptr CBool -> IO ForeignAXError++axUIElementIsAttributeSettable+  :: AXUIElementRef -> Attribute a -> IO (Either AXError CBool)+axUIElementIsAttributeSettable ref a = do+  str <- toAttributeString' a+  alloca $ \p -> do+    err <- poke p (Foreign.fromBool False) >>+      ax_ui_element_is_attribute_settable ref str p+    res <- peek p+    pure (either Left (const (Right res)) (toAXResult err))++isAttributeSettable+  :: (MonadIO m, MonadError e m, AsAXError e)+  => UIElement -> Attribute a -> m Bool+isAttributeSettable el =+  fmap Foreign.toBool . except . liftIO . withCFPtr el .+    flip axUIElementIsAttributeSettable++foreign import ccall unsafe "AXUIElementCopyAttributeNames"+  axUIElementCopyAttributeNames+  :: AXUIElementRef -> Ptr CFArrayRef -> IO ForeignAXError++-- | Returns a list of all the attributes supported by the specified+-- accessibility object.+copyAttributeNames+  :: (MonadIO m, MonadError e m, AsAXError e)+  => UIElement -> m (Array CFString)+copyAttributeNames el = fmap Array . except . liftIO . flip with pure $ do+  elptr <- managed (withCFPtr el)+  arrptr <- managed alloca+  liftIO $ do+    err <- axUIElementCopyAttributeNames elptr arrptr+    either (pure . Left) (const (peek arrptr >>= fmap Right . manageCFObj))+      (toAXResult err)
+ src/MacSdk/Framework/Accessibility/Attribute/Types.hs view
@@ -0,0 +1,811 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE KindSignatures #-}++module MacSdk.Framework.Accessibility.Attribute.Types where++import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.Accessibility.Role+import MacSdk.Framework.Accessibility.UIElement+import MacSdk.Framework.CoreGraphics.Rect++import Foreign (castPtr)+import Control.Monad.Trans.Maybe+import Control.Monad (msum, join, (<=<))+import Data.Maybe (fromMaybe)+import Data.Bifunctor (bimap)++data Attribute :: * -> * where+  -- | The role, or type, of this accessibility object (for example, AXButton).+  -- This string is for identification purposes only and does not need to be+  -- localized. All accessibility objects must include this attribute.+  RoleAttribute :: Attribute Role+  SubroleAttribute :: Attribute Subrole+  RoleDescriptionAttribute :: Attribute CFObject+  -- | A localized string containing help text for this accessibility object. An+  -- accessibility object that provides help information should include this+  -- attribute.+  HelpAttribute :: Attribute CFObject+  TitleAttribute :: Attribute CFString+  ValueAttribute :: Attribute CFObject+  -- | The minimum value this accessibility object can display (for example, the+  -- minimum value of a scroller control). This attribute is used only in+  -- conjunction with the AXValue attribute.+  MinValueAttribute :: Attribute CFObject+  -- | The maximum value this accessibility object can display (for example, the+  -- maximum value of a scroller control). This attribute is used only in+  -- conjunction with the AXValue attribute.+  MaxValueAttribute :: Attribute CFObject+  -- | The amount an accessibility object’s value changes as the result of a+  -- single action (for example, how far a scroller travels with one mouse+  -- click). This attribute is used only in conjunction with the AXValue+  -- attribute.+  ValueIncrementAttribute :: Attribute CFObject+  AllowedValuesAttribute :: Attribute CFObject+  EnabledAttribute :: Attribute CFObject+  FocusedAttribute :: Attribute Bool+  -- | This accessibility object’s parent object in the accessibility hierarchy.+  -- This attribute is required for all accessibility objects except the+  -- application-level accessibility object.+  ParentAttribute :: Attribute UIElement+  ChildrenAttribute :: Attribute CFObject+  SelectedChildrenAttribute :: Attribute CFObject+  VisibleChildrenAttribute :: Attribute CFObject+  WindowAttribute :: Attribute CFObject+  PositionAttribute :: Attribute Point+  TopLevelUIElementAttribute :: Attribute UIElement+  -- | The vertical and horizontal dimensions of this accessibility object. This+  -- attribute is required for all accessibility objects that are visible on the+  -- screen.+  SizeAttribute :: Attribute Size+  OrientationAttribute :: Attribute CFObject+  DescriptionAttribute :: Attribute CFObject+  -- | The currently selected text within this accessibility object. This+  -- attribute is required for all accessibility objects that represent editable+  -- text elements.+  SelectedTextAttribute :: Attribute CFObject+  -- | Indicates the range of characters (not bytes) that defines the currently+  -- selected text within this accessibility object. This attribute is required+  -- for all accessibility objects that represent editable text elements.+  SelectedTextRangeAttribute :: Attribute CFObject+  VisibleCharacterRangeAttribute :: Attribute CFObject+  -- | The total number of characters (not bytes) in the editable text element+  -- represented by this accessibility object. This attribute is required for+  -- all accessibility objects that represent editable text elements.+  NumberOfCharactersAttribute :: Attribute CFObject+  SharedTextUIElementsAttribute :: Attribute CFObject+  SharedCharacterRangeAttribute :: Attribute CFObject+  MainAttribute :: Attribute Bool+  -- | Indicates whether the window represented by this accessibility object is+  -- currently minimized in the Dock. This attribute is recommended for all+  -- accessibility objects that represent windows that can be minimized.+  MinimizedAttribute :: Attribute Bool+  CloseButtonAttribute :: Attribute UIElement+  ZoomButtonAttribute :: Attribute UIElement+  MinimizeButtonAttribute :: Attribute UIElement+  ToolbarButtonAttribute :: Attribute UIElement+  GrowAreaAttribute :: Attribute CFObject+  ProxyAttribute :: Attribute CFObject+  -- | Indicates whether the window represented by this accessibility object is+  -- modal. This attribute is recommended for all accessibility objects that+  -- represent windows.+  ModalAttribute :: Attribute CFObject+  DefaultButtonAttribute :: Attribute CFObject+  CancelButtonAttribute :: Attribute CFObject+  -- | The primary key in the keyboard shortcut for the command represented by+  -- this accessibility object. For example, “O” is the primary key in the+  -- keyboard shortcut for the Open command.+  MenuItemCmdCharAttribute :: Attribute CFObject+  MenuItemCmdVirtualKeyAttribute :: Attribute CFObject+  MenuItemCmdGlyphAttribute :: Attribute CFObject+  -- | An integer mask that represents the modifier keys held down in the+  -- keyboard shortcut for the command represented by this accessibility object.+  MenuItemCmdModifiersAttribute :: Attribute CFObject+  MenuItemMarkCharAttribute :: Attribute CFObject+  MenuItemPrimaryUIElementAttribute :: Attribute CFObject+  MenuBarAttribute :: Attribute CFObject+  -- | An array of accessibility objects representing this application’s+  -- windows. This attribute is recommended for all application-level+  -- accessibility objects.+  WindowsAttribute :: Attribute (Array UIElement)+  -- | Indicates whether the application represented by this accessibility+  -- object is active. This attribute is recommended for all application-level+  -- accessibility objects.+  FrontmostAttribute :: Attribute CFObject+  -- | Indicates whether the application represented by this accessibility+  -- object is hidden. This attribute is recommended for all application-level+  -- accessibility objects.+  HiddenAttribute :: Attribute CFObject+  -- | The accessibility object representing this application’s main window.+  -- This attribute is recommended for all application-level accessibility+  -- objects.+  MainWindowAttribute :: Attribute CFObject+  -- | The accessibility object that represents the currently focused window of+  -- this application. This attribute is recommended for all application-level+  -- accessibility objects.+  -- FocusedUIElemenAttribute :: Attribute FocusedUIElemenAttributeTag+  -- The accessibility object that represents the currently focused user+  -- interface element in this application. This attribute is recommended for+  -- all application-level accessibility objects.+  FocusedWindowAttribute :: Attribute UIElement+  HeaderAttribute :: Attribute CFObject+  EditedAttribute :: Attribute CFObject+  -- | An accessibility object that represents a static text title associated+  -- with another accessibility object.+  TitleUIElementAttribute :: Attribute CFObject+  -- | Indicates whether the value displayed in the user interface element+  -- represented by this accessibility object wraps around.+  ValueWrapsAttribute :: Attribute CFObject+  TabsAttribute :: Attribute CFObject+  HorizontalScrollBarAttribute :: Attribute CFObject+  VerticalScrollBarAttribute :: Attribute CFObject+  -- | Identifies which child of an accessibility object representing a toolbar+  -- is the overflow button (if any). This attribute is optional.+  OverflowButtonAttribute :: Attribute CFObject+  -- | The filename associated with this accessibility object. This attribute is+  -- optional.+  FilenameAttribute :: Attribute CFObject+  -- | Indicates whether the menu displayed by the combo box or pop-up menu+  -- represented by this accessibility object is currently expanded. This+  -- attribute is recommended for all accessibility objects that display a+  -- pop-up menu.+  ExpandedAttribute :: Attribute CFObject+  -- | Indicates whether the row or column element represented by this+  -- accessibility object is selected. This attribute is recommended for all+  -- accessibility objects that represent selectable rows or columns.+  SelectedAttribute :: Attribute CFObject+  -- | An array of views and splitter bar elements displayed by the split view+  -- represented by this accessibility object. This is a convenience attribute+  -- that helps an assistive application easily find these elements.+  SplittersAttribute :: Attribute CFObject+  NextContentsAttribute :: Attribute CFObject+  PreviousContentsAttribute :: Attribute CFObject+  -- | The URL of the open document represented by this accessibility object.+  -- This attribute represents the URL as a string object.+  DocumentAttribute :: Attribute CFObject+  IncrementButtonAttribute :: Attribute CFObject+  -- | The decrement element associated with the user interface object this+  -- accessibility object represents. This attribute can be used to provide+  -- convenient access to the decrement area of a custom user interface object.+  DecrementButtonAttribute :: Attribute CFObject+  ContentsAttribute :: Attribute CFObject+  -- | The incrementor of a time or date field represented by this accessibility+  -- object. This attribute is required for accessibility objects that represent+  -- time or date field elements that display an incrementor.+  IncrementorAttribute :: Attribute CFObject+  -- | The hour field of a time field represented by this accessibility object.+  -- This attribute is required for accessibility objects that represent time+  -- fields that display hours.+  HourFieldAttribute :: Attribute CFObject+  -- | The minute field of a time field represented by this accessibility+  -- object. This attribute is required for accessibility objects that represent+  -- time fields that display minutes.+  MinuteFieldAttribute :: Attribute CFObject+  -- | The second field of a time field represented by this accessibility+  -- object. This attribute is required for accessibility objects that represent+  -- time fields that display seconds.+  SecondFieldAttribute :: Attribute CFObject+  -- | The AM/PM field of a time field represented by this accessibility object.+  -- This attribute is required for accessibility objects that represent time+  -- fields that display AM/PM settings.+  AMPMFieldAttribute :: Attribute CFObject+  -- | The day field of a time field represented by this accessibility object.+  -- This attribute is required for accessibility objects that represent time+  -- fields that display days.+  DayFieldAttribute :: Attribute CFObject+  -- | The month field of a time field represented by this accessibility object.+  -- This attribute is required for accessibility objects that represent time+  -- fields that display months.+  MonthFieldAttribute :: Attribute CFObject+  -- | The year field of a time field represented by this accessibility object.+  -- This attribute is required for accessibility objects that represent time+  -- fields that display years.+  YearFieldAttribute :: Attribute CFObject+  ColumnTitleAttribute :: Attribute CFObject+  -- | The URL that describes the location of the document or application+  -- represented by this accessibility object.+  URLAttribute :: Attribute CFObject+  LabelUIElementsAttribute :: Attribute CFObject+  -- | The value of the label represented by this accessibility object. This+  -- attribute is required for all accessibility objects that represent labels.+  LabelValueAttribute :: Attribute CFObject+  -- | An array of accessibility objects that represent the contextual or Dock+  -- menus provided by this accessibility object.+  ShownMenuUIElementAttribute :: Attribute CFObject+  ServesAsTitleForUIElementsAttribute :: Attribute CFObject+  LinkedUIElementsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the rows in this table+  -- or outline view.+  RowsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the currently visible+  -- rows in this table or outline view.+  VisibleRowsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the currently selected+  -- rows in this table or outline view.+  SelectedRowsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the columns in this+  -- browser view.+  ColumnsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the currently visible+  -- columns in this browser view.+  VisibleColumnsAttribute :: Attribute CFObject+  -- | An array of the accessibility objects representing the currently selected+  -- columns in this browser view.+  SelectedColumnsAttribute :: Attribute CFObject+  -- | The sort direction of this accessibility object’s contents. For example,+  -- a list view’s contents may be sorted in ascending or descending order.+  SortDirectionAttribute :: Attribute CFObject+  -- | An array of accessibility objects representing the column headers of this+  -- table or browser view.+  ColumnHeaderUIElementsAttribute :: Attribute CFObject+  -- | The index of the row or column represented by this accessibility object.+  IndexAttribute :: Attribute CFObject+  -- | Indicates whether a row in an outline view represented by this+  -- accessibility object has an open or closed disclosure triangle. true+  -- indicates an open disclosure triangle; false indicates a closed disclosure+  -- triangle.+  DisclosingAttribute :: Attribute CFObject+  -- | An array of accessibility objects representing the disclosed rows of this+  -- user interface element.+  DisclosedRowsAttribute :: Attribute CFObject+  -- | The accessibility object representing the disclosing row.+  DisclosedByRowAttribute :: Attribute CFObject+  -- | The accessibility object that represents the area available to the user+  -- through the matte hole.+  MatteHoleAttribute :: Attribute CFObject+  -- | The accessibility object clipped by the matte.+  MatteContentUIElementAttribute :: Attribute CFObject+  -- | Indicates if the application represented by the Dock icon this+  -- accessibility object represents is currently running.+  IsApplicationRunningAttribute :: Attribute CFObject+  FocusedApplicationAttribute :: Attribute CFObject+  -- | The line number of the insertion point in the text associated with this+  -- accessibility object.+  InsertionPointLineNumberAttribute :: Attribute CFObject++deriving instance Show (Attribute tag)++foreign import ccall unsafe kAXRoleAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSubroleAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXRoleDescriptionAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXHelpAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXTitleAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXValueAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMinValueAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMaxValueAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXValueIncrementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXAllowedValuesAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXEnabledAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXFocusedAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXParentAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXChildrenAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedChildrenAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXVisibleChildrenAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXWindowAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXPositionAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXTopLevelUIElementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSizeAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXOrientationAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDescriptionAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedTextAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedTextRangeAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXVisibleCharacterRangeAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXNumberOfCharactersAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSharedTextUIElementsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSharedCharacterRangeAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMainAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMinimizedAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXCloseButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXZoomButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMinimizeButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXToolbarButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXGrowAreaAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXProxyAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXModalAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDefaultButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXCancelButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemCmdCharAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemCmdVirtualKeyAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemCmdGlyphAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemCmdModifiersAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemMarkCharAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemPrimaryUIElementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuBarAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXWindowsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXFrontmostAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXHiddenAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMainWindowAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXFocusedWindowAttribute_ :: IO CFStringRef+-- foreign import ccall unsafe kAXFocusedUIElemenAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXHeaderAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXEditedAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXTitleUIElementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXValueWrapsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXTabsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXHorizontalScrollBarAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXVerticalScrollBarAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXOverflowButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXFilenameAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXExpandedAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSplittersAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXNextContentsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXPreviousContentsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDocumentAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXIncrementButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDecrementButtonAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXContentsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXIncrementorAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXHourFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMinuteFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSecondFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXAMPMFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDayFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMonthFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXYearFieldAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXColumnTitleAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXURLAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXLabelUIElementsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXLabelValueAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXShownMenuUIElementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXServesAsTitleForUIElementsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXLinkedUIElementsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXRowsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXVisibleRowsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedRowsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXColumnsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXVisibleColumnsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSelectedColumnsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXSortDirectionAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXColumnHeaderUIElementsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXIndexAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDisclosingAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDisclosedRowsAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXDisclosedByRowAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMatteHoleAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXMatteContentUIElementAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXIsApplicationRunningAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXFocusedApplicationAttribute_ :: IO CFStringRef+foreign import ccall unsafe kAXInsertionPointLineNumberAttribute_ :: IO CFStringRef++toAttributeString :: Attribute a -> IO String+toAttributeString a =+  toAttributeString' a >>= manageCFObj >>=+    fmap (fromMaybe (error "toAttributeString: decoding failed")) .+      toString CFStringEncodingASCII++toAttributeString' :: Attribute a -> IO CFStringRef+toAttributeString' = \case+  RoleAttribute -> kAXRoleAttribute_+  SubroleAttribute -> kAXSubroleAttribute_+  RoleDescriptionAttribute -> kAXRoleDescriptionAttribute_+  HelpAttribute -> kAXHelpAttribute_+  TitleAttribute -> kAXTitleAttribute_+  ValueAttribute -> kAXValueAttribute_+  MinValueAttribute -> kAXMinValueAttribute_+  MaxValueAttribute -> kAXMaxValueAttribute_+  ValueIncrementAttribute -> kAXValueIncrementAttribute_+  AllowedValuesAttribute -> kAXAllowedValuesAttribute_+  EnabledAttribute -> kAXEnabledAttribute_+  FocusedAttribute -> kAXFocusedAttribute_+  ParentAttribute -> kAXParentAttribute_+  ChildrenAttribute -> kAXChildrenAttribute_+  SelectedChildrenAttribute -> kAXSelectedChildrenAttribute_+  VisibleChildrenAttribute -> kAXVisibleChildrenAttribute_+  WindowAttribute -> kAXWindowAttribute_+  PositionAttribute -> kAXPositionAttribute_+  TopLevelUIElementAttribute -> kAXTopLevelUIElementAttribute_+  SizeAttribute -> kAXSizeAttribute_+  OrientationAttribute -> kAXOrientationAttribute_+  DescriptionAttribute -> kAXDescriptionAttribute_+  SelectedTextAttribute -> kAXSelectedTextAttribute_+  SelectedTextRangeAttribute -> kAXSelectedTextRangeAttribute_+  VisibleCharacterRangeAttribute -> kAXVisibleCharacterRangeAttribute_+  NumberOfCharactersAttribute -> kAXNumberOfCharactersAttribute_+  SharedTextUIElementsAttribute -> kAXSharedTextUIElementsAttribute_+  SharedCharacterRangeAttribute -> kAXSharedCharacterRangeAttribute_+  MainAttribute -> kAXMainAttribute_+  MinimizedAttribute -> kAXMinimizedAttribute_+  CloseButtonAttribute -> kAXCloseButtonAttribute_+  ZoomButtonAttribute -> kAXZoomButtonAttribute_+  MinimizeButtonAttribute -> kAXMinimizeButtonAttribute_+  ToolbarButtonAttribute -> kAXToolbarButtonAttribute_+  GrowAreaAttribute -> kAXGrowAreaAttribute_+  ProxyAttribute -> kAXProxyAttribute_+  ModalAttribute -> kAXModalAttribute_+  DefaultButtonAttribute -> kAXDefaultButtonAttribute_+  CancelButtonAttribute -> kAXCancelButtonAttribute_+  MenuItemCmdCharAttribute -> kAXMenuItemCmdCharAttribute_+  MenuItemCmdVirtualKeyAttribute -> kAXMenuItemCmdVirtualKeyAttribute_+  MenuItemCmdGlyphAttribute -> kAXMenuItemCmdGlyphAttribute_+  MenuItemCmdModifiersAttribute -> kAXMenuItemCmdModifiersAttribute_+  MenuItemMarkCharAttribute -> kAXMenuItemMarkCharAttribute_+  MenuItemPrimaryUIElementAttribute -> kAXMenuItemPrimaryUIElementAttribute_+  MenuBarAttribute -> kAXMenuBarAttribute_+  WindowsAttribute -> kAXWindowsAttribute_+  FrontmostAttribute -> kAXFrontmostAttribute_+  HiddenAttribute -> kAXHiddenAttribute_+  MainWindowAttribute -> kAXMainWindowAttribute_+  FocusedWindowAttribute -> kAXFocusedWindowAttribute_+  -- FocusedUIElemenAttribute -> kAXFocusedUIElemenAttribute_+  HeaderAttribute -> kAXHeaderAttribute_+  EditedAttribute -> kAXEditedAttribute_+  TitleUIElementAttribute -> kAXTitleUIElementAttribute_+  ValueWrapsAttribute -> kAXValueWrapsAttribute_+  TabsAttribute -> kAXTabsAttribute_+  HorizontalScrollBarAttribute -> kAXHorizontalScrollBarAttribute_+  VerticalScrollBarAttribute -> kAXVerticalScrollBarAttribute_+  OverflowButtonAttribute -> kAXOverflowButtonAttribute_+  FilenameAttribute -> kAXFilenameAttribute_+  ExpandedAttribute -> kAXExpandedAttribute_+  SelectedAttribute -> kAXSelectedAttribute_+  SplittersAttribute -> kAXSplittersAttribute_+  NextContentsAttribute -> kAXNextContentsAttribute_+  PreviousContentsAttribute -> kAXPreviousContentsAttribute_+  DocumentAttribute -> kAXDocumentAttribute_+  IncrementButtonAttribute -> kAXIncrementButtonAttribute_+  DecrementButtonAttribute -> kAXDecrementButtonAttribute_+  ContentsAttribute -> kAXContentsAttribute_+  IncrementorAttribute -> kAXIncrementorAttribute_+  HourFieldAttribute -> kAXHourFieldAttribute_+  MinuteFieldAttribute -> kAXMinuteFieldAttribute_+  SecondFieldAttribute -> kAXSecondFieldAttribute_+  AMPMFieldAttribute -> kAXAMPMFieldAttribute_+  DayFieldAttribute -> kAXDayFieldAttribute_+  MonthFieldAttribute -> kAXMonthFieldAttribute_+  YearFieldAttribute -> kAXYearFieldAttribute_+  ColumnTitleAttribute -> kAXColumnTitleAttribute_+  URLAttribute -> kAXURLAttribute_+  LabelUIElementsAttribute -> kAXLabelUIElementsAttribute_+  LabelValueAttribute -> kAXLabelValueAttribute_+  ShownMenuUIElementAttribute -> kAXShownMenuUIElementAttribute_+  ServesAsTitleForUIElementsAttribute -> kAXServesAsTitleForUIElementsAttribute_+  LinkedUIElementsAttribute -> kAXLinkedUIElementsAttribute_+  RowsAttribute -> kAXRowsAttribute_+  VisibleRowsAttribute -> kAXVisibleRowsAttribute_+  SelectedRowsAttribute -> kAXSelectedRowsAttribute_+  ColumnsAttribute -> kAXColumnsAttribute_+  VisibleColumnsAttribute -> kAXVisibleColumnsAttribute_+  SelectedColumnsAttribute -> kAXSelectedColumnsAttribute_+  SortDirectionAttribute -> kAXSortDirectionAttribute_+  ColumnHeaderUIElementsAttribute -> kAXColumnHeaderUIElementsAttribute_+  IndexAttribute -> kAXIndexAttribute_+  DisclosingAttribute -> kAXDisclosingAttribute_+  DisclosedRowsAttribute -> kAXDisclosedRowsAttribute_+  DisclosedByRowAttribute -> kAXDisclosedByRowAttribute_+  MatteHoleAttribute -> kAXMatteHoleAttribute_+  MatteContentUIElementAttribute -> kAXMatteContentUIElementAttribute_+  IsApplicationRunningAttribute -> kAXIsApplicationRunningAttribute_+  FocusedApplicationAttribute -> kAXFocusedApplicationAttribute_+  InsertionPointLineNumberAttribute -> kAXInsertionPointLineNumberAttribute_++data SomeAttribute = forall tag . SomeAttribute (Attribute tag)++fromAttributeString :: CFStringRef -> IO (Maybe SomeAttribute)+fromAttributeString attr = runMaybeT . msum . fmap MaybeT $+  [ kAXRoleAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute RoleAttribute) else Nothing)+  , kAXSubroleAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SubroleAttribute) else Nothing)+  , kAXRoleDescriptionAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute RoleDescriptionAttribute) else Nothing)+  , kAXHelpAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute HelpAttribute) else Nothing)+  , kAXTitleAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute TitleAttribute) else Nothing)+  , kAXValueAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ValueAttribute) else Nothing)+  , kAXMinValueAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MinValueAttribute) else Nothing)+  , kAXMaxValueAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MaxValueAttribute) else Nothing)+  , kAXValueIncrementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ValueIncrementAttribute) else Nothing)+  , kAXAllowedValuesAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute AllowedValuesAttribute) else Nothing)+  , kAXEnabledAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute EnabledAttribute) else Nothing)+  , kAXFocusedAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute FocusedAttribute) else Nothing)+  , kAXParentAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ParentAttribute) else Nothing)+  , kAXChildrenAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ChildrenAttribute) else Nothing)+  , kAXSelectedChildrenAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedChildrenAttribute) else Nothing)+  , kAXVisibleChildrenAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute VisibleChildrenAttribute) else Nothing)+  , kAXWindowAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute WindowAttribute) else Nothing)+  , kAXPositionAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute PositionAttribute) else Nothing)+  , kAXTopLevelUIElementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute TopLevelUIElementAttribute) else Nothing)+  , kAXSizeAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SizeAttribute) else Nothing)+  , kAXOrientationAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute OrientationAttribute) else Nothing)+  , kAXDescriptionAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DescriptionAttribute) else Nothing)+  , kAXSelectedTextAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedTextAttribute) else Nothing)+  , kAXSelectedTextRangeAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedTextRangeAttribute) else Nothing)+  , kAXVisibleCharacterRangeAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute VisibleCharacterRangeAttribute) else Nothing)+  , kAXNumberOfCharactersAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute NumberOfCharactersAttribute) else Nothing)+  , kAXSharedTextUIElementsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SharedTextUIElementsAttribute) else Nothing)+  , kAXSharedCharacterRangeAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SharedCharacterRangeAttribute) else Nothing)+  , kAXMainAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MainAttribute) else Nothing)+  , kAXMinimizedAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MinimizedAttribute) else Nothing)+  , kAXCloseButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute CloseButtonAttribute) else Nothing)+  , kAXZoomButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ZoomButtonAttribute) else Nothing)+  , kAXMinimizeButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MinimizeButtonAttribute) else Nothing)+  , kAXToolbarButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ToolbarButtonAttribute) else Nothing)+  , kAXGrowAreaAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute GrowAreaAttribute) else Nothing)+  , kAXProxyAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ProxyAttribute) else Nothing)+  , kAXModalAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ModalAttribute) else Nothing)+  , kAXDefaultButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DefaultButtonAttribute) else Nothing)+  , kAXCancelButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute CancelButtonAttribute) else Nothing)+  , kAXMenuItemCmdCharAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemCmdCharAttribute) else Nothing)+  , kAXMenuItemCmdVirtualKeyAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemCmdVirtualKeyAttribute) else Nothing)+  , kAXMenuItemCmdGlyphAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemCmdGlyphAttribute) else Nothing)+  , kAXMenuItemCmdModifiersAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemCmdModifiersAttribute) else Nothing)+  , kAXMenuItemMarkCharAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemMarkCharAttribute) else Nothing)+  , kAXMenuItemPrimaryUIElementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuItemPrimaryUIElementAttribute) else Nothing)+  , kAXMenuBarAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MenuBarAttribute) else Nothing)+  , kAXWindowsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute WindowsAttribute) else Nothing)+  , kAXFrontmostAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute FrontmostAttribute) else Nothing)+  , kAXHiddenAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute HiddenAttribute) else Nothing)+  , kAXMainWindowAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MainWindowAttribute) else Nothing)+  , kAXFocusedWindowAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute FocusedWindowAttribute) else Nothing)+  -- , kAXFocusedUIElemenAttribute_ >>= \str -> cfEqual str attr >>= \b ->+  --     pure (if b then Just (SomeAttribute FocusedUIElemenAttribute) else Nothing)+  , kAXHeaderAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute HeaderAttribute) else Nothing)+  , kAXEditedAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute EditedAttribute) else Nothing)+  , kAXTitleUIElementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute TitleUIElementAttribute) else Nothing)+  , kAXValueWrapsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ValueWrapsAttribute) else Nothing)+  , kAXTabsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute TabsAttribute) else Nothing)+  , kAXHorizontalScrollBarAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute HorizontalScrollBarAttribute) else Nothing)+  , kAXVerticalScrollBarAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute VerticalScrollBarAttribute) else Nothing)+  , kAXOverflowButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute OverflowButtonAttribute) else Nothing)+  , kAXFilenameAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute FilenameAttribute) else Nothing)+  , kAXExpandedAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ExpandedAttribute) else Nothing)+  , kAXSelectedAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedAttribute) else Nothing)+  , kAXSplittersAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SplittersAttribute) else Nothing)+  , kAXNextContentsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute NextContentsAttribute) else Nothing)+  , kAXPreviousContentsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute PreviousContentsAttribute) else Nothing)+  , kAXDocumentAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DocumentAttribute) else Nothing)+  , kAXIncrementButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute IncrementButtonAttribute) else Nothing)+  , kAXDecrementButtonAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DecrementButtonAttribute) else Nothing)+  , kAXContentsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ContentsAttribute) else Nothing)+  , kAXIncrementorAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute IncrementorAttribute) else Nothing)+  , kAXHourFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute HourFieldAttribute) else Nothing)+  , kAXMinuteFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MinuteFieldAttribute) else Nothing)+  , kAXSecondFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SecondFieldAttribute) else Nothing)+  , kAXAMPMFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute AMPMFieldAttribute) else Nothing)+  , kAXDayFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DayFieldAttribute) else Nothing)+  , kAXMonthFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MonthFieldAttribute) else Nothing)+  , kAXYearFieldAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute YearFieldAttribute) else Nothing)+  , kAXColumnTitleAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ColumnTitleAttribute) else Nothing)+  , kAXURLAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute URLAttribute) else Nothing)+  , kAXLabelUIElementsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute LabelUIElementsAttribute) else Nothing)+  , kAXLabelValueAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute LabelValueAttribute) else Nothing)+  , kAXShownMenuUIElementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ShownMenuUIElementAttribute) else Nothing)+  , kAXServesAsTitleForUIElementsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ServesAsTitleForUIElementsAttribute) else Nothing)+  , kAXLinkedUIElementsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute LinkedUIElementsAttribute) else Nothing)+  , kAXRowsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute RowsAttribute) else Nothing)+  , kAXVisibleRowsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute VisibleRowsAttribute) else Nothing)+  , kAXSelectedRowsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedRowsAttribute) else Nothing)+  , kAXColumnsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ColumnsAttribute) else Nothing)+  , kAXVisibleColumnsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute VisibleColumnsAttribute) else Nothing)+  , kAXSelectedColumnsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SelectedColumnsAttribute) else Nothing)+  , kAXSortDirectionAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute SortDirectionAttribute) else Nothing)+  , kAXColumnHeaderUIElementsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute ColumnHeaderUIElementsAttribute) else Nothing)+  , kAXIndexAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute IndexAttribute) else Nothing)+  , kAXDisclosingAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DisclosingAttribute) else Nothing)+  , kAXDisclosedRowsAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DisclosedRowsAttribute) else Nothing)+  , kAXDisclosedByRowAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute DisclosedByRowAttribute) else Nothing)+  , kAXMatteHoleAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MatteHoleAttribute) else Nothing)+  , kAXMatteContentUIElementAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute MatteContentUIElementAttribute) else Nothing)+  , kAXIsApplicationRunningAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute IsApplicationRunningAttribute) else Nothing)+  , kAXFocusedApplicationAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute FocusedApplicationAttribute) else Nothing)+  , kAXInsertionPointLineNumberAttribute_ >>= \str -> cfEqual str attr >>= \b ->+      pure (if b then Just (SomeAttribute InsertionPointLineNumberAttribute) else Nothing)+  ]++attrGetterSetter :: Attribute a -> (a -> IO CFTypeRef, CFTypeRef -> IO a)+attrGetterSetter = \case+  RoleAttribute ->+    (fmap asCFType . toRoleCFStringRef,+     fromRoleCFString <=< manageCFObj . castPtr)+  SubroleAttribute ->+    (fmap asCFType . toSubroleString,+     fromSubroleCFString <=< manageCFObj . castPtr)+  RoleDescriptionAttribute -> cfObj+  HelpAttribute -> cfObj+  TitleAttribute -> cfObjSubty+  ValueAttribute -> cfObj+  MinValueAttribute -> cfObj+  MaxValueAttribute -> cfObj+  ValueIncrementAttribute -> cfObj+  AllowedValuesAttribute -> cfObj+  EnabledAttribute -> cfObj+  FocusedAttribute -> cfBool+  ParentAttribute -> cfObjSubty+  ChildrenAttribute -> cfObj+  SelectedChildrenAttribute -> cfObj+  VisibleChildrenAttribute -> cfObj+  WindowAttribute -> cfObj+  PositionAttribute ->+    ( join . fmap (flip withCFPtr pure) . createCFPoint+    , fmap (fromMaybe (error "failed to cast position attribute")) .+        axValueGetPoint . castPtr)+  TopLevelUIElementAttribute -> cfObjSubty+  SizeAttribute ->+    ( join . fmap (flip withCFPtr pure) . createCFSize+    , fmap (fromMaybe (error "failed to cast size attribute")) .+        axValueGetSize . castPtr)+  OrientationAttribute -> cfObj+  DescriptionAttribute -> cfObj+  SelectedTextAttribute -> cfObj+  SelectedTextRangeAttribute -> cfObj+  VisibleCharacterRangeAttribute -> cfObj+  NumberOfCharactersAttribute -> cfObj+  SharedTextUIElementsAttribute -> cfObj+  SharedCharacterRangeAttribute -> cfObj+  MainAttribute -> cfBool+  MinimizedAttribute -> cfBool+  CloseButtonAttribute -> cfObjSubty+  ZoomButtonAttribute -> cfObjSubty+  MinimizeButtonAttribute -> cfObjSubty+  ToolbarButtonAttribute -> cfObjSubty+  GrowAreaAttribute -> cfObj+  ProxyAttribute -> cfObj+  ModalAttribute -> cfObj+  DefaultButtonAttribute -> cfObjSubty+  CancelButtonAttribute -> cfObjSubty+  MenuItemCmdCharAttribute -> cfObj+  MenuItemCmdVirtualKeyAttribute -> cfObj+  MenuItemCmdGlyphAttribute -> cfObj+  MenuItemCmdModifiersAttribute -> cfObj+  MenuItemMarkCharAttribute -> cfObj+  MenuItemPrimaryUIElementAttribute -> cfObj+  MenuBarAttribute -> cfObj+  WindowsAttribute -> bimap (. getArray) (fmap Array .) cfObjSubty+  FrontmostAttribute -> cfObj+  HiddenAttribute -> cfObj+  MainWindowAttribute -> cfObj+  FocusedWindowAttribute -> cfObjSubty+  HeaderAttribute -> cfObj+  EditedAttribute -> cfObj+  TitleUIElementAttribute -> cfObj+  ValueWrapsAttribute -> cfObj+  TabsAttribute -> cfObj+  HorizontalScrollBarAttribute -> cfObj+  VerticalScrollBarAttribute -> cfObj+  OverflowButtonAttribute -> cfObj+  FilenameAttribute -> cfObj+  ExpandedAttribute -> cfObj+  SelectedAttribute -> cfObj+  SplittersAttribute -> cfObj+  NextContentsAttribute -> cfObj+  PreviousContentsAttribute -> cfObj+  DocumentAttribute -> cfObj+  IncrementButtonAttribute -> cfObj+  DecrementButtonAttribute -> cfObj+  ContentsAttribute -> cfObj+  IncrementorAttribute -> cfObj+  HourFieldAttribute -> cfObj+  MinuteFieldAttribute -> cfObj+  SecondFieldAttribute -> cfObj+  AMPMFieldAttribute -> cfObj+  DayFieldAttribute -> cfObj+  MonthFieldAttribute -> cfObj+  YearFieldAttribute -> cfObj+  ColumnTitleAttribute -> cfObj+  URLAttribute -> cfObj+  LabelUIElementsAttribute -> cfObj+  LabelValueAttribute -> cfObj+  ShownMenuUIElementAttribute -> cfObj+  ServesAsTitleForUIElementsAttribute -> cfObj+  LinkedUIElementsAttribute -> cfObj+  RowsAttribute -> cfObj+  VisibleRowsAttribute -> cfObj+  SelectedRowsAttribute -> cfObj+  ColumnsAttribute -> cfObj+  VisibleColumnsAttribute -> cfObj+  SelectedColumnsAttribute -> cfObj+  SortDirectionAttribute -> cfObj+  ColumnHeaderUIElementsAttribute -> cfObj+  IndexAttribute -> cfObj+  DisclosingAttribute -> cfObj+  DisclosedRowsAttribute -> cfObj+  DisclosedByRowAttribute -> cfObj+  MatteHoleAttribute -> cfObj+  MatteContentUIElementAttribute -> cfObj+  IsApplicationRunningAttribute -> cfObj+  FocusedApplicationAttribute -> cfObj+  InsertionPointLineNumberAttribute -> cfObj+  where+    cfObj :: (CFObject -> IO CFTypeRef, CFTypeRef -> IO CFObject)+    cfObj = (flip withCFPtr pure, manageCFObj)+    cfObjSubty :: CFClass a => (Object a -> IO CFTypeRef, CFTypeRef -> IO (Object a))+    cfObjSubty = (flip withCFPtr (pure . asCFType), manageCFObj . castPtr)+    cfBool = (fmap asCFType . boolToRef, refToBool . castPtr)
+ src/MacSdk/Framework/Accessibility/Error.hsc view
@@ -0,0 +1,86 @@++module MacSdk.Framework.Accessibility.Error+  ( AXError(..)+  , MonadError+  , AsAXError(..)+  , ForeignAXError+  , toAXResult+  , except+  , throwing+  ) where++#include <Carbon/Carbon.h>++import Foreign.C.Types (CInt(..))+import MacSdk.Prism+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad (join)++type ForeignAXError = CInt++data AXError+  = AXErrorAPIDisabled+  -- ^ Assistive applications are not enabled in System Preferences.+  | AXErrorActionUnsupported+  -- ^ The referenced action is not supported. Alternatively, you can return the+  -- eventNotHandledErr error.+  | AXErrorAttributeUnsupported+  -- ^ The referenced attribute is not supported. Alternatively, you can return+  -- the eventNotHandledErr error.+  | AXErrorCannotComplete+  -- ^ A fundamental error has occurred, such as a failure to allocate memory+  -- during processing.+  | AXErrorFailure+  | AXErrorIllegalArgument+  -- ^ The value received in this event is an invalid value for this attribute.+  -- This also applies for invalid parameters in parameterized attributes.+  | AXErrorInvalidUIElement+  -- ^ The accessibility object received in this event is invalid.+  | AXErrorInvalidUIElementObserver+  -- ^ The observer for the accessibility object received in this event is+  -- invalid.+  | AXErrorNoValue+  | AXErrorNotEnoughPrecision+  | AXErrorNotImplemented+  | AXErrorNotificationAlreadyRegistered+  | AXErrorNotificationNotRegistered+  | AXErrorNotificationUnsupported+  | AXErrorParameterizedAttributeUnsupported+  -- ^ The parameterized attribute is not supported. Alternatively, you can+  -- return the eventNotHandledErr error.+  | AXErrorUnrecognized ForeignAXError+  deriving (Eq, Show)++toAXResult :: ForeignAXError -> Either AXError ()+toAXResult e+  | e == (#const kAXErrorAPIDisabled) = Left AXErrorAPIDisabled+  | e == (#const kAXErrorActionUnsupported) = Left AXErrorActionUnsupported+  | e == (#const kAXErrorAttributeUnsupported) = Left AXErrorAttributeUnsupported+  | e == (#const kAXErrorCannotComplete) = Left AXErrorCannotComplete+  | e == (#const kAXErrorFailure) = Left AXErrorFailure+  | e == (#const kAXErrorIllegalArgument) = Left AXErrorIllegalArgument+  | e == (#const kAXErrorInvalidUIElement) = Left AXErrorInvalidUIElement+  | e == (#const kAXErrorInvalidUIElementObserver) =+    Left AXErrorInvalidUIElementObserver+  | e == (#const kAXErrorNoValue) = Left AXErrorNoValue+  | e == (#const kAXErrorNotEnoughPrecision) = Left AXErrorNotEnoughPrecision+  | e == (#const kAXErrorNotImplemented) = Left AXErrorNotImplemented+  | e == (#const kAXErrorNotificationAlreadyRegistered) =+    Left AXErrorNotificationAlreadyRegistered+  | e == (#const kAXErrorNotificationNotRegistered) =+    Left AXErrorNotificationNotRegistered+  | e == (#const kAXErrorNotificationUnsupported) =+    Left AXErrorNotificationUnsupported+  | e == (#const kAXErrorParameterizedAttributeUnsupported) =+    Left AXErrorParameterizedAttributeUnsupported+  | e == (#const kAXErrorSuccess) = Right ()+  | otherwise = Left (AXErrorUnrecognized e)++class AsAXError e where+  _AXError :: Prism' e AXError++instance AsAXError AXError where+  _AXError = id++except :: (MonadError e m, AsAXError e) => m (Either AXError a) -> m a+except = join . fmap (either (throwing _AXError) pure)
+ src/MacSdk/Framework/Accessibility/Observer.hs view
@@ -0,0 +1,157 @@+module MacSdk.Framework.Accessibility.Observer+  ( Observer+  , ObserverCallback+  , observerCreate+  , observerRelease+  , observerStart+  , observerStart'+  , observerStop+  , observerGetRunLoopSource+  -- * Notifications+  , addNotification+  , removeNotification+  ) where++import MacSdk.Framework.Types (PID)+import MacSdk.Framework.Accessibility.Error+import MacSdk.Framework.Accessibility.UIElement+import MacSdk.Framework.Accessibility.UINotification+import MacSdk.Framework.Accessibility.Types+import MacSdk.Framework.CoreFoundation++import Control.Monad.Managed+import Control.Monad ((>=>))+import Foreign hiding (with)+import Foreign.C.Types (CInt(..))+import Prelude hiding (String)+import Data.IORef++data AXObserver+type AXObserverRef = Ptr AXObserver+data Observer = Observer+  { _obsObj :: Object AXObserver+  , _obsRef :: Ref+  , _obsCallb :: FunPtr AXObserverCallback+  , _obsElems :: IORef [(UINotification, Ref)]+  }+instance CFClass AXObserver++foreign import ccall "wrapper"+  wrap_observer_callback :: AXObserverCallback -> IO (FunPtr AXObserverCallback)++foreign import ccall "Carbon/Carbon.h AXObserverCreate"+  ax_observer_create+  :: PID -> FunPtr AXObserverCallback -> Ptr AXObserverRef -> IO ForeignAXError++type AXObserverCallback =+  AXObserverRef -> AXUIElementRef -> CFStringRef -> StablePtr () -> IO ()++type ObserverCallback =+  -- Observer ->+  UIElement -> UINotification -> StablePtr () -> IO ()++toAXCallback :: ObserverCallback -> AXObserverCallback+toAXCallback f _ el str ptr = do+  el'  <- retainManageCFObj el+  mNotif <- toNotif str+  maybe (pure ()) (\notif -> f el' notif ptr) mNotif++-- | Creates an observer for the application with specified PID.+--+-- Note that this does not start the observer. Refer to 'observerStart' for+-- this.+--+-- Observers that are not longer useful must be released with 'observerRelease'+-- to avoid memory leaks.+observerCreate+  :: (MonadIO m, MonadError e m, AsAXError e)+  => PID -> ObserverCallback -> m Observer+observerCreate pid f = do+  fptr <- liftIO (wrap_observer_callback (toAXCallback f))+  obs <- axObserverCreate pid fptr >>= liftIO . manageCFObj+  liftIO $ do+    oref <- objRetain obs+    elems <- newIORef []+    pure (Observer obs oref fptr elems)++-- | Starts an observer by adding it to the given event loop, according to the+-- specified 'RunLoopMode'.+--+-- See 'observerStart'' for a version of this using default parameters.+observerStart :: MonadIO m => RunLoop -> RunLoopMode -> Observer -> m ()+observerStart rl rlm obs = liftIO $ do+  rls <- observerGetRunLoopSource obs+  b <- runLoopContainsSource rl rls rlm+  if b then pure () else runLoopAddSource rl rls rlm++-- | Starts an observer by adding it to the main run loop, using the default+-- mode.+observerStart' :: MonadIO m => Observer -> m ()+observerStart' o = liftIO mainRunLoop >>= \x -> observerStart x DefaultMode o++-- | Stops an observer, preventing it from receiving further notifications.+observerStop :: Observer -> IO ()+observerStop obs = observerGetRunLoopSource obs >>= runLoopSourceInvalidate++-- | Releases all resources associated to an observer.+observerRelease :: MonadIO m => Observer -> m ()+observerRelease (Observer _ ref fptr elems) = liftIO $ do+  refRelease ref+  freeHaskellFunPtr fptr+  readIORef elems >>= mapM_ refRelease . fmap snd++axObserverCreate+  :: (MonadIO m, MonadError e m, AsAXError e)+  => PID -> FunPtr AXObserverCallback -> m AXObserverRef+axObserverCreate pid callb = except . liftIO $ alloca $ \p -> do+  err <- ax_observer_create pid callb p+  o <- peek p+  pure (either Left (const (Right o)) (toAXResult err))++foreign import ccall unsafe "Carbon/Carbon.h AXObserverGetRunLoopSource"+  axObserverGetRunLoopSource :: AXObserverRef -> IO CFRunLoopSourceRef++observerGetRunLoopSource :: Observer -> IO RunLoopSource+observerGetRunLoopSource obs = withCFPtr (_obsObj obs) $+  axObserverGetRunLoopSource >=> retainManageCFObj++foreign import ccall unsafe "Carbon/Carbon.h AXObserverAddNotification"+  ax_observer_add_notification+  :: AXObserverRef -> AXUIElementRef -> CFStringRef -> StablePtr a+  -> IO ForeignAXError++-- | Registers the specified observer to receive notifications from the+-- specified accessibility object.+addNotification+  :: (MonadIO m, MonadError e m, AsAXError e)+  => Observer -> UIElement -> UINotification -> StablePtr a -> m ()+addNotification obs el notif ptr = except . liftIO $ flip with pure $ do+  obs' <- managed $ withCFPtr (_obsObj obs)+  el'  <- managed $ withCFPtr el+  liftIO $ do+    str <- notifString notif+    ref <- objRetain el+    fmap toAXResult (ax_observer_add_notification obs' el' str ptr)+      <* atomicModifyIORef' (_obsElems obs) ((,()) . ((notif, ref) :))++foreign import ccall "Carbon/Carbon.h AXObserverRemoveNotification"+  ax_observer_remove_notification+  :: AXObserverRef -> AXUIElementRef -> CFStringRef -> IO ForeignAXError++lookupAndDelete :: Eq a => a -> [(a, b)] -> ([(a, b)], Maybe b)+lookupAndDelete x xs =+  maybe (xs, Nothing) ((filter ((/= x) . fst) xs,) . Just) (lookup x xs)++-- | Removes the specified notification from the list of notifications the+-- observer wants to receive from the accessibility object.+removeNotification+  :: (MonadIO m, MonadError e m, AsAXError e)+  => Observer -> UIElement -> UINotification -> m ()+removeNotification obs el notif = except . liftIO . flip with pure $ do+  obs' <- managed $ withCFPtr (_obsObj obs)+  el'  <- managed $ withCFPtr el+  liftIO $ do+    str <- notifString notif+    fmap toAXResult (ax_observer_remove_notification obs' el' str)+      <* (atomicModifyIORef' (_obsElems obs) (lookupAndDelete notif)+           >>= maybe (pure ()) refRelease)
+ src/MacSdk/Framework/Accessibility/Role.hs view
@@ -0,0 +1,509 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}++-- | Constants and ADTs defining the values an accessibility object’s role+-- attribute can have.++module MacSdk.Framework.Accessibility.Role where++import MacSdk.Framework.CoreFoundation+import Control.Monad.Trans.Maybe (MaybeT(..))+import Control.Monad (msum)+import Data.Maybe (fromMaybe)++data Role+  = ApplicationRole+  -- ^ An application.+  | SystemWideRole+  -- ^ The system-wide accessibility object.+  | WindowRole+  -- ^ A window.+  | SheetRole+  -- ^ A sheet.+  | DrawerRole+  -- ^ A drawer.+  | GrowAreaRole+  -- ^ A grow control.+  | ImageRole+  -- ^ An image.+  | UnknownRole+  -- ^ Generic role value for an unknown accessibility object.+  | ButtonRole+  -- ^ A button.+  | RadioButtonRole+  -- ^ A radio button.+  | CheckBoxRole+  -- ^ A check box.+  | PopUpButtonRole+  -- ^ A pop-up button.+  | MenuButtonRole+  -- ^ A menu button.+  | TabGroupRole+  -- ^ A tab view.+  | TableRole+  -- ^ A table.+  | ColumnRole+  -- ^ A column.+  | RowRole+  -- ^ A row.+  | OutlineRole+  -- ^ An accessibility object that displays row-based, hierarchically+  -- structured data, such as the list view in a Finder window.+  | BrowserRole+  -- ^ An accessibility object that displays column-based, hierarchically+  -- structured data, such as the column view in a Finder window.+  | ScrollAreaRole+  -- ^ An accessibility object that displays data managed by scrolling controls.+  | ScrollBarRole+  -- ^ A scroll bar control.+  | RadioGroupRole+  -- ^ A set of radio buttons.+  | ListRole+  -- ^ A list view.+  | GroupRole+  -- ^ A group box. This role can also be used to group other views without any+  -- visual indication of the grouping.+  | ValueIndicatorRole+  -- ^ A control that indicates the value of an accessibility object, such as+  -- the scroller of a scroll bar control+  | ComboBoxRole+  -- ^ A combo box control.+  | SliderRole+  -- ^ A slider control.+  | IncrementorRole+  -- ^ A stepper control (also known as the “little arrows”).+  | BusyIndicatorRole+  -- ^ An asynchronous progress indicator.+  | ProgressIndicatorRole+  -- ^ A determinate or indeterminate progress indicator.+  | RelevanceIndicatorRole+  -- ^ A relevance indicator.+  | ToolbarRole+  -- ^ A toolbar.+  | DisclosureTriangleRole+  -- ^ A disclosure triangle control.+  | TextFieldRole+  -- ^ A text field.+  | TextAreaRole+  -- ^ The editable text area in a control or window.+  | StaticTextRole+  -- ^ A string of static text displayed in a window that is not part of any+  -- control.+  | MenuBarRole+  -- ^ A menu bar.+  | MenuBarItemRole+  -- ^ A menu bar item.+  | MenuRole+  -- ^ A menu.+  | MenuItemRole+  -- ^ A menu item.+  | SplitGroupRole+  -- ^ A split view.+  | SplitterRole+  -- ^ A splitter bar control.+  | ColorWellRole+  -- ^ A color well.+  | TimeFieldRole+  -- ^ A field that displays time.+  | DateFieldRole+  -- ^ A field that displays dates.+  | HelpTagRole+  -- ^ A help tag.+  | MatteRole+  | DockItemRole+  -- ^ An icon that represents an item in the Dock.+  | OtherRole String+  deriving (Eq, Show)++foreign import ccall unsafe kAXApplicationRole_ :: IO CFStringRef+foreign import ccall unsafe kAXSystemWideRole_ :: IO CFStringRef+foreign import ccall unsafe kAXWindowRole_ :: IO CFStringRef+foreign import ccall unsafe kAXSheetRole_ :: IO CFStringRef+foreign import ccall unsafe kAXDrawerRole_ :: IO CFStringRef+foreign import ccall unsafe kAXGrowAreaRole_ :: IO CFStringRef+foreign import ccall unsafe kAXImageRole_ :: IO CFStringRef+foreign import ccall unsafe kAXUnknownRole_ :: IO CFStringRef+foreign import ccall unsafe kAXButtonRole_ :: IO CFStringRef+foreign import ccall unsafe kAXRadioButtonRole_ :: IO CFStringRef+foreign import ccall unsafe kAXCheckBoxRole_ :: IO CFStringRef+foreign import ccall unsafe kAXPopUpButtonRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuButtonRole_ :: IO CFStringRef+foreign import ccall unsafe kAXTabGroupRole_ :: IO CFStringRef+foreign import ccall unsafe kAXTableRole_ :: IO CFStringRef+foreign import ccall unsafe kAXColumnRole_ :: IO CFStringRef+foreign import ccall unsafe kAXRowRole_ :: IO CFStringRef+foreign import ccall unsafe kAXOutlineRole_ :: IO CFStringRef+foreign import ccall unsafe kAXBrowserRole_ :: IO CFStringRef+foreign import ccall unsafe kAXScrollAreaRole_ :: IO CFStringRef+foreign import ccall unsafe kAXScrollBarRole_ :: IO CFStringRef+foreign import ccall unsafe kAXRadioGroupRole_ :: IO CFStringRef+foreign import ccall unsafe kAXListRole_ :: IO CFStringRef+foreign import ccall unsafe kAXGroupRole_ :: IO CFStringRef+foreign import ccall unsafe kAXValueIndicatorRole_ :: IO CFStringRef+foreign import ccall unsafe kAXComboBoxRole_ :: IO CFStringRef+foreign import ccall unsafe kAXSliderRole_ :: IO CFStringRef+foreign import ccall unsafe kAXIncrementorRole_ :: IO CFStringRef+foreign import ccall unsafe kAXBusyIndicatorRole_ :: IO CFStringRef+foreign import ccall unsafe kAXProgressIndicatorRole_ :: IO CFStringRef+foreign import ccall unsafe kAXRelevanceIndicatorRole_ :: IO CFStringRef+foreign import ccall unsafe kAXToolbarRole_ :: IO CFStringRef+foreign import ccall unsafe kAXDisclosureTriangleRole_ :: IO CFStringRef+foreign import ccall unsafe kAXTextFieldRole_ :: IO CFStringRef+foreign import ccall unsafe kAXTextAreaRole_ :: IO CFStringRef+foreign import ccall unsafe kAXStaticTextRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuBarRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuBarItemRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMenuItemRole_ :: IO CFStringRef+foreign import ccall unsafe kAXSplitGroupRole_ :: IO CFStringRef+foreign import ccall unsafe kAXSplitterRole_ :: IO CFStringRef+foreign import ccall unsafe kAXColorWellRole_ :: IO CFStringRef+foreign import ccall unsafe kAXTimeFieldRole_ :: IO CFStringRef+foreign import ccall unsafe kAXDateFieldRole_ :: IO CFStringRef+foreign import ccall unsafe kAXHelpTagRole_ :: IO CFStringRef+foreign import ccall unsafe kAXMatteRole_ :: IO CFStringRef+foreign import ccall unsafe kAXDockItemRole_ :: IO CFStringRef++toRoleCFStringRef :: Role -> IO CFStringRef+toRoleCFStringRef = \case+  ApplicationRole -> kAXApplicationRole_+  SystemWideRole -> kAXSystemWideRole_+  WindowRole -> kAXWindowRole_+  SheetRole -> kAXSheetRole_+  DrawerRole -> kAXDrawerRole_+  GrowAreaRole -> kAXGrowAreaRole_+  ImageRole -> kAXImageRole_+  UnknownRole -> kAXUnknownRole_+  ButtonRole -> kAXButtonRole_+  RadioButtonRole -> kAXRadioButtonRole_+  CheckBoxRole -> kAXCheckBoxRole_+  PopUpButtonRole -> kAXPopUpButtonRole_+  MenuButtonRole -> kAXMenuButtonRole_+  TabGroupRole -> kAXTabGroupRole_+  TableRole -> kAXTableRole_+  ColumnRole -> kAXColumnRole_+  RowRole -> kAXRowRole_+  OutlineRole -> kAXOutlineRole_+  BrowserRole -> kAXBrowserRole_+  ScrollAreaRole -> kAXScrollAreaRole_+  ScrollBarRole -> kAXScrollBarRole_+  RadioGroupRole -> kAXRadioGroupRole_+  ListRole -> kAXListRole_+  GroupRole -> kAXGroupRole_+  ValueIndicatorRole -> kAXValueIndicatorRole_+  ComboBoxRole -> kAXComboBoxRole_+  SliderRole -> kAXSliderRole_+  IncrementorRole -> kAXIncrementorRole_+  BusyIndicatorRole -> kAXBusyIndicatorRole_+  ProgressIndicatorRole -> kAXProgressIndicatorRole_+  RelevanceIndicatorRole -> kAXRelevanceIndicatorRole_+  ToolbarRole -> kAXToolbarRole_+  DisclosureTriangleRole -> kAXDisclosureTriangleRole_+  TextFieldRole -> kAXTextFieldRole_+  TextAreaRole -> kAXTextAreaRole_+  StaticTextRole -> kAXStaticTextRole_+  MenuBarRole -> kAXMenuBarRole_+  MenuBarItemRole -> kAXMenuBarItemRole_+  MenuRole -> kAXMenuRole_+  MenuItemRole -> kAXMenuItemRole_+  SplitGroupRole -> kAXSplitGroupRole_+  SplitterRole -> kAXSplitterRole_+  ColorWellRole -> kAXColorWellRole_+  TimeFieldRole -> kAXTimeFieldRole_+  DateFieldRole -> kAXDateFieldRole_+  HelpTagRole -> kAXHelpTagRole_+  MatteRole -> kAXMatteRole_+  DockItemRole -> kAXDockItemRole_+  OtherRole str -> fromString CFStringEncodingASCII str >>= flip withCFPtr pure++fromRoleCFString :: CFString -> IO Role+fromRoleCFString roleString = withCFPtr roleString $ \role -> do+  Just str' <- toString CFStringEncodingASCII roleString+  fmap (fromMaybe (OtherRole str')) . runMaybeT . msum . fmap MaybeT $+    [ kAXApplicationRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ApplicationRole else Nothing)+    , kAXSystemWideRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just SystemWideRole else Nothing)+    , kAXWindowRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just WindowRole else Nothing)+    , kAXSheetRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just SheetRole else Nothing)+    , kAXDrawerRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just DrawerRole else Nothing)+    , kAXGrowAreaRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just GrowAreaRole else Nothing)+    , kAXImageRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ImageRole else Nothing)+    , kAXUnknownRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just UnknownRole else Nothing)+    , kAXButtonRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ButtonRole else Nothing)+    , kAXRadioButtonRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just RadioButtonRole else Nothing)+    , kAXCheckBoxRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just CheckBoxRole else Nothing)+    , kAXPopUpButtonRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just PopUpButtonRole else Nothing)+    , kAXMenuButtonRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MenuButtonRole else Nothing)+    , kAXTabGroupRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just TabGroupRole else Nothing)+    , kAXTableRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just TableRole else Nothing)+    , kAXColumnRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ColumnRole else Nothing)+    , kAXRowRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just RowRole else Nothing)+    , kAXOutlineRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just OutlineRole else Nothing)+    , kAXBrowserRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just BrowserRole else Nothing)+    , kAXScrollAreaRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ScrollAreaRole else Nothing)+    , kAXScrollBarRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ScrollBarRole else Nothing)+    , kAXRadioGroupRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just RadioGroupRole else Nothing)+    , kAXListRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ListRole else Nothing)+    , kAXGroupRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just GroupRole else Nothing)+    , kAXValueIndicatorRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ValueIndicatorRole else Nothing)+    , kAXComboBoxRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ComboBoxRole else Nothing)+    , kAXSliderRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just SliderRole else Nothing)+    , kAXIncrementorRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just IncrementorRole else Nothing)+    , kAXBusyIndicatorRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just BusyIndicatorRole else Nothing)+    , kAXProgressIndicatorRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ProgressIndicatorRole else Nothing)+    , kAXRelevanceIndicatorRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just RelevanceIndicatorRole else Nothing)+    , kAXToolbarRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ToolbarRole else Nothing)+    , kAXDisclosureTriangleRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just DisclosureTriangleRole else Nothing)+    , kAXTextFieldRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just TextFieldRole else Nothing)+    , kAXTextAreaRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just TextAreaRole else Nothing)+    , kAXStaticTextRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just StaticTextRole else Nothing)+    , kAXMenuBarRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MenuBarRole else Nothing)+    , kAXMenuBarItemRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MenuBarItemRole else Nothing)+    , kAXMenuRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MenuRole else Nothing)+    , kAXMenuItemRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MenuItemRole else Nothing)+    , kAXSplitGroupRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just SplitGroupRole else Nothing)+    , kAXSplitterRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just SplitterRole else Nothing)+    , kAXColorWellRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just ColorWellRole else Nothing)+    , kAXTimeFieldRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just TimeFieldRole else Nothing)+    , kAXDateFieldRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just DateFieldRole else Nothing)+    , kAXHelpTagRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just HelpTagRole else Nothing)+    , kAXMatteRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just MatteRole else Nothing)+    , kAXDockItemRole_ >>= \str -> cfEqual str role >>= \b ->+        pure (if b then Just DockItemRole else Nothing)+    ]++data Subrole+  = CloseButtonSubrole+  -- ^ A close button (that is, the red button in a window’s title bar that+  -- closes the window).+  | MinimizeButtonSubrole+  -- ^ A minimize button (that is, the yellow button in a window’s title bar+  -- that minimizes the window into the Dock).+  | ZoomButtonSubrole+  -- ^ A zoom button (that is, the green button in a window’s title bar that+  -- adjusts the window’s size).+  | ToolbarButtonSubrole+  -- ^ A toolbar button (that is, the button in a window’s title bar that hides+  -- and reveals the toolbar).+  | SecureTextFieldSubrole+  -- ^ A text field intended to contain sensitive data and that displays the+  -- user’s input as a series of bullets.+  | TableRowSubrole+  -- ^ A row in a table.+  | OutlineRowSubrole+  -- ^ A row in an outline view (see OutlineRole for a description of an outline+  -- view).+  | UnknownSubrole+  | StandardWindowSubrole+  -- ^ A standard window that includes a title bar (that is, not an inspector+  -- window or a sheet).+  | DialogSubrole+  -- ^ A dialog window, such as an alert.+  | SystemDialogSubrole+  -- ^ A system-generated dialog window that floats on the top layer, regardless+  -- of which application is frontmost. Use this subrole only when a dialog or+  -- alert applies to the system as a whole, such as a shutdown dialog.+  | FloatingWindowSubrole+  -- ^ A utility window.+  | SystemFloatingWindowSubrole+  -- ^ A system-generated utility window.+  | IncrementArrowSubrole+  -- ^ The up arrow of a scroll bar.+  | DecrementArrowSubrole+  -- ^ The down arrow of a scroll bar.+  | IncrementPageSubrole+  -- ^ The increment area in the scroll track of a scroll bar.+  | DecrementPageSubrole+  -- ^ The decrement area in the scroll track of a scroll bar.+  | SortButtonSubrole+  -- ^ A column heading button in a list or column view.+  | SearchFieldSubrole+  -- ^ A search field.+  | ApplicationDockItemSubrole+  -- ^ An icon in the Dock that represents an application.+  | DocumentDockItemSubrole+  -- ^ An icon in the Dock that represents a document.+  | FolderDockItemSubrole+  -- ^ An icon in the Dock that represents a folder.+  | MinimizedWindowDockItemSubrole+  -- ^ An icon in the Dock that represents a minimized window.+  | URLDockItemSubrole+  -- ^ An icon in the Dock that represents a URL.+  | DockExtraDockItemSubrole+  -- ^ An icon in the Dock that represents a Dock Extra.+  | TrashDockItemSubrole+  -- ^ The icon in the Dock that represents the Trash.+  | ProcessSwitcherListSubrole+  -- ^ The display of running applications (processes) that appears when a user+  -- presses Command-Tab.+  | SubroleOther String -- CFString+  deriving (Eq, Show)++foreign import ccall unsafe kAXCloseButtonSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXMinimizeButtonSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXZoomButtonSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXToolbarButtonSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXSecureTextFieldSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXTableRowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXOutlineRowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXUnknownSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXStandardWindowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXDialogSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXSystemDialogSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXFloatingWindowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXSystemFloatingWindowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXIncrementArrowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXDecrementArrowSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXIncrementPageSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXDecrementPageSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXSortButtonSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXSearchFieldSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXApplicationDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXDocumentDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXFolderDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXMinimizedWindowDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXURLDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXDockExtraDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXTrashDockItemSubrole_ :: IO CFStringRef+foreign import ccall unsafe kAXProcessSwitcherListSubrole_ :: IO CFStringRef++toSubroleString :: Subrole -> IO CFStringRef+toSubroleString = \case+  CloseButtonSubrole -> kAXCloseButtonSubrole_+  MinimizeButtonSubrole -> kAXMinimizeButtonSubrole_+  ZoomButtonSubrole -> kAXZoomButtonSubrole_+  ToolbarButtonSubrole -> kAXToolbarButtonSubrole_+  SecureTextFieldSubrole -> kAXSecureTextFieldSubrole_+  TableRowSubrole -> kAXTableRowSubrole_+  OutlineRowSubrole -> kAXOutlineRowSubrole_+  UnknownSubrole -> kAXUnknownSubrole_+  StandardWindowSubrole -> kAXStandardWindowSubrole_+  DialogSubrole -> kAXDialogSubrole_+  SystemDialogSubrole -> kAXSystemDialogSubrole_+  FloatingWindowSubrole -> kAXFloatingWindowSubrole_+  SystemFloatingWindowSubrole -> kAXSystemFloatingWindowSubrole_+  IncrementArrowSubrole -> kAXIncrementArrowSubrole_+  DecrementArrowSubrole -> kAXDecrementArrowSubrole_+  IncrementPageSubrole -> kAXIncrementPageSubrole_+  DecrementPageSubrole -> kAXDecrementPageSubrole_+  SortButtonSubrole -> kAXSortButtonSubrole_+  SearchFieldSubrole -> kAXSearchFieldSubrole_+  ApplicationDockItemSubrole -> kAXApplicationDockItemSubrole_+  DocumentDockItemSubrole -> kAXDocumentDockItemSubrole_+  FolderDockItemSubrole -> kAXFolderDockItemSubrole_+  MinimizedWindowDockItemSubrole -> kAXMinimizedWindowDockItemSubrole_+  URLDockItemSubrole -> kAXURLDockItemSubrole_+  DockExtraDockItemSubrole -> kAXDockExtraDockItemSubrole_+  TrashDockItemSubrole -> kAXTrashDockItemSubrole_+  ProcessSwitcherListSubrole -> kAXProcessSwitcherListSubrole_+  SubroleOther str ->+    fromString CFStringEncodingASCII str >>= flip withCFPtr pure++fromSubroleCFString :: CFString -> IO Subrole+fromSubroleCFString subrole = do+  Just sr <- toString CFStringEncodingASCII subrole+  withCFPtr subrole $ \subr ->+    fmap (fromMaybe (SubroleOther sr)) . runMaybeT . msum . fmap MaybeT $+    [ kAXCloseButtonSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just CloseButtonSubrole else Nothing)+    , kAXMinimizeButtonSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just MinimizeButtonSubrole else Nothing)+    , kAXZoomButtonSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just ZoomButtonSubrole else Nothing)+    , kAXToolbarButtonSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just ToolbarButtonSubrole else Nothing)+    , kAXSecureTextFieldSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just SecureTextFieldSubrole else Nothing)+    , kAXTableRowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just TableRowSubrole else Nothing)+    , kAXOutlineRowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just OutlineRowSubrole else Nothing)+    , kAXUnknownSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just UnknownSubrole else Nothing)+    , kAXStandardWindowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just StandardWindowSubrole else Nothing)+    , kAXDialogSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just DialogSubrole else Nothing)+    , kAXSystemDialogSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just SystemDialogSubrole else Nothing)+    , kAXFloatingWindowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just FloatingWindowSubrole else Nothing)+    , kAXSystemFloatingWindowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just SystemFloatingWindowSubrole else Nothing)+    , kAXIncrementArrowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just IncrementArrowSubrole else Nothing)+    , kAXDecrementArrowSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just DecrementArrowSubrole else Nothing)+    , kAXIncrementPageSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just IncrementPageSubrole else Nothing)+    , kAXDecrementPageSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just DecrementPageSubrole else Nothing)+    , kAXSortButtonSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just SortButtonSubrole else Nothing)+    , kAXSearchFieldSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just SearchFieldSubrole else Nothing)+    , kAXApplicationDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just ApplicationDockItemSubrole else Nothing)+    , kAXDocumentDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just DocumentDockItemSubrole else Nothing)+    , kAXFolderDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just FolderDockItemSubrole else Nothing)+    , kAXMinimizedWindowDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just MinimizedWindowDockItemSubrole else Nothing)+    , kAXURLDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just URLDockItemSubrole else Nothing)+    , kAXDockExtraDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just DockExtraDockItemSubrole else Nothing)+    , kAXTrashDockItemSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just TrashDockItemSubrole else Nothing)+    , kAXProcessSwitcherListSubrole_ >>= \str -> cfEqual str subr >>= \b ->+        pure (if b then Just ProcessSwitcherListSubrole else Nothing)+    ]
+ src/MacSdk/Framework/Accessibility/Types.hs view
@@ -0,0 +1,11 @@+module MacSdk.Framework.Accessibility.Types where++import Foreign+import MacSdk.Framework.CoreFoundation.Object++data AXUIElement+type AXUIElementRef = Ptr AXUIElement++-- | This type represents a reference to an accessible user interface element.+type UIElement = Object AXUIElement+instance CFClass AXUIElement
+ src/MacSdk/Framework/Accessibility/UIElement.hs view
@@ -0,0 +1,67 @@+module MacSdk.Framework.Accessibility.UIElement+  (+  -- * UI elements+    UIElement+  , createAppElement+  , getWindowElementID+  , setMessagingTimeout+  , systemWideUIElement+  ) where++import MacSdk.Framework.Accessibility.Error+import MacSdk.Framework.Accessibility.Types+import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.Types (PID)+import MacSdk.Framework.CoreGraphics.Window (WindowID)+import Control.Monad.IO.Class(MonadIO(..))++import Foreign+import Foreign.C.Types (CInt(..))+import Control.Monad+import Control.Arrow ((>>>))+import Data.Bifunctor (first)++foreign import ccall unsafe "AXUIElementCreateApplication"+  ax_ui_element_create_application :: PID -> IO AXUIElementRef++-- | Create a UIElement from a PID, representing the application associated to+-- it.+createAppElement :: MonadIO m => PID -> m UIElement+createAppElement =+  (ax_ui_element_create_application >=> manageCFObj) >>> liftIO++foreign import ccall unsafe "_AXUIElementGetWindow"+  axUIElementGetWindow :: AXUIElementRef -> Ptr WindowID -> IO ForeignAXError++-- | Retrieve the WindowID of the window associated to the UI element. The+-- function fail if, among other things, the specified UI element does not+-- correspond to a valid window.+getWindowElementID+  :: (MonadIO m, MonadError e m, AsAXError e)+  => UIElement -> m WindowID+getWindowElementID el =+  except . liftIO . withCFPtr el $ \elptr -> alloca $ \widptr -> do+    err <- axUIElementGetWindow elptr widptr+    -- AXUIElementGetWindow occasionally returns AXErrorIllegalArgument, but+    -- AXErrorInvalidUIElement seems more appropriate, since the first argument+    -- is the only one that could possibly be invalid.+    let res = first (\e -> case e of+                        { AXErrorIllegalArgument -> AXErrorInvalidUIElement+                        ; _ -> e }) $ toAXResult err+    either (pure . Left) (const (Right <$> peek widptr)) res++foreign import ccall unsafe "AXUIElementSetMessagingTimeout"+  axUIElementSetMessagingTimeout :: AXUIElementRef -> Float -> IO ForeignAXError++setMessagingTimeout+  :: (MonadIO m, MonadError e m, AsAXError e) => UIElement -> Float -> m ()+setMessagingTimeout el f = except . liftIO . fmap toAXResult $+  withCFPtr el (`axUIElementSetMessagingTimeout` f)++foreign import ccall unsafe "AXUIElementCreateSystemWide"+  axUIElementCreateSystemWide :: IO AXUIElementRef++-- | Returns the system-wide accessibility object, that provides access to+-- system attributes.+systemWideUIElement :: IO UIElement+systemWideUIElement = axUIElementCreateSystemWide >>= manageCFObj
+ src/MacSdk/Framework/Accessibility/UINotification.hs view
@@ -0,0 +1,74 @@+module MacSdk.Framework.Accessibility.UINotification where++import MacSdk.Framework.CoreFoundation+import Control.Monad.Except++data UINotification+  = WindowCreatedNotification+  | FocusedWindowChangedNotification+  | WindowMovedNotification+  | WindowResizedNotification+  | TitleChangedNotification+  | UIElementDestroyedNotification+  | WindowMiniaturizedNotification+  | WindowDeminiaturizedNotification+  deriving (Eq, Show)++foreign import ccall window_created_notif :: IO CFStringRef+foreign import ccall focused_window_changed_notif :: IO CFStringRef+foreign import ccall window_moved_notif :: IO CFStringRef+foreign import ccall window_resized_notif :: IO CFStringRef+foreign import ccall title_changed_notif :: IO CFStringRef+foreign import ccall ax_ui_element_destroyed_notification :: IO CFStringRef+foreign import ccall ax_window_miniaturized_notification :: IO CFStringRef+foreign import ccall ax_window_deminiaturized_notification :: IO CFStringRef++ifM :: Monad m => Bool -> a -> ExceptT a m ()+ifM b x = if b then throwError x else pure ()++toNotif' :: CFStringRef -> ExceptT UINotification IO ()+toNotif' str = do+  wcn <- liftIO window_created_notif+  b_wcn <- liftIO $ cfEqual str wcn+  ifM b_wcn WindowCreatedNotification++  fwc <- liftIO focused_window_changed_notif+  b_fwc <- liftIO $ cfEqual str fwc+  ifM b_fwc FocusedWindowChangedNotification++  wm <- liftIO window_moved_notif+  b_wm <- liftIO $ cfEqual str wm+  ifM b_wm WindowMovedNotification++  wr <- liftIO window_resized_notif+  b_wr <- liftIO $ cfEqual str wr+  ifM b_wr WindowResizedNotification++  tc <- liftIO title_changed_notif+  b_tc <- liftIO $ cfEqual str tc+  ifM b_tc TitleChangedNotification++  ed <- liftIO ax_ui_element_destroyed_notification+  b_ed <- liftIO $ cfEqual str ed+  ifM b_ed UIElementDestroyedNotification++  wmin <- liftIO ax_window_miniaturized_notification+  b_wmin <- liftIO $ cfEqual str wmin+  ifM b_wmin WindowMiniaturizedNotification++  wdemin <- liftIO ax_window_deminiaturized_notification+  b_wdemin <- liftIO $ cfEqual str wdemin+  ifM b_wdemin WindowDeminiaturizedNotification++toNotif :: CFStringRef -> IO (Maybe UINotification)+toNotif = fmap (either Just (const Nothing)) . runExceptT . toNotif'++notifString :: UINotification -> IO CFStringRef+notifString WindowCreatedNotification = window_created_notif+notifString FocusedWindowChangedNotification = focused_window_changed_notif+notifString WindowMovedNotification = window_moved_notif+notifString WindowResizedNotification = window_resized_notif+notifString TitleChangedNotification = title_changed_notif+notifString UIElementDestroyedNotification = ax_ui_element_destroyed_notification+notifString WindowMiniaturizedNotification = ax_window_miniaturized_notification+notifString WindowDeminiaturizedNotification = ax_window_deminiaturized_notification
+ src/MacSdk/Framework/Accessibility/Value.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TypeFamilies #-}++module MacSdk.Framework.Accessibility.Value where++import MacSdk.Framework.CoreFoundation.Object+import Foreign.Ptr++data AXValue+type AXValueRef = Ptr AXValue+type Value = Object AXValue++instance CFClass AXValue
+ src/MacSdk/Framework/CoreFoundation.hs view
@@ -0,0 +1,21 @@+module MacSdk.Framework.CoreFoundation+  ( module MacSdk.Framework.CoreFoundation.Allocator+  , module MacSdk.Framework.CoreFoundation.Boolean+  , module MacSdk.Framework.CoreFoundation.Array+  , module MacSdk.Framework.CoreFoundation.Number+  , module MacSdk.Framework.CoreFoundation.Object+  , module MacSdk.Framework.CoreFoundation.RunLoop+  , module MacSdk.Framework.CoreFoundation.String+  , module MacSdk.Framework.CoreFoundation.UUID+  , module MacSdk.Framework.CoreFoundation.Dictionary+  ) where++import MacSdk.Framework.CoreFoundation.Allocator+import MacSdk.Framework.CoreFoundation.Boolean+import MacSdk.Framework.CoreFoundation.Dictionary+import MacSdk.Framework.CoreFoundation.Array+import MacSdk.Framework.CoreFoundation.Number+import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.CoreFoundation.RunLoop+import MacSdk.Framework.CoreFoundation.String+import MacSdk.Framework.CoreFoundation.UUID
+ src/MacSdk/Framework/CoreFoundation/Allocator.hs view
@@ -0,0 +1,16 @@+module MacSdk.Framework.CoreFoundation.Allocator+  ( Allocator+  , CFAllocatorRef+  , nullAllocator+  ) where++import Foreign+import MacSdk.Framework.CoreFoundation.Object++data CFAllocator+type CFAllocatorRef = Ptr CFAllocator+instance CFClass CFAllocator where+type Allocator = Object CFAllocator++nullAllocator :: IO Allocator+nullAllocator = Object <$> newForeignPtr_ nullPtr
+ src/MacSdk/Framework/CoreFoundation/Array.hs view
@@ -0,0 +1,70 @@+module MacSdk.Framework.CoreFoundation.Array+  ( CFArrayRef+  , CFIndex+  , Array(..)+  , createArray+  , createArray'+  , arrayValues+  , getCFArrayValues+  ) where++import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.CoreFoundation.Allocator+import Foreign.Ptr+import Foreign hiding (with)+import Foreign.C.Types (CInt(..))+import Control.Monad+import Control.Monad.Managed+import Data.Foldable++data CFArray+type CFArrayRef = Ptr CFArray+instance CFClass CFArray+newtype Array a = Array { getArray :: Object CFArray }+instance Functor Array where+  fmap _ (Array a) = Array a++type CFIndex = CInt++foreign import ccall unsafe "Carbon/Carbon.h CFArrayGetValueAtIndex"+  cf_array_get_value_at_index :: CFArrayRef -> CFIndex -> IO (Ptr ())++foreign import ccall unsafe "Carbon/Carbon.h CFArrayGetCount"+  cf_array_get_count :: CFArrayRef -> IO CFIndex++getCFArrayValues :: CFArrayRef -> IO [CFTypeRef]+getCFArrayValues arr = do+  n <- cf_array_get_count arr+  ptrs <- forM [0.. (n-1)] (cf_array_get_value_at_index arr)+  pure (fmap castPtr ptrs)++arrayValues :: (MonadIO m, CFClass a) => Array (Object a) -> m [Object a]+arrayValues arr = liftIO . withCFPtr (getArray arr) $ \cfarr ->+  getCFArrayValues cfarr >>= mapM retainManageCFObj . fmap castPtr++--------------------------------------------------------------------------------+-- Array creation++data ArrayCallbacks++foreign import ccall cfCallbs :: Ptr ArrayCallbacks++foreign import ccall "CFArrayCreate"+  cfArrayCreate :: CFAllocatorRef -> Ptr CFTypeRef -> CFIndex+                -> Ptr ArrayCallbacks -> IO CFArrayRef++-- | Create an array from a denumerable collection of Core Foundation objects,+-- using the specified allocator.+createArray :: (Foldable f, CFClass a) => Allocator -> f (Object a) -> IO (Array (Object a))+createArray allo objs = fmap Array . flip with pure $ do+  allo' <- managed (withCFPtr allo)+  objs' <- managed (withMany withCFPtr (toList objs))+  liftIO $ do+    arr <- newArray (fmap asCFType objs')+    cfArrayCreate allo' arr (fromIntegral (length objs')) cfCallbs+      >>= manageCFObj++-- | Create an array from a denumerable collection of Core Foundation objects,+-- using the default allocator.+createArray' :: (Foldable f, CFClass a) => f (Object a) -> IO (Array (Object a))+createArray' objs = nullAllocator >>= flip createArray objs
+ src/MacSdk/Framework/CoreFoundation/Boolean.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE TypeSynonymInstances #-}++module MacSdk.Framework.CoreFoundation.Boolean+  ( Boolean+  , CFBooleanRef+  -- , MacSdk.Framework.CoreFoundation.Boolean.toBool+  -- , MacSdk.Framework.CoreFoundation.Boolean.fromBool+  , booleanFalse+  , booleanTrue+  , refToBool+  , boolToRef+  ) where++import MacSdk.Framework.CoreFoundation.Object+import qualified Foreign.C.Types as C (CChar(..))+import Foreign+import Data.Bool++data CFBoolean+type CFBooleanRef = Ptr CFBoolean+instance CFClass CFBoolean+type Boolean = Object CFBoolean++foreign import ccall unsafe cf_boolean_true :: CFBooleanRef+foreign import ccall unsafe cf_boolean_false :: CFBooleanRef+foreign import ccall unsafe "Carbon/Carbon.h CFBooleanGetValue"+  cf_boolean_get_value :: CFBooleanRef -> IO C.CChar++-- toBool :: CFBooleanRef -> IO Bool+-- toBool = fmap Foreign.toBool . cf_boolean_get_value++-- fromBool :: Bool -> CFBooleanRef+-- fromBool = bool cf_boolean_false cf_boolean_true++-- instance IOIso Bool CFBooleanRef where+boolToRef :: Bool -> IO CFBooleanRef+boolToRef = pure . bool cf_boolean_false cf_boolean_true++refToBool :: CFBooleanRef -> IO Bool+refToBool = fmap Foreign.toBool . cf_boolean_get_value++-- instance IOIso Bool Boolean where+  -- ioTo = bool booleanFalse booleanTrue+  -- ioFrom = flip withCFPtr refToBool++booleanFalse :: IO Boolean+booleanFalse = Object <$> newForeignPtr_ cf_boolean_false++booleanTrue :: IO Boolean+booleanTrue = Object <$> newForeignPtr_ cf_boolean_true
+ src/MacSdk/Framework/CoreFoundation/Dictionary.hs view
@@ -0,0 +1,93 @@+module MacSdk.Framework.CoreFoundation.Dictionary+  ( Dictionary+  , CFDictionaryRef+  , CFDictionaryKeyCallBacks+  , CFDictionaryValueCallBacks+  , createDictionary+  , getDictValue+  , getDictValue'+  , getDictValueSafe+  , stringDictionaryKeyCallBacks+  , cfTypeDictionaryValueCallBacks+  -- , strKey+  ) where++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Managed+import Foreign.Ptr+import Foreign.C.Types (CInt(..), CBool(..))+import Foreign.Marshal.Utils (withMany)+import Foreign.Marshal.Array+import Foreign hiding (with)+import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.CoreFoundation.Array+import MacSdk.Framework.CoreFoundation.Allocator+import MacSdk.Framework.CoreFoundation.String++data CFDictionary+type CFDictionaryRef = Ptr CFDictionary+instance CFClass CFDictionary+type Dictionary = Object CFDictionary++foreign import ccall unsafe "cfCopyStringDictionaryKeyCallBacks"+  stringDictionaryKeyCallBacks :: IO (Ptr CFDictionaryKeyCallBacks)+foreign import ccall unsafe "cfTypeDictionaryValueCallBacks"+  cfTypeDictionaryValueCallBacks :: IO (Ptr CFDictionaryValueCallBacks)++data CFDictionaryKeyCallBacks+data CFDictionaryValueCallBacks++foreign import ccall unsafe "CFDictionaryCreate" cfDictionaryCreate+  :: CFAllocatorRef -> Ptr CFTypeRef -> Ptr CFTypeRef -> CFIndex+  -> Ptr CFDictionaryKeyCallBacks -> Ptr CFDictionaryValueCallBacks+  -> IO CFDictionaryRef++createDictionary+  :: CFClass obj => Allocator -> [CFString] -> [Object obj] -> IO Dictionary+createDictionary allo keys vals = flip with pure $ do+  allo' <- managed (withCFPtr allo)+  keys' <- fmap (fmap asCFType) $ managed (withMany withCFPtr keys)+  keys'' <- liftIO (newArray keys')+  vals' <- fmap (fmap asCFType) $ managed (withMany withCFPtr vals)+  vals'' <- liftIO (newArray vals')+  k1 <- liftIO stringDictionaryKeyCallBacks+  k2 <- liftIO cfTypeDictionaryValueCallBacks+  liftIO $+    cfDictionaryCreate allo' keys'' vals'' (fromIntegral (length keys)) k1 k2+      >>= manageCFObj++foreign import ccall unsafe "CFDictionaryGetValue"+  cfDictionaryGetValue :: CFDictionaryRef -> CFTypeRef -> IO (Ptr b)++-- | Returns the value associated with a given key.+getDictValue :: (CFClass key, CFClass val) => Dictionary -> Object key -> IO (Object val)+getDictValue dict key = flip with pure $ do+  d' <- managed (withCFPtr dict)+  k' <- managed (withCFPtr key)+  liftIO $ cfDictionaryGetValue d' (asCFType k') >>= retainManageCFObj++getDictValue' :: (MonadIO m, CFClass val) => Dictionary -> CFStringRef -> m (Object val)+getDictValue' dict key = liftIO $ withCFPtr dict $ \d ->+  cfDictionaryGetValue d (asCFType key) >>= retainManageCFObj++foreign import ccall unsafe "CFDictionaryGetValueIfPresent"+  cfDictionaryGetValueIfPresent+  :: CFDictionaryRef -> Ptr a -> Ptr (Ptr b) -> IO CBool++getDictValueSafe+  :: (MonadIO m, CFClass val)+  => Dictionary -> CFStringRef -> m (Maybe (Object val))+getDictValueSafe dict key = liftIO $ flip with pure $ do+  d <- managed (withCFPtr dict)+  p <- managed alloca+  liftIO $ do+    b <- toBool <$> cfDictionaryGetValueIfPresent d key p+    if b then peek p >>= fmap Just . retainManageCFObj else pure Nothing++-- strKey :: String -> IO S.String+-- strKey = ioTo++-- foreign import ccall azder :: CFDictionaryRef -> IO CFNumberRef++-- azder' :: Dictionary -> IO Number+-- azder' d = withCFPtr d azder >>= manageCFObj
+ src/MacSdk/Framework/CoreFoundation/Number.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE KindSignatures #-}++module MacSdk.Framework.CoreFoundation.Number+  ( CFNumberRef+  , Number+  , NumberType(..)+  , numberCreateWithAllocator+  , numberCreate+  , numberGetValue+  ) where++import Control.Monad.Managed+import Control.Monad.IO.Class (MonadIO(..))+import Foreign hiding (with)+import Foreign.C.Types (CInt(..), CBool(..))+import MacSdk.Framework.CoreFoundation.Allocator+import MacSdk.Framework.CoreFoundation.Object++data CFNumber+type CFNumberRef = Ptr CFNumber+instance CFClass CFNumber+type Number = Object CFNumber++type CFNumberType = CInt++data NumberType :: * -> * where+  NumberSigned64Type :: NumberType Int64+  NumberLongType :: NumberType Int64+  NumberIntType :: NumberType Int32+  NumberSInt32Type :: NumberType Int32++storableTy :: NumberType ty -> (Storable ty => b) -> b+storableTy NumberSigned64Type f = f+storableTy NumberLongType f = f+storableTy NumberIntType f = f+storableTy NumberSInt32Type f = f++toCFNumberType :: NumberType ty -> CFNumberType+toCFNumberType NumberSigned64Type = 4+toCFNumberType NumberIntType = 9+toCFNumberType NumberLongType = 10+toCFNumberType NumberSInt32Type = 3++--------------------------------------------------------------------------------++foreign import ccall unsafe "CFNumberCreate"+  cfNumberCreate :: CFAllocatorRef -> CFNumberType -> Ptr a -> IO CFNumberRef++numberCreateWithAllocator :: Allocator -> NumberType ty -> ty -> IO Number+numberCreateWithAllocator allo nty num = flip with pure $ do+  allo' <- managed (withCFPtr allo)+  storableTy nty $ do+    p <- managed alloca+    liftIO $ do+      poke p num+      num' <- cfNumberCreate allo' (toCFNumberType nty) p+      manageCFObj num'++numberCreate :: NumberType ty -> ty -> IO Number+numberCreate nty num = nullAllocator >>= \a -> numberCreateWithAllocator a nty num++--------------------------------------------------------------------------------++foreign import ccall unsafe "CFNumberGetValue"+  cfNumberGetValue :: CFNumberRef -> CFNumberType -> Ptr a -> IO CBool++numberGetValue :: MonadIO m => Number -> NumberType ty -> m (Maybe ty)+numberGetValue num nty = liftIO $ flip with pure $ do+  nptr <- managed (withCFPtr num)+  storableTy nty $ do+    p <- managed alloca+    liftIO $ do+      b <- cfNumberGetValue nptr (toCFNumberType nty) p+      if toBool b then Just <$> peek p else pure Nothing
+ src/MacSdk/Framework/CoreFoundation/Object.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- |+  Core Foundation objects.++   https://developer.apple.com/documentation/corefoundation/cftype?language=objc+-}++module MacSdk.Framework.CoreFoundation.Object+  (+  -- * Core Foundation types+    CFTypeID+  , CFClass(..)+  , CFTypeable(..)+  , Object(..)+  , withCFPtr+  , Ref(..)+  , objRetain+  , refRelease+  , objEquals+  , objShow+  , getTypeID+  , objCast+  -- * Low level+  , CFType_+  , CFType+  , CFTypeRef+  , CFObject+  , manageCFObj+  , retainManageCFObj+  , cfRetain+  , cf_retain+  , cfReleasePtr+  , cf_release+  , cf_equal+  , cfEqual+  , cf_show+  , cfGetTypeID+  ) where++import Control.Monad.Managed+import Foreign hiding (with)+import Foreign.C.Types (CBool(..))+import Data.Proxy++data CFType_+type CFType = Object CFType_+type CFTypeRef = Ptr CFType_+type CFObject = Object CFType_+instance CFClass CFType_ where++type CFTypeID = Word64++-- | Typeclass of types corresponding to a CFType class, and that can+-- therefore by upcasted to a Core Foundation object.+class CFClass a where+  asCFType :: Ptr a -> Ptr CFType_+  asCFType = castPtr++-- | Typeclass of CFType classes whose CFType ID can be queried at runtime.+class CFClass a => CFTypeable a where+  cfTypeID :: Proxy a -> IO CFTypeID++-- | A reference to a CoreFoundation object whose memory allocation is+-- automatically managed by the GHC runtime.+newtype Object a = Object (ForeignPtr a)++withCFPtr :: Object a -> (Ptr a -> IO b) -> IO b+withCFPtr (Object p) = withForeignPtr p++-- | A reference to a CoreFoundation object whose memory allocation is manually+-- managed. It can be used to keep an object in memory beyond its garbage+-- collection. Note that failing to release a manual memory reference will cause+-- a memory leak.+newtype Ref = Ref { unRef :: CFTypeRef }++-- | Retains an object in memory, returning a corresponding reference.+--+-- An object can be retained multiple times, each time creating a new, distinct+-- memory reference. Every reference that is created with this function must be+-- explicitly released with 'refRelease' to avoid memory leaks.+objRetain :: CFClass a => Object a -> IO Ref+objRetain = flip withCFPtr $ \p ->+  let q = asCFType p in cf_retain q >> pure (Ref q)++-- | Releases a manual memory reference.+refRelease :: Ref -> IO ()+refRelease = cf_release . unRef++-- TODO: check that it is only used with references following the "copy rule"+manageCFObj :: Ptr a -> IO (Object a)+manageCFObj ptr =+  if ptr == nullPtr+    then error "manageCFObj: null pointer"+    else Object <$> newForeignPtr cfReleasePtr ptr++-- TODO: check that it is only used with references following the "create rule"+retainManageCFObj :: CFClass a => Ptr a -> IO (Object a)+retainManageCFObj ref = cfRetain ref >> manageCFObj ref++cfRetain :: CFClass a => Ptr a -> IO ()+cfRetain p = cf_retain (asCFType p)++foreign import ccall "Carbon/Carbon.h CFRetain" cf_retain :: CFTypeRef -> IO ()+foreign import ccall "&CFRelease" cfReleasePtr :: FunPtr (Ptr a -> IO ())+foreign import ccall "CFRelease" cf_release :: CFTypeRef -> IO ()++foreign import ccall "Carbon/Carbon.h CFEqual"+  cf_equal :: CFTypeRef -> CFTypeRef -> IO CBool++-- | Suubtype polymorphic equality testing between two Core Foundation objects.+objEquals :: (CFClass a, MonadIO m) => Object a -> Object a -> m Bool+objEquals x y = liftIO . flip with pure $ do+  p <- asCFType <$> managed (withCFPtr x)+  q <- asCFType <$> managed (withCFPtr y)+  liftIO (fmap toBool (cf_equal p q))++cfEqual :: CFClass a => Ptr a -> Ptr a -> IO Bool+cfEqual x y = do+  res <- cf_equal (asCFType x) (asCFType y)+  pure (toBool res)++foreign import ccall "CFShow" cf_show :: CFTypeRef -> IO ()++-- | Sends a "show" message to the object.+objShow :: CFClass o => Object o -> IO ()+objShow = flip withCFPtr (cf_show . asCFType)++foreign import ccall "CFGetTypeID" cfGetTypeID :: CFTypeRef -> IO CFTypeID++-- | Returns the 'CFTypeID' of a given object.+getTypeID :: CFClass o => Object o -> IO CFTypeID+getTypeID = flip withCFPtr (cfGetTypeID . asCFType)++-- | Type safe cast from a CFType to another.+objCast :: forall o o'. (CFClass o, CFTypeable o')+        => Object o -> IO (Maybe (Object o'))+objCast o = do+  ty <- getTypeID o+  wanted <- cfTypeID (Proxy :: Proxy o')+  if ty == wanted+    then Just <$> withCFPtr o (retainManageCFObj . castPtr)+    else pure Nothing
+ src/MacSdk/Framework/CoreFoundation/RunLoop.hs view
@@ -0,0 +1,162 @@+{-| Run loops for system-wide events. -}++module MacSdk.Framework.CoreFoundation.RunLoop+  ( CFRunLoopSourceRef+  , RunLoop+  , RunLoopSource+  , RunLoopMode(..)+  , runLoopContainsSource+  , runLoopGetCurrent+  , runLoopAddSource+  , mainRunLoop+  , runLoopRun+  , runLoopStop+  , runLoopSourceInvalidate+  , machPortRunLoopSource+  , addSourceToMainLoop+  -- * Mach ports+  , CFMachPortRef+  , MachPort+  , eventTapIsEnabled+  , enableEventTap+  , cgEventTapIsEnabled+  -- , releaseMachPort+  ) where++import Control.Monad.Managed+import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.CoreFoundation.String+import MacSdk.Framework.CoreFoundation.Allocator+import MacSdk.Framework.CoreFoundation.Array+import Foreign hiding (with)+import Foreign.C.Types (CBool(..), CInt(..))+import Control.Monad+import System.IO.Unsafe (unsafePerformIO)++data CFMachPort+type CFMachPortRef = Ptr CFMachPort+instance CFClass CFMachPort where+type MachPort = Object CFMachPort++foreign import ccall unsafe "CGEventTapIsEnabled"+  cgEventTapIsEnabled :: CFMachPortRef -> IO CBool++eventTapIsEnabled :: MachPort -> IO Bool+eventTapIsEnabled = fmap toBool . flip withCFPtr cgEventTapIsEnabled++foreign import ccall unsafe "CGEventTapEnable"+  cgEventTapEnable :: CFMachPortRef -> CBool -> IO ()++enableEventTap :: MachPort -> Bool -> IO ()+enableEventTap mp b = withCFPtr mp $ flip cgEventTapEnable (fromBool b)++-- releaseMachPort :: MachPort -> IO ()+-- releaseMachPort = flip withCFPtr cfRelease++data CFRunLoop+type CFRunLoopRef = Ptr CFRunLoop+instance CFClass CFRunLoop++-- | Type of run loops.+--+-- A run loop is an event loop in a (system) thread that looks for events, such+-- as mouse clicks, key presses, and timer firings. The run loop dispatches+-- these events to interested parties and then goes to sleep waiting for more+-- events. [Advanced Mac OS X Programming, 1st ed.]+type RunLoop = Object CFRunLoop++foreign import ccall unsafe kCFRunLoopCommonModes_ :: IO CFRunLoopMode+foreign import ccall unsafe kCFRunLoopDefaultMode_ :: IO CFRunLoopMode++type CFRunLoopMode = CFStringRef+data RunLoopMode+  = CommonModes+  -- ^ Objects added to a run loop using this value as the mode are monitored+  -- by all run loop modes that have been declared as a member of the set of+  -- “common” modes with 'runLoopAddCommonMode'.+  | DefaultMode+  -- ^ Run loop mode that should be used when a thread is in its default, or+  -- idle, state, waiting for an event. This mode is used when the run loop is+  -- started with 'runLoopRun'.++toCFRunLoopMode :: RunLoopMode -> CFRunLoopMode+toCFRunLoopMode = unsafePerformIO . \case+  CommonModes -> kCFRunLoopCommonModes_+  DefaultMode -> kCFRunLoopDefaultMode_++data CFRunLoopSource+type CFRunLoopSourceRef = Ptr CFRunLoopSource+instance CFClass CFRunLoopSource+type RunLoopSource = Object CFRunLoopSource++foreign import ccall unsafe "Carbon/Carbon.h CFRunLoopContainsSource"+  cfRunLoopContainsSource+  :: CFRunLoopRef -> CFRunLoopSourceRef -> CFStringRef -> IO CBool++runLoopContainsSource :: RunLoop -> RunLoopSource -> RunLoopMode -> IO Bool+runLoopContainsSource rl rls mode = flip with pure $ do+  rl' <- managed $ withCFPtr rl+  rls' <- managed $ withCFPtr rls+--   str' <- managed $ withCFPtr str+  liftIO . fmap toBool $ cfRunLoopContainsSource rl' rls' (toCFRunLoopMode mode) -- str'++foreign import ccall unsafe "Carbon/Carbon.h CFRunLoopAddSource"+  cfRunLoopAddSource+  :: CFRunLoopRef -> CFRunLoopSourceRef -> CFStringRef -> IO ()++runLoopAddSource :: RunLoop -> RunLoopSource -> RunLoopMode -> IO ()+runLoopAddSource rl rls mode = runManaged $ do+  rl' <- managed $ withCFPtr rl+  rls' <- managed $ withCFPtr rls+--  str' <- managed $ withCFPtr str+  liftIO $ cfRunLoopAddSource rl' rls' (toCFRunLoopMode mode) -- str'++foreign import ccall unsafe "Carbon/Carbon.h CFRunLoopGetMain"+  cfRunLoopGetMain :: IO CFRunLoopRef++foreign import ccall unsafe "Carbon/Carbon.h CFRunLoopGetCurrent"+  cfRunLoopGetCurrent :: IO CFRunLoopRef++-- | Returns the RunLoop object for the current thread.+runLoopGetCurrent :: IO RunLoop+runLoopGetCurrent = cfRunLoopGetCurrent >>= retainManageCFObj++-- | Runs the current thread’s CFRunLoop object in its default mode+-- indefinitely.+foreign import ccall "Carbon/Carbon.h CFRunLoopRun"+  runLoopRun :: IO ()++-- | Forces a CFRunLoop object to stop running.+foreign import ccall "Carbon/Carbon.h CFRunLoopStop"+  cfRunLoopStop :: CFRunLoopRef -> IO ()++runLoopStop :: RunLoop -> IO ()+runLoopStop l = withCFPtr l cfRunLoopStop++-- | Returns the main RunLoop object.+mainRunLoop :: IO RunLoop+mainRunLoop = cfRunLoopGetMain >>= retainManageCFObj++foreign import ccall unsafe "Carbon/Carbon.h CFRunLoopSourceInvalidate"+  cfRunLoopSourceInvalidate :: CFRunLoopSourceRef -> IO ()++runLoopSourceInvalidate :: RunLoopSource -> IO ()+runLoopSourceInvalidate = flip withCFPtr cfRunLoopSourceInvalidate++foreign import ccall "CFMachPortCreateRunLoopSource"+  cfMachPortCreateRunLoopSource+  :: CFAllocatorRef -> CFMachPortRef -> CFIndex -> IO CFRunLoopSourceRef++machPortRunLoopSource :: Allocator -> MachPort -> Int -> IO RunLoopSource+machPortRunLoopSource al mp i = flip with pure $ do+  al' <- managed $ withCFPtr al+  mp' <- managed $ withCFPtr mp+  liftIO $ cfMachPortCreateRunLoopSource al' mp' (fromIntegral i) >>= manageCFObj++-- | Creates a loop source from the given mach port, and adds it to the main run+-- loop with default parameters.+addSourceToMainLoop :: MachPort -> IO ()+addSourceToMainLoop port = nullAllocator >>= \alloc -> +  join $ runLoopAddSource <$> mainRunLoop+                          <*> machPortRunLoopSource alloc port 0+                          <*> pure CommonModes
+ src/MacSdk/Framework/CoreFoundation/String.hsc view
@@ -0,0 +1,141 @@+{-# LANGUAGE TypeSynonymInstances #-}++module MacSdk.Framework.CoreFoundation.String+  ( CFStringEncoding(..)+  , CFStringRef+  , CFString+  -- * Conversion+  , toCString+  , fromCString+  , fromCStringWithAllocator+  , toString+  , fromString+  ) where++import MacSdk.Framework.CoreFoundation.Allocator+import MacSdk.Framework.CoreFoundation.Object+import MacSdk.Framework.CoreFoundation.Array+import Foreign+import Foreign.C.String+import Foreign.C.Types (CBool(..), CInt(..))+import Control.Monad+import Control.Monad.IO.Class (MonadIO(..))++#include <Carbon/Carbon.h>++type ForeignCFStringEncoding = Word32++-- | String encodings to be used when converting from and to CFString references.+data CFStringEncoding+  = CFStringEncodingMacRoman+  -- ^ An encoding constant that identifies the Mac Roman encoding.+  | CFStringEncodingWindowsLatin1+  -- ^ An encoding constant that identifies the Windows Latin 1 encoding+  -- (ANSI codepage 1252).+  | CFStringEncodingISOLatin1+  -- ^ An encoding constant that identifies the ISO Latin 1 encoding+  -- (ISO 8859-1)+  | CFStringEncodingNextStepLatin+  -- ^ An encoding constant that identifies the NextStep/OpenStep encoding.+  | CFStringEncodingASCII+  -- ^ An encoding constant that identifies the ASCII encoding (decimal values 0+  -- through 127).+  | CFStringEncodingUnicode+  -- ^ An encoding constant that identifies the Unicode encoding.+  | CFStringEncodingUTF8+  -- ^ An encoding constant that identifies the UTF 8 encoding.+  | CFStringEncodingNonLossyASCII+  -- ^ An encoding constant that identifies non-lossy ASCII encoding.+  | CFStringEncodingUTF16+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF16Format encoding (alias of kCFStringEncodingUnicode).+  | CFStringEncodingUTF16BE+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF16BEFormat encoding. This constant specifies big-endian byte+  -- order.+  | CFStringEncodingUTF16LE+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF16LEFormat encoding. This constant specifies little-endian byte+  -- order.+  | CFStringEncodingUTF32+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF32Format encoding.+  | CFStringEncodingUTF32BE+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF32BEFormat encoding. This constant specifies big-endian byte+  -- order.+  | CFStringEncodingUTF32LE+  -- ^ An encoding constant that identifies kTextEncodingUnicodeDefault ++  -- kUnicodeUTF32LEFormat encoding. This constant specifies little-endian byte+  -- order.++toForeignEncoding :: CFStringEncoding -> ForeignCFStringEncoding+toForeignEncoding = \case+  CFStringEncodingMacRoman -> (#const kCFStringEncodingMacRoman)+  CFStringEncodingWindowsLatin1 -> (#const kCFStringEncodingWindowsLatin1)+  CFStringEncodingISOLatin1 -> (#const kCFStringEncodingISOLatin1)+  CFStringEncodingNextStepLatin -> (#const kCFStringEncodingNextStepLatin)+  CFStringEncodingASCII -> (#const kCFStringEncodingASCII)+  CFStringEncodingUnicode -> (#const kCFStringEncodingUnicode)+  CFStringEncodingUTF8 -> (#const kCFStringEncodingUTF8)+  CFStringEncodingNonLossyASCII -> (#const kCFStringEncodingNonLossyASCII)+  CFStringEncodingUTF16 -> (#const kCFStringEncodingUTF16)+  CFStringEncodingUTF16BE -> (#const kCFStringEncodingUTF16BE)+  CFStringEncodingUTF16LE -> (#const kCFStringEncodingUTF16LE)+  CFStringEncodingUTF32 -> (#const kCFStringEncodingUTF32)+  CFStringEncodingUTF32BE -> (#const kCFStringEncodingUTF32BE)+  CFStringEncodingUTF32LE -> (#const kCFStringEncodingUTF32LE)++data CFString_+type CFStringRef = Ptr CFString_+instance CFClass CFString_+type CFString = Object CFString_++foreign import ccall unsafe "CFStringGetCString"+  cfStringGetCString+  :: CFStringRef -> CString -> CFIndex -> ForeignCFStringEncoding -> IO CBool++foreign import ccall "CFStringCreateWithCString" cfStringCreateWithCString+  :: CFAllocatorRef -> Ptr a -> ForeignCFStringEncoding -> IO CFStringRef++foreign import ccall "CFStringGetLength"+  cfStringGetLength :: CFStringRef -> IO CFIndex++foreign import ccall "CFStringGetMaximumSizeForEncoding"+  cfStringGetMaximumSizeForEncoding+  :: CFIndex -> ForeignCFStringEncoding -> IO CFIndex++-- | Creates a CFString reference from a C-style string, using a provided+-- allocator and string encoding.+fromCStringWithAllocator+  :: MonadIO m => Allocator -> CString -> CFStringEncoding -> m CFString+fromCStringWithAllocator allo cstr enc = liftIO $ withCFPtr allo $ \pallo ->+  cfStringCreateWithCString pallo cstr (toForeignEncoding enc) >>= manageCFObj++-- | Creates a CFString reference from an ASCII-encoded C-style string, using a+-- default allocator.+fromCString :: MonadIO m => CFStringEncoding -> CString -> m CFString+fromCString enc cstr =+  liftIO (nullAllocator >>= \allo -> fromCStringWithAllocator allo cstr enc)++-- | Creates a CFString reference from a regular string with ASCII encoding.+fromString :: MonadIO m => CFStringEncoding -> String -> m CFString+fromString enc str = liftIO (newCString str >>= fromCString enc)++-- | Converts a Core Foundation String to a C-style null-terminated string. It+-- returns 'Nothing' if the conversion is unsuccessfull.+toCString :: MonadIO m => CFStringEncoding -> CFString -> m (Maybe CString)+toCString enc cfs = liftIO . withCFPtr cfs $ \s -> do+  len <- cfStringGetLength s+  bytes <- cfStringGetMaximumSizeForEncoding len foreignEnc -- stringEncodingUTF8+  cstr <- mallocArray (fromIntegral bytes + 1)+  res <- cfStringGetCString s cstr (bytes + 1) foreignEnc -- stringEncodingUTF8+  if toBool res+    then pure (Just cstr)+    else free cstr >> pure Nothing+  where foreignEnc = toForeignEncoding enc++-- | Converts a CFString reference to a regular string.+toString :: MonadIO m => CFStringEncoding -> CFString -> m (Maybe String)+toString enc =+  liftIO . (maybe (pure Nothing) (fmap Just . peekCString) <=< toCString enc)
+ src/MacSdk/Framework/CoreFoundation/UUID.hs view
@@ -0,0 +1,12 @@+module MacSdk.Framework.CoreFoundation.UUID+  ( CFUUIDRef+  , UUID+  ) where++import Foreign+import MacSdk.Framework.CoreFoundation.Object++data CFUUID+type CFUUIDRef = Ptr CFUUID+instance CFClass CFUUID where+type UUID = Object CFUUID
+ src/MacSdk/Framework/CoreGraphics.hs view
@@ -0,0 +1,21 @@+module MacSdk.Framework.CoreGraphics+  ( module MacSdk.Framework.CoreGraphics.Connection+  , module MacSdk.Framework.CoreGraphics.Display+  , module MacSdk.Framework.CoreGraphics.Dock+  , module MacSdk.Framework.CoreGraphics.Error+  , module MacSdk.Framework.CoreGraphics.Event+  , module MacSdk.Framework.CoreGraphics.Rect+  , module MacSdk.Framework.CoreGraphics.Space+  , module MacSdk.Framework.CoreGraphics.Mouse+  , module MacSdk.Framework.CoreGraphics.Window+  ) where++import MacSdk.Framework.CoreGraphics.Connection+import MacSdk.Framework.CoreGraphics.Display+import MacSdk.Framework.CoreGraphics.Dock+import MacSdk.Framework.CoreGraphics.Error (CGError(..), AsCGError(..))+import MacSdk.Framework.CoreGraphics.Event+import MacSdk.Framework.CoreGraphics.Rect+import MacSdk.Framework.CoreGraphics.Space+import MacSdk.Framework.CoreGraphics.Mouse+import MacSdk.Framework.CoreGraphics.Window
+ src/MacSdk/Framework/CoreGraphics/Connection.hs view
@@ -0,0 +1,14 @@+module MacSdk.Framework.CoreGraphics.Connection where++import Data.Int++type ConnectionID = Int32++foreign import ccall unsafe "CGSMainConnectionID"+  mainConnection :: IO ConnectionID++foreign import ccall unsafe "_CGSDefaultConnection"+  defaultConnection :: IO ConnectionID++defaultConnection' :: ConnectionID+defaultConnection' = 217615
+ src/MacSdk/Framework/CoreGraphics/Display.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++module MacSdk.Framework.CoreGraphics.Display+  ( DisplayID+  , DisplayChange(..)+  , DisplayReconfigurationCallback+  , DisplayCallbackToken+  , displayUUID+  , uuidString'+  , displayBounds+  , displayCount+  , activeDisplays+  , activeDisplay+  , setDisplayCallback+  , removeDisplayCallback+  , displayForWindow'+  ) where++import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.CoreGraphics.Error+import MacSdk.Framework.CoreGraphics.Rect+import MacSdk.Framework.CoreGraphics.Window.Types+-- import MacSdk.Framework.Types (WindowID)++import Data.Word+import Data.Bits+import Control.Monad+import Prelude hiding (String)+import Control.Monad.Managed+import Foreign.C.Types (CUInt(..), CInt(..))+import Foreign.Ptr+import Foreign.Marshal.Array+import Foreign hiding (with)++type DisplayID = Word32++foreign import ccall unsafe "CGDisplayCreateUUIDFromDisplayID"+  cgCreateUUIDFromDisplayID :: DisplayID -> IO CFUUIDRef++displayUUID :: DisplayID -> IO UUID+displayUUID = cgCreateUUIDFromDisplayID >=> manageCFObj++foreign import ccall unsafe "CFUUIDCreateString"+  cfUUIDCreateString :: CFAllocatorRef -> CFUUIDRef -> IO CFStringRef++uuidString :: Allocator -> UUID -> IO CFString+uuidString al uuid = flip with pure $ do+  al' <- managed $ withCFPtr al+  uuid' <- managed $ withCFPtr uuid+  liftIO $ cfUUIDCreateString al' uuid' >>= manageCFObj++uuidString' :: UUID -> IO CFString+uuidString' uuid = nullAllocator >>= flip uuidString uuid++foreign import ccall unsafe cgDisplayBounds_ :: CUInt -> Ptr Rect -> IO ()++displayBounds :: DisplayID -> IO Rect+displayBounds dId = alloca $ \p -> do+  cgDisplayBounds_ (fromIntegral dId) p+  peek p++foreign import ccall unsafe "CGGetActiveDisplayList"+  cgGetActiveDisplayList+  :: CUInt -> Ptr DisplayID -> Ptr CUInt -> IO ForeignCGError++displayCount :: (MonadIO m, MonadError e m, AsCGError e) => m Int+displayCount = except . liftIO . alloca $ \p -> do+  err <- cgGetActiveDisplayList 0 nullPtr p+  let res = intToCGError err+  either (pure . Left) (const (Right <$> (fmap fromIntegral $ peek p))) res++activeDisplays :: (MonadIO m, MonadError e m, AsCGError e) => Int -> m [DisplayID]+activeDisplays maxIds = except . liftIO . allocaArray maxIds $ \p -> alloca $ \q -> do+  err <- cgGetActiveDisplayList (fromIntegral maxIds) p q+  let res = intToCGError err+  either (pure . Left)+    (const (fromIntegral <$> peek q >>= \count ->+               Right <$> peekArray count p)) res++--------------------------------------------------------------------------------++type DisplayChangeSummaryFlags = Word32++beginConfigFlag, movedFlag, setMainFlag, setModeFlag, addFlag, removeFlag,+  enabledFlag, disabledFlag, mirrorFlag, unmirrorFlag,+    desktopShapeChangedFlag :: DisplayChangeSummaryFlags+beginConfigFlag = 1+movedFlag = 1 `shiftL` 1+setMainFlag = 1 `shiftL` 2+setModeFlag = 1 `shiftL` 3+addFlag = 1 `shiftL` 4+removeFlag = 1 `shiftL` 5+enabledFlag = 1 `shiftL` 8+disabledFlag = 1 `shiftL` 9+mirrorFlag = 1 `shiftL` 10+unmirrorFlag = 1 `shiftL` 11+desktopShapeChangedFlag = 1 `shiftL` 12++data DisplayChange+  = DisplayBeginConfig+  | DisplayMoved+  | DisplaySetMain+  | DisplaySetMode+  | DisplayAdd+  | DisplayRemove+  | DisplayEnabled+  | DisplayDisabled+  | DisplayMirror+  | DisplayUnmirror+  | DisplayDesktopShapeChanged+  deriving (Eq)++toDisplayChange :: DisplayChangeSummaryFlags -> Maybe DisplayChange+toDisplayChange fl+  | Foreign.toBool (fl .&. beginConfigFlag) = Just DisplayBeginConfig+  | Foreign.toBool (fl .&. movedFlag) = Just DisplayMoved+  | Foreign.toBool (fl .&. setMainFlag) = Just DisplaySetMain+  | Foreign.toBool (fl .&. setModeFlag) = Just DisplaySetMode+  | Foreign.toBool (fl .&. addFlag) = Just DisplayAdd+  | Foreign.toBool (fl .&. removeFlag) = Just DisplayRemove+  | Foreign.toBool (fl .&. enabledFlag) = Just DisplayEnabled+  | Foreign.toBool (fl .&. disabledFlag) = Just DisplayDisabled+  | Foreign.toBool (fl .&. mirrorFlag) = Just DisplayMirror+  | Foreign.toBool (fl .&. unmirrorFlag) = Just DisplayUnmirror+  | Foreign.toBool (fl .&. desktopShapeChangedFlag) = Just DisplayDesktopShapeChanged+  | otherwise = Nothing++--------------------------------------------------------------------------------++type CGDisplayReconfigurationCallback =+  DisplayID -> DisplayChangeSummaryFlags -> Ptr () -> IO ()++foreign import ccall unsafe "wrapper" wrap_display_callback+  :: CGDisplayReconfigurationCallback -> IO (FunPtr CGDisplayReconfigurationCallback)++type DisplayReconfigurationCallback = DisplayID -> DisplayChange -> IO ()++toCGCallback :: DisplayReconfigurationCallback -> CGDisplayReconfigurationCallback+toCGCallback cb did flags _ = maybe (pure ()) (cb did) (toDisplayChange flags)++foreign import ccall "CGDisplayRegisterReconfigurationCallback"+  cgDisplayRegisterReconfigurationCallback_+  :: FunPtr CGDisplayReconfigurationCallback -> Ptr () -> IO ForeignCGError++foreign import ccall "CGDisplayRemoveReconfigurationCallback"+  cgDisplayRemoveReconfigurationCallback+  :: FunPtr CGDisplayReconfigurationCallback -> Ptr () -> IO ForeignCGError++newtype DisplayCallbackToken =+  DisplayCallbackToken (FunPtr CGDisplayReconfigurationCallback)++setDisplayCallback+  :: (MonadIO m, MonadError e m, AsCGError e) => DisplayReconfigurationCallback+  -> m DisplayCallbackToken+setDisplayCallback f = do+  fp <- liftIO $ wrap_display_callback (toCGCallback f)+  err <- liftIO $+    intToCGError <$> cgDisplayRegisterReconfigurationCallback_ fp nullPtr+  except (pure (err >> pure (DisplayCallbackToken fp)))++removeDisplayCallback+  :: (MonadIO m, MonadError e m, AsCGError e) => DisplayCallbackToken -> m ()+removeDisplayCallback (DisplayCallbackToken fp) =+  except . liftIO . fmap intToCGError $+    cgDisplayRemoveReconfigurationCallback fp nullPtr++-- foreign import ccall unsafe "CGSCopyManagedDisplayForWindow"+--   cgSCopyManagedDisplayForWindow_+--   :: ConnectionID -> CUInt -> IO CFStringRef++-- displayForWindow :: ConnectionID -> WindowID -> IO String+-- displayForWindow cid wid =+--   cgSCopyManagedDisplayForWindow_ cid (fromIntegral wid) >>= manageCFObj++--------------------------------------------------------------------------------++foreign import ccall unsafe display_for_window :: WindowID -> IO CFStringRef++displayForWindow' :: WindowID -> IO CFString+displayForWindow' = display_for_window >=> manageCFObj++foreign import ccall unsafe activeDisplay :: IO DisplayID
+ src/MacSdk/Framework/CoreGraphics/Dock.hs view
@@ -0,0 +1,86 @@+module MacSdk.Framework.CoreGraphics.Dock+  ( DockPinning+  , DockOrientation+  , dockAutohides+  , dockOrientation+  , dockSize+  , menuBarAutohides+  ) where++import Foreign.C.Types (CBool(..), CFloat(..), CInt(..))+import Foreign.Ptr+import Foreign+import MacSdk.Framework.CoreGraphics.Connection++data DockPinning+  = DockPinningIgnore+  | DockPinningStart+  | DockPinningMiddle+  | DockPinningEnd+  deriving (Eq, Show)++type CoreDockPinning = CInt++-- fromDockPinning :: DockPinning -> CoreDockPinning+-- fromDockPinning DockPinningIgnore = 0+-- fromDockPinning DockPinningStart = 1+-- fromDockPinning DockPinningMiddle = 2+-- fromDockPinning DockPinningEnd = 3++data DockOrientation+  = DockIgnore+  | DockTop+  | DockBottom+  | DockLeft+  | DockRight+  deriving (Show)++type CoreDockOrientation = CInt++toDockOrientation :: CoreDockOrientation -> DockOrientation+toDockOrientation cdo+  | cdo == 0 = DockIgnore+  | cdo == 1 = DockTop+  | cdo == 2 = DockBottom+  | cdo == 3 = DockLeft+  | cdo == 4 = DockRight+  | otherwise = error "unknown dock orientation code"++-- fromDockOrientation :: DockOrientation -> CoreDockOrientation+-- fromDockOrientation DockIgnore = 0+-- fromDockOrientation DockTop = 1+-- fromDockOrientation DockBottom = 2+-- fromDockOrientation DockLeft = 3+-- fromDockOrientation DockRight = 4++foreign import ccall unsafe "CoreDockGetAutoHideEnabled"+  coreDockGetAutoHideEnabled :: IO CBool++dockAutohides :: IO Bool+dockAutohides = fmap toBool coreDockGetAutoHideEnabled++foreign import ccall unsafe "CoreDockGetOrientationAndPinning"+  coreDockGetOrientationAndPinning+  :: Ptr CoreDockOrientation -> Ptr CoreDockPinning -> IO ()++dockOrientation :: IO DockOrientation+dockOrientation = alloca $ \p -> alloca $ \q ->+  coreDockGetOrientationAndPinning p q >> fmap toDockOrientation (peek p)++foreign import ccall unsafe "CoreDockGetTileSize"+  coreDockGetTileSize :: IO CFloat++dockSize :: IO Double+dockSize = do+  ratio <- coreDockGetTileSize+  pure . realToFrac $ (ratio * (maxSize - minSize)) + minSize+  where maxSize = 128 ; minSize = 16++foreign import ccall unsafe "CGSGetMenuBarAutohideEnabled"+  cgSGetMenuBarAutohideEnabled :: ConnectionID -> Ptr CInt -> IO ()++menuBarAutohides :: IO Bool+menuBarAutohides = alloca $ \p -> do+  dc <- defaultConnection+  cgSGetMenuBarAutohideEnabled dc p+  fmap (== 1) $ peek p
+ src/MacSdk/Framework/CoreGraphics/Error.hsc view
@@ -0,0 +1,60 @@+module MacSdk.Framework.CoreGraphics.Error+  ( intToCGError+  , CGError(..)+  , ForeignCGError+  , AsCGError(..)+  , MonadError+  , except+  ) where++#include <Carbon/Carbon.h>++import Foreign.C.Types (CInt(..))+import Control.Exception (Exception)+import Data.Typeable (Typeable)++import MacSdk.Prism+import Control.Monad.Error.Class (MonadError(..))+import Control.Monad (join)++data CGError+  = CGErrorCannotComplete+  | CGErrorFailure+  | CGErrorIllegalArgument+  | CGErrorInvalidConnection+  | CGErrorInvalidContext+  | CGErrorInvalidOperation+  | CGErrorNoneAvailable+  | CGErrorNotImplemented+  | CGErrorRangeCheck+  | CGErrorTypeCheck+  | CGErrorUnknown Int+  deriving (Show, Typeable)++instance Exception CGError++type ForeignCGError = CInt++intToCGError :: CInt -> Either CGError ()+intToCGError x+  | x == (#const kCGErrorCannotComplete) = Left CGErrorCannotComplete+  | x == (#const kCGErrorFailure) = Left CGErrorFailure+  | x == (#const kCGErrorIllegalArgument) = Left CGErrorIllegalArgument+  | x == (#const kCGErrorInvalidConnection) = Left CGErrorInvalidConnection+  | x == (#const kCGErrorInvalidContext) = Left CGErrorInvalidContext+  | x == (#const kCGErrorInvalidOperation) = Left CGErrorInvalidOperation+  | x == (#const kCGErrorNoneAvailable) = Left CGErrorNoneAvailable+  | x == (#const kCGErrorNotImplemented) = Left CGErrorNotImplemented+  | x == (#const kCGErrorRangeCheck) = Left CGErrorRangeCheck+  | x == (#const kCGErrorSuccess) = Right ()+  | x == (#const kCGErrorTypeCheck) = Left CGErrorTypeCheck+  | otherwise = Left (CGErrorUnknown (fromIntegral x))++class AsCGError e where+  _CGError :: Prism' e CGError++instance AsCGError CGError where+  _CGError = id++except :: (MonadError e m, AsCGError e) => m (Either CGError a) -> m a+except = join . fmap (either (throwing _CGError) pure)
+ src/MacSdk/Framework/CoreGraphics/Event.hs view
@@ -0,0 +1,335 @@+{-|++Quarts Event Services. This module provides features for managing event+taps—filters for observing and altering the stream of low-level user input+events in macOS.++See: https://developer.apple.com/documentation/coregraphics/quartz_event_services?language=objc++-}++module MacSdk.Framework.CoreGraphics.Event+  ( Event+  , EventType(..)+  , EventField(..)+  , EventSource+  , EventTapLocation(..)+  , EventTapCallback+  , MouseButtonPress(..)+  , KeyEventPosition(..)+  , CGKeyCode+  , module MacSdk.Framework.CoreGraphics.Event.Flag+  -- * Events+  , eventCreate+  , createMouseEvent+  , createKeyboardEvent+  , eventFlags+  , getEventField+  , eventGetType+  , eventSetType+  , eventSetFlags+  -- * Event taps+  , EventTap+  , eventTapEnable+  , eventTapDisable+  , eventPost+  , eventTapCreate+  , eventTapMachPort+  , eventTapRelease+  , QuartzEvents(..)+  , kCGSessionEventTap+  , kCGHeadInsertEventTap+  , kCGEventTapOptionDefault+  ) where++import Foreign.C.Types (CInt(..), CBool(..))+import Foreign.Ptr+import Foreign+import System.IO.Unsafe+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad (guard)+import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.CoreGraphics.Rect+import MacSdk.Framework.CoreGraphics.Event.Type+import MacSdk.Framework.CoreGraphics.Event.Flag+import MacSdk.Framework.CoreGraphics.Event.Field+import MacSdk.Framework.CoreGraphics.Event.Mask+import MacSdk.Framework.CoreGraphics.Event.Location++data CGEvent+type CGEventRef = Ptr CGEvent+-- | Type of low-level Quartz events. A typical event in macOS originates when+-- the user manipulates an input device such as a mouse or a keyboard. You can+-- use event taps to gain access to Quartz events.+type Event = Object CGEvent+instance CFClass CGEvent+  +data CGEventSource+type CGEventSourceRef = Ptr CGEventSource+-- | Type of objects representing the source of a Quartz event.+type EventSource = Object CGEventSource+instance CFClass CGEventSource++--------------------------------------------------------------------------------+-- Working with Events++foreign import ccall unsafe "CGEventCreate"+  cg_event_create :: CGEventSourceRef -> IO CGEventRef++-- | Returns a new Quartz event to be filled in. If no event source is+-- specified, a default source is used. Returns 'Nothing' if the event could not+-- be created.+eventCreate :: Maybe EventSource -> IO (Maybe Event)+eventCreate = maybe (aux nullPtr) (flip withCFPtr aux)+  where+    aux p = do+      ref <- cg_event_create p+      if ref == nullPtr+        then pure Nothing+        else Just <$> manageCFObj ref++type CGMouseButton = Word32+data MouseButtonPress = LeftButtonPress | RightButtonPress | CenterButtonPress+toPressCode :: MouseButtonPress -> CGMouseButton+toPressCode = \case+  LeftButtonPress -> 0+  RightButtonPress -> 1+  CenterButtonPress -> 2++foreign import ccall unsafe "CGEventCreateMouseEvent_"+  cg_event_create_mouse_event+  :: CGEventSourceRef -> CGEventType -> Ptr Point -> CGMouseButton -> IO CGEventRef++-- | Returns a new Quartz mouse event. If no event source is specified, a+-- default source is used. Returns 'Nothing' if the event could not be created.+createMouseEvent+  :: Maybe EventSource -> EventType -> Point -> MouseButtonPress -> IO (Maybe Event)+createMouseEvent mes ety p mbp = maybe (aux nullPtr) (flip withCFPtr aux) mes+  where aux es = alloca $ \ptr -> do+          poke ptr p+          ref <- cg_event_create_mouse_event es+                   (toEventTypeCode ety) ptr (toPressCode mbp)+          if ref == nullPtr then pure Nothing else Just <$> manageCFObj ref++--------------------------------------------------------------------------------++type CGKeyCode = Word32++foreign import ccall unsafe "CGEventCreateKeyboardEvent"+  cg_event_create_keyboard_event+  :: CGEventSourceRef -> CGKeyCode -> CBool -> IO CGEventRef++data KeyEventPosition = KeyDown | KeyUp++createKeyboardEvent+  :: MonadIO m+  => Maybe EventSource -> CGKeyCode -> KeyEventPosition -> m (Maybe Event)+createKeyboardEvent mes k pos =+  liftIO $ maybe (aux nullPtr) (flip withCFPtr aux) mes+  where aux es = do+          res <- cg_event_create_keyboard_event es k $+            case pos of { KeyDown -> 1 ; KeyUp -> 0 }+          if res == nullPtr then pure Nothing else Just <$> manageCFObj res++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGEventSetFlags"+  cg_event_set_flags :: CGEventRef -> CGEventFlags -> IO ()++eventSetFlags :: MonadIO m => Event -> CGEventFlags -> m ()+eventSetFlags e flags =+  liftIO $ withCFPtr e (flip cg_event_set_flags flags)++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGEventPost"+  cg_event_post :: CGEventTapLocation -> CGEventRef -> IO ()++-- | Posts a Quartz event into the event stream at a specified location.+eventPost :: MonadIO m => EventTapLocation -> Event -> m ()+eventPost loc ev =+  liftIO $ withCFPtr ev (cg_event_post (toCGEventTapLocation loc))++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGEventSetType"+  cg_event_set_type :: CGEventRef -> CGEventType -> IO ()++-- | Sets the event type of a Quartz event.+eventSetType :: MonadIO m => Event -> EventType -> m ()+eventSetType ev ety =+  liftIO $ withCFPtr ev (flip cg_event_set_type (toEventTypeCode ety))++--------------------------------------------------------------------------------++type CGEventType = Word32++foreign import ccall unsafe "CGEventGetType"+  cg_event_get_type :: CGEventRef -> IO CGEventType++-- | Returns the event type of a Quartz event (left mouse down, for example).+eventGetType :: Event -> IO EventType+eventGetType = flip withCFPtr (fmap fromEventTypeCode . cg_event_get_type)++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGSIsSecureEventInputSet"+  check_secure_input_set :: IO CBool++checkSecureInputSet :: IO Bool+checkSecureInputSet = fmap Foreign.toBool check_secure_input_set++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGEventGetFlags"+  cgEventGetFlags :: CGEventRef -> IO CGEventFlags++-- | Returns the event flags of a Quartz event.+eventFlags :: Event -> IO CGEventFlags+eventFlags = flip withCFPtr cgEventGetFlags++--------------------------------------------------------------------------------++type CGEventField = Word32++foreign import ccall unsafe "CGEventGetIntegerValueField"+  cgEventGetIntegerValueField :: CGEventRef -> CGEventField -> IO Word64++foreign import ccall unsafe "CGEventGetDoubleValueField"+  cgEventGetDoubleValueField :: CGEventRef -> CGEventField -> IO Double++getEventField :: Event -> EventField ty -> IO ty+getEventField e efs = withCFPtr e $ \p ->+  let code = toEventFieldCode efs+  in decideFieldType (cgEventGetIntegerValueField p code)+                     (cgEventGetDoubleValueField p code) efs++--------------------------------------------------------------------------------++foreign import ccall unsafe "CGEventTapEnable"+  cg_event_tap_enable :: CFMachPortRef -> CBool -> IO ()++-- | Enables an event tap.+--+-- Event taps are normally enabled when created. If an event tap becomes+-- unresponsive, or if a user requests that event taps be disabled, then a+-- EventTapDisabled event is passed to the event tap callback function. Event+-- taps may be re-enabled by calling this function.+eventTapEnable :: MonadIO m => EventTap -> m ()+eventTapEnable = liftIO . flip withCFPtr (`cg_event_tap_enable` 1) . _etMachPort++-- | Disables an event tap.+eventTapDisable :: MonadIO m => EventTap -> m ()+eventTapDisable = liftIO . flip withCFPtr (`cg_event_tap_enable` 0) . _etMachPort++--------------------------------------------------------------------------------++type CGEventTapPlacement = CInt+type CGEventTapOptions = CInt++foreign import ccall unsafe mykCGSessionEventTap :: IO CGEventTapLocation+kCGSessionEventTap :: CGEventTapLocation+kCGSessionEventTap = unsafePerformIO mykCGSessionEventTap+{-# NOINLINE kCGSessionEventTap #-}++foreign import ccall unsafe mykCGHeadInsertEventTap :: IO CGEventTapPlacement+kCGHeadInsertEventTap :: CGEventTapPlacement+kCGHeadInsertEventTap = unsafePerformIO mykCGHeadInsertEventTap+{-# NOINLINE kCGHeadInsertEventTap #-}++foreign import ccall unsafe mykCGEventTapOptionDefault :: IO CGEventTapOptions+kCGEventTapOptionDefault :: CGEventTapOptions+kCGEventTapOptionDefault = unsafePerformIO mykCGEventTapOptionDefault+{-# NOINLINE kCGEventTapOptionDefault #-}++data CGEventTapProxy_+type CGEventTapProxy = Ptr CGEventTapProxy_++-- | Type that represents state within the client application that’s associated+-- with an event tap.+newtype EventTapProxy = EventTapProxy { getEventTapProxy :: CGEventTapProxy }++type CGEventTapCallBack =+  CGEventTapProxy -> CGEventType -> CGEventRef -> Ptr () -> IO CGEventRef++-- | Type of client-supplied callback function that’s invoked whenever an+-- associated event tap receives a Quartz event.+-- +-- An event tap proxy object is passed to the callback function when it receives+-- a new Quartz event. The function needs the proxy to post Quartz events using+-- the function 'eventTapPostEvent'.+--+-- If the event tap is an active filter, your callback function should return+-- one of the following:+--+-- * The (possibly modified) event that is passed in, or a newly-constructed+-- event, wrapped in 'Just'. This event is passed back to the event system.+-- +-- * 'Nothing' if the event passed in is to be deleted.+--+-- If the event tap is an passive listener, the callback function may return the+-- event that is passed in wrapped in 'Just', or 'Nothing'. In either case, the+-- event stream is not affected.+type EventTapCallback a =+  EventTapProxy -> EventType -> Event -> a -> IO (Maybe Event)++foreign import ccall "wrapper"+  wrapCGEventTapCallBack :: CGEventTapCallBack -> IO (FunPtr CGEventTapCallBack)++foreign import ccall "CGEventTapCreate" cgEventTapCreate+  :: CGEventTapLocation -> CGEventTapPlacement -> CGEventTapOptions+  -> CGEventMask -> FunPtr CGEventTapCallBack -> Ptr () -> IO CFMachPortRef++data EventTap = EventTap+  { _etMachPort :: MachPort+  , _etMachPortRef :: Ref+  , _etCallb :: FunPtr CGEventTapCallBack+  }++eventTapMachPort :: EventTap -> MachPort+eventTapMachPort = _etMachPort++eventTapRelease :: MonadIO m => EventTap -> m ()+eventTapRelease (EventTap _ ref cb) =+  liftIO (refRelease ref >> freeHaskellFunPtr cb)++-- | Returns a newly-created 'EventTap', or 'Nothing' if the event tap could not+-- be created. When you are finished using the event tap, you should release it+-- using the function 'eventTapRelease'.+--+-- Event taps receive key up and key down events if one of the following+-- conditions is true:+--+-- * The current process is running as the root user.+--+-- * Access for assistive devices is enabled. In OS X v10.4, you can enable this+-- feature using System Preferences, Universal Access panel, Keyboard view. You+-- should check whether AX privileges have been granted with 'checkAXPrivileges'.+-- +-- After creating an event tap, you can add it to a run loop as follows:+--+-- * Retrieve the event tap's 'MachPort' with 'eventTapMachPort' and pass it to+-- the 'machPortRunLoopSource' function to create a run loop event source.+--+-- * Call the 'runLoopAddSource' function to add the source to the appropriate+-- run loop.+-- +-- Alternatively, you can 'addSourceToMainLoop' to start the event tap with+-- default parameters.+eventTapCreate+  :: CGEventTapLocation -> CGEventTapPlacement -> CGEventTapOptions+  -> QuartzEvents -> EventTapCallback a -> a -> IO (Maybe EventTap)+eventTapCreate l p o evs callb userData = do+  ptr <- castStablePtrToPtr <$> newStablePtr userData+  c' <- wrapCGEventTapCallBack $ \proxy ety e ptr' -> do+    ev <- retainManageCFObj e+    x <- deRefStablePtr (castPtrToStablePtr ptr')+    me <- callb (EventTapProxy proxy) (fromEventTypeCode ety) ev x+    maybe (pure nullPtr) (flip withCFPtr pure) me+  machPtr <- cgEventTapCreate l p o (getEventMask (toMask evs)) c' ptr+  mach <- manageCFObj machPtr+  ref <- objRetain mach+  -- Event taps are normally enabled when created. If not, something went wrong+  -- and we fail.+  en <- toBool <$> cgEventTapIsEnabled machPtr+  pure $ guard (machPtr /= nullPtr && en) >> Just (EventTap mach ref c')
+ src/MacSdk/Framework/CoreGraphics/Event/Field.hsc view
@@ -0,0 +1,472 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}++-- | Constants and ADTs used as keys to access specialized fields in low-level+-- Quartz events.++module MacSdk.Framework.CoreGraphics.Event.Field where++#include <Carbon/Carbon.h>++import Data.Word++data EventField :: * -> * where+  -- | Key to access an integer field that contains the mouse button event number.+  -- Matching mouse-down and mouse-up events will have the same event number.+  MouseEventNumber :: EventField Word64++  -- | Key to access an integer field that contains the mouse button click state.+  -- A click state of 1 represents a single click. A click state of 2 represents a+  -- double-click. A click state of 3 represents a triple-click.+  MouseEventClickState :: EventField Word64++  -- | Key to access a double field that contains the mouse button pressure. The+  -- pressure value may range from 0 to 1, with 0 representing the mouse being up.+  -- This value is commonly set by tablet pens mimicking a mouse.+  MouseEventPressure :: EventField Double++  -- | Key to access an integer field that contains the mouse button number. For+  -- information about the possible values, see CGMouseButton.+  MouseEventButtonNumber :: EventField Word64++  -- | Key to access an integer field that contains the horizontal mouse delta+  -- since the last mouse movement event.+  MouseEventDeltaX :: EventField Word64++  -- | Key to access an integer field that contains the vertical mouse delta since+  -- the last mouse movement event.+  MouseEventDeltaY :: EventField Word64++  -- | Key to access an integer field. The value is non-zero if the event should+  -- be ignored by the Inkwell subsystem.+  MouseEventInstantMouser :: EventField Word64++  -- | Key to access an integer field that encodes the mouse event subtype as a+  -- kCFNumberIntType.+  MouseEventSubtype :: EventField Word64++  -- | Key to access an integer field, non-zero when this is an autorepeat of a+  -- key-down, and zero otherwise.+  KeyboardEventAutorepeat :: EventField Word64++  -- | Key to access an integer field that contains the virtual keycode of the+  -- key-down or key-up event.+  KeyboardEventKeycode :: EventField Word64++  -- | Key to access an integer field that contains the keyboard type identifier.+  KeyboardEventKeyboardType :: EventField Word64++  -- | Key to access an integer field that contains scrolling data. This field+  -- typically contains the change in vertical position since the last scrolling+  -- event from a Mighty Mouse scroller or a single-wheel mouse scroller.+  ScrollWheelEventDeltaAxis1 :: EventField Double++  -- | Key to access an integer field that contains scrolling data. This field+  -- typically contains the change in horizontal position since the last scrolling+  -- event from a Mighty Mouse scroller.+  ScrollWheelEventDeltaAxis2 :: EventField Double++  -- | Key to access a field that contains scrolling data. The scrolling data+  -- represents a line-based or pixel-based change in vertical position since the+  -- last scrolling event from a Mighty Mouse scroller or a single-wheel mouse+  -- scroller. The scrolling data uses a fixed-point 16.16 signed integer format.+  -- For example, if the field contains a value of 1.0, the integer 0x00010000 is+  -- returned by CGEventGetIntegerValueField. If this key is passed to+  -- CGEventGetDoubleValueField, the fixed-point value is converted to a double+  -- value.+  ScrollWheelEventFixedPtDeltaAxis1 :: EventField Word64++  -- | Key to access a field that contains scrolling data. The scrolling data+  -- represents a line-based or pixel-based change in horizontal position since+  -- the last scrolling event from a Mighty Mouse scroller. The scrolling data+  -- uses a fixed-point 16.16 signed integer format. For example, if the field+  -- contains a value of 1.0, the integer 0x00010000 is returned by+  -- CGEventGetIntegerValueField. If this key is passed to+  -- CGEventGetDoubleValueField, the fixed-point value is converted to a double+  -- value.+  ScrollWheelEventFixedPtDeltaAxis2 :: EventField Word64++  -- | Key to access an integer field that contains pixel-based scrolling data.+  -- The scrolling data represents the change in vertical position since the last+  -- scrolling event from a Mighty Mouse scroller or a single-wheel mouse+  -- scroller.+  ScrollWheelEventPointDeltaAxis1 :: EventField Word64++  -- | Key to access an integer field that contains pixel-based scrolling data.+  -- The scrolling data represents the change in horizontal position since the+  -- last scrolling event from a Mighty Mouse scroller.+  ScrollWheelEventPointDeltaAxis2 :: EventField Word64++  -- | Key to access an integer field that indicates whether the event should be+  -- ignored by the Inkwell subsystem. If the value is non-zero, the event should be ignored.+  ScrollWheelEventInstantMouser :: EventField Word64++  -- | Key to access an integer field that contains the absolute X coordinate in+  -- tablet space at full tablet resolution.+  TabletEventPointX :: EventField Word64++  -- | Key to access an integer field that contains the absolute Y coordinate in+  -- tablet space at full tablet resolution.+  TabletEventPointY :: EventField Word64++  -- | Key to access an integer field that contains the absolute Z coordinate in+  -- tablet space at full tablet resolution.+  TabletEventPointZ :: EventField Word64++  -- | Key to access an integer field that contains the tablet button state. Bit 0+  -- is the first button, and a set bit represents a closed or pressed button. Up+  -- to 16 buttons are supported.+  TabletEventPointButtons :: EventField Word64++  -- | Key to access a double field that contains the tablet pen pressure.+  -- A value of 0.0 represents no pressure, and 1.0 represents maximum pressure.+  TabletEventPointPressure :: EventField Double++  -- | Key to access a double field that contains the horizontal tablet pen tilt.+  -- A value of 0.0 represents no tilt, and 1.0 represents maximum tilt.+  TabletEventTiltX :: EventField Double++  -- | Key to access a double field that contains the vertical tablet pen tilt.+  -- A value of 0.0 represents no tilt, and 1.0 represents maximum tilt.+  TabletEventTiltY :: EventField Double++  -- | Key to access a double field that contains the tablet pen rotation.+  TabletEventRotation :: EventField Double++  -- | Key to access a double field that contains the tangential pressure on the+  -- device. A value of 0.0 represents no pressure, and 1.0 represents maximum+  -- pressure.+  TabletEventTangentialPressure :: EventField Double++  -- | Key to access an integer field that contains the system-assigned unique+  -- device ID.+  TabletEventDeviceID :: EventField Word64++  -- | Key to access an integer field that contains a vendor-specified value.+  TabletEventVendor1 :: EventField Word64++  -- | Key to access an integer field that contains a vendor-specified value.+  TabletEventVendor2 :: EventField Word64++  -- | Key to access an integer field that contains a vendor-specified value.+  TabletEventVendor3 :: EventField Word64++  -- | Key to access an integer field that contains the vendor-defined ID,+  -- typically the USB vendor ID.+  TabletProximityEventVendorID :: EventField Word64++  -- | Key to access an integer field that contains the vendor-defined tablet ID,+  -- typically the USB product ID.+  TabletProximityEventTabletID :: EventField Word64++  -- | Key to access an integer field that contains the vendor-defined ID of the+  -- pointing device.+  TabletProximityEventPointerID :: EventField Word64++  -- | Key to access an integer field that contains the system-assigned device ID.+  TabletProximityEventDeviceID :: EventField Word64++  -- | Key to access an integer field that contains the system-assigned unique+  -- tablet ID.+  TabletProximityEventSystemTabletID :: EventField Word64++  -- | Key to access an integer field that contains the vendor-assigned pointer+  -- type.+  TabletProximityEventVendorPointerType :: EventField Word64++  -- | Key to access an integer field that contains the vendor-defined pointer+  -- serial number.+  TabletProximityEventVendorPointerSerialNumber :: EventField Word64++  -- | Key to access an integer field that contains the vendor-defined unique ID.+  TabletProximityEventVendorUniqueID :: EventField Word64++  -- | Key to access an integer field that contains the device capabilities mask.+  TabletProximityEventCapabilityMask :: EventField Word64++  -- | Key to access an integer field that contains the pointer type.+  TabletProximityEventPointerType :: EventField Word64++  -- | Key to access an integer field that indicates whether the pen is in+  -- proximity to the tablet. The value is non-zero if the pen is in proximity to+  -- the tablet and zero when leaving the tablet.+  TabletProximityEventEnterProximity :: EventField Word64++  -- | Key to access a field that contains the event target process serial+  -- number. The value is a 64-bit long word.+  EventTargetProcessSerialNumber :: EventField Word64++  -- | Key to access a field that contains the event target Unix process ID.+  EventTargetUnixProcessID :: EventField Word64++  -- | Key to access a field that contains the event source Unix process ID.+  EventSourceUnixProcessID :: EventField Word64++  -- | Key to access a field that contains the event source user-supplied data,+  -- up to 64 bits.+  EventSourceUserData :: EventField Word64++  -- | Key to access a field that contains the event source Unix effective UID.+  EventSourceUserID :: EventField Word64++  -- | Key to access a field that contains the event source Unix effective GID.+  EventSourceGroupID :: EventField Word64++  -- | Key to access a field that contains the event source state ID used to+  -- create this event.+  EventSourceStateID :: EventField Word64++  -- | Key to access an integer field that indicates whether a scrolling event+  -- contains continuous, pixel-based scrolling data. The value is non-zero when+  -- the scrolling data is pixel-based and zero when the scrolling data is+  -- line-based.+  ScrollWheelEventIsContinuous :: EventField Word64++  MouseEventWindowUnderMousePointer :: EventField Word64++  MouseEventWindowUnderMousePointerThatCanHandleThisEvent :: EventField Word64++  ScrollWheelEventMomentumPhase :: EventField Word64++  ScrollWheelEventScrollCount :: EventField Word64++  ScrollWheelEventScrollPhase :: EventField Word64++mouseEventNumber :: Word32+mouseEventNumber = #const kCGMouseEventNumber+mouseEventClickState :: Word32+mouseEventClickState = #const kCGMouseEventClickState+mouseEventPressure :: Word32+mouseEventPressure = #const kCGMouseEventPressure+mouseEventButtonNumber :: Word32+mouseEventButtonNumber = #const kCGMouseEventButtonNumber+mouseEventDeltaX :: Word32+mouseEventDeltaX = #const kCGMouseEventDeltaX+mouseEventDeltaY :: Word32+mouseEventDeltaY = #const kCGMouseEventDeltaY+mouseEventInstantMouser :: Word32+mouseEventInstantMouser = #const kCGMouseEventInstantMouser+mouseEventSubtype :: Word32+mouseEventSubtype = #const kCGMouseEventSubtype+keyboardEventAutorepeat :: Word32+keyboardEventAutorepeat = #const kCGKeyboardEventAutorepeat+keyboardEventKeycode :: Word32+keyboardEventKeycode = #const kCGKeyboardEventKeycode+keyboardEventKeyboardType :: Word32+keyboardEventKeyboardType = #const kCGKeyboardEventKeyboardType+scrollWheelEventDeltaAxis1 :: Word32+scrollWheelEventDeltaAxis1 = #const kCGScrollWheelEventDeltaAxis1+scrollWheelEventDeltaAxis2 :: Word32+scrollWheelEventDeltaAxis2 = #const kCGScrollWheelEventDeltaAxis2+scrollWheelEventDeltaAxis3 :: Word32+scrollWheelEventDeltaAxis3 = #const kCGScrollWheelEventDeltaAxis3+scrollWheelEventFixedPtDeltaAxis1 :: Word32+scrollWheelEventFixedPtDeltaAxis1 = #const kCGScrollWheelEventFixedPtDeltaAxis1+scrollWheelEventFixedPtDeltaAxis2 :: Word32+scrollWheelEventFixedPtDeltaAxis2 = #const kCGScrollWheelEventFixedPtDeltaAxis2+scrollWheelEventFixedPtDeltaAxis3 :: Word32+scrollWheelEventFixedPtDeltaAxis3 = #const kCGScrollWheelEventFixedPtDeltaAxis3+scrollWheelEventPointDeltaAxis1 :: Word32+scrollWheelEventPointDeltaAxis1 = #const kCGScrollWheelEventPointDeltaAxis1+scrollWheelEventPointDeltaAxis2 :: Word32+scrollWheelEventPointDeltaAxis2 = #const kCGScrollWheelEventPointDeltaAxis2+scrollWheelEventPointDeltaAxis3 :: Word32+scrollWheelEventPointDeltaAxis3 = #const kCGScrollWheelEventPointDeltaAxis3+scrollWheelEventInstantMouser :: Word32+scrollWheelEventInstantMouser = #const kCGScrollWheelEventInstantMouser+tabletEventPointX :: Word32+tabletEventPointX = #const kCGTabletEventPointX+tabletEventPointY :: Word32+tabletEventPointY = #const kCGTabletEventPointY+tabletEventPointZ :: Word32+tabletEventPointZ = #const kCGTabletEventPointZ+tabletEventPointButtons :: Word32+tabletEventPointButtons = #const kCGTabletEventPointButtons+tabletEventPointPressure :: Word32+tabletEventPointPressure = #const kCGTabletEventPointPressure+tabletEventTiltX :: Word32+tabletEventTiltX = #const kCGTabletEventTiltX+tabletEventTiltY :: Word32+tabletEventTiltY = #const kCGTabletEventTiltY+tabletEventRotation :: Word32+tabletEventRotation = #const kCGTabletEventRotation+tabletEventTangentialPressure :: Word32+tabletEventTangentialPressure = #const kCGTabletEventTangentialPressure+tabletEventDeviceID :: Word32+tabletEventDeviceID = #const kCGTabletEventDeviceID+tabletEventVendor1 :: Word32+tabletEventVendor1 = #const kCGTabletEventVendor1+tabletEventVendor2 :: Word32+tabletEventVendor2 = #const kCGTabletEventVendor2+tabletEventVendor3 :: Word32+tabletEventVendor3 = #const kCGTabletEventVendor3+tabletProximityEventVendorID :: Word32+tabletProximityEventVendorID = #const kCGTabletProximityEventVendorID+tabletProximityEventTabletID :: Word32+tabletProximityEventTabletID = #const kCGTabletProximityEventTabletID+tabletProximityEventPointerID :: Word32+tabletProximityEventPointerID = #const kCGTabletProximityEventPointerID+tabletProximityEventDeviceID :: Word32+tabletProximityEventDeviceID = #const kCGTabletProximityEventDeviceID+tabletProximityEventSystemTabletID :: Word32+tabletProximityEventSystemTabletID = #const kCGTabletProximityEventSystemTabletID+tabletProximityEventVendorPointerType :: Word32+tabletProximityEventVendorPointerType = #const kCGTabletProximityEventVendorPointerType+tabletProximityEventVendorPointerSerialNumber :: Word32+tabletProximityEventVendorPointerSerialNumber = #const kCGTabletProximityEventVendorPointerSerialNumber+tabletProximityEventVendorUniqueID :: Word32+tabletProximityEventVendorUniqueID = #const kCGTabletProximityEventVendorUniqueID+tabletProximityEventCapabilityMask :: Word32+tabletProximityEventCapabilityMask = #const kCGTabletProximityEventCapabilityMask+tabletProximityEventPointerType :: Word32+tabletProximityEventPointerType = #const kCGTabletProximityEventPointerType+tabletProximityEventEnterProximity :: Word32+tabletProximityEventEnterProximity = #const kCGTabletProximityEventEnterProximity+eventTargetProcessSerialNumber :: Word32+eventTargetProcessSerialNumber = #const kCGEventTargetProcessSerialNumber+eventTargetUnixProcessID :: Word32+eventTargetUnixProcessID = #const kCGEventTargetUnixProcessID+eventSourceUnixProcessID :: Word32+eventSourceUnixProcessID = #const kCGEventSourceUnixProcessID+eventSourceUserData :: Word32+eventSourceUserData = #const kCGEventSourceUserData+eventSourceUserID :: Word32+eventSourceUserID = #const kCGEventSourceUserID+eventSourceGroupID :: Word32+eventSourceGroupID = #const kCGEventSourceGroupID+eventSourceStateID :: Word32+eventSourceStateID = #const kCGEventSourceStateID+scrollWheelEventIsContinuous :: Word32+scrollWheelEventIsContinuous = #const kCGScrollWheelEventIsContinuous+mouseEventWindowUnderMousePointer :: Word32+mouseEventWindowUnderMousePointer = #const kCGMouseEventWindowUnderMousePointer+mouseEventWindowUnderMousePointerThatCanHandleThisEvent :: Word32+mouseEventWindowUnderMousePointerThatCanHandleThisEvent = #const kCGMouseEventWindowUnderMousePointerThatCanHandleThisEvent+scrollWheelEventMomentumPhase :: Word32+scrollWheelEventMomentumPhase = #const kCGScrollWheelEventMomentumPhase+scrollWheelEventScrollCount :: Word32+scrollWheelEventScrollCount = #const kCGScrollWheelEventScrollCount+scrollWheelEventScrollPhase :: Word32+scrollWheelEventScrollPhase = #const kCGScrollWheelEventScrollPhase++toEventFieldCode :: EventField ty -> Word32+toEventFieldCode = \case+  MouseEventNumber -> mouseEventNumber+  MouseEventClickState -> mouseEventClickState+  MouseEventPressure -> mouseEventPressure+  MouseEventButtonNumber -> mouseEventButtonNumber+  MouseEventDeltaX -> mouseEventDeltaX+  MouseEventDeltaY -> mouseEventDeltaY+  MouseEventInstantMouser -> mouseEventInstantMouser+  MouseEventSubtype -> mouseEventSubtype+  KeyboardEventAutorepeat -> keyboardEventAutorepeat+  KeyboardEventKeycode -> keyboardEventKeycode+  KeyboardEventKeyboardType -> keyboardEventKeyboardType+  ScrollWheelEventDeltaAxis1 -> scrollWheelEventDeltaAxis1+  ScrollWheelEventDeltaAxis2 -> scrollWheelEventDeltaAxis2+  ScrollWheelEventFixedPtDeltaAxis1 -> scrollWheelEventFixedPtDeltaAxis1+  ScrollWheelEventFixedPtDeltaAxis2 -> scrollWheelEventFixedPtDeltaAxis2+  ScrollWheelEventPointDeltaAxis1 -> scrollWheelEventPointDeltaAxis1+  ScrollWheelEventPointDeltaAxis2 -> scrollWheelEventPointDeltaAxis2+  ScrollWheelEventInstantMouser -> scrollWheelEventInstantMouser+  TabletEventPointX -> tabletEventPointX+  TabletEventPointY -> tabletEventPointY+  TabletEventPointZ -> tabletEventPointZ+  TabletEventPointButtons -> tabletEventPointButtons+  TabletEventPointPressure -> tabletEventPointPressure+  TabletEventTiltX -> tabletEventTiltX+  TabletEventTiltY -> tabletEventTiltY+  TabletEventRotation -> tabletEventRotation+  TabletEventTangentialPressure -> tabletEventTangentialPressure+  TabletEventDeviceID -> tabletEventDeviceID+  TabletEventVendor1 -> tabletEventVendor1+  TabletEventVendor2 -> tabletEventVendor2+  TabletEventVendor3 -> tabletEventVendor3+  TabletProximityEventVendorID -> tabletProximityEventVendorID+  TabletProximityEventTabletID -> tabletProximityEventTabletID+  TabletProximityEventPointerID -> tabletProximityEventPointerID+  TabletProximityEventDeviceID -> tabletProximityEventDeviceID+  TabletProximityEventSystemTabletID -> tabletProximityEventSystemTabletID+  TabletProximityEventVendorPointerType -> tabletProximityEventVendorPointerType+  TabletProximityEventVendorPointerSerialNumber -> tabletProximityEventVendorPointerSerialNumber+  TabletProximityEventVendorUniqueID -> tabletProximityEventVendorUniqueID+  TabletProximityEventCapabilityMask -> tabletProximityEventCapabilityMask+  TabletProximityEventPointerType -> tabletProximityEventPointerType+  TabletProximityEventEnterProximity -> tabletProximityEventEnterProximity+  EventTargetProcessSerialNumber -> eventTargetProcessSerialNumber+  EventTargetUnixProcessID -> eventTargetUnixProcessID+  EventSourceUnixProcessID -> eventSourceUnixProcessID+  EventSourceUserData -> eventSourceUserData+  EventSourceUserID -> eventSourceUserID+  EventSourceGroupID -> eventSourceGroupID+  EventSourceStateID -> eventSourceStateID+  ScrollWheelEventIsContinuous -> scrollWheelEventIsContinuous+  MouseEventWindowUnderMousePointer -> mouseEventWindowUnderMousePointer+  MouseEventWindowUnderMousePointerThatCanHandleThisEvent ->+    mouseEventWindowUnderMousePointerThatCanHandleThisEvent+  ScrollWheelEventMomentumPhase -> scrollWheelEventMomentumPhase+  ScrollWheelEventScrollCount -> scrollWheelEventScrollCount+  ScrollWheelEventScrollPhase -> scrollWheelEventScrollPhase++-- decideFieldType :: EventField ty+--                 -> Either (Dict (ty ~ Word64)) (Dict (ty ~ Double))++decideFieldType+  :: (ty ~ Word64 => a) -> (ty ~ Double => a) -> EventField ty -> a+decideFieldType f g = \case+  MouseEventNumber -> f+  MouseEventClickState -> f+  MouseEventPressure -> g+  MouseEventButtonNumber -> f+  MouseEventDeltaX -> f+  MouseEventDeltaY -> f+  MouseEventInstantMouser -> f+  MouseEventSubtype -> f+  KeyboardEventAutorepeat -> f+  KeyboardEventKeycode -> f+  KeyboardEventKeyboardType -> f+  ScrollWheelEventDeltaAxis1 -> g+  ScrollWheelEventDeltaAxis2 -> g+  ScrollWheelEventFixedPtDeltaAxis1 -> f+  ScrollWheelEventFixedPtDeltaAxis2 -> f+  ScrollWheelEventPointDeltaAxis1 -> f+  ScrollWheelEventPointDeltaAxis2 -> f+  ScrollWheelEventInstantMouser -> f+  TabletEventPointX -> f+  TabletEventPointY -> f+  TabletEventPointZ -> f+  TabletEventPointButtons -> f+  TabletEventPointPressure -> g+  TabletEventTiltX -> g+  TabletEventTiltY -> g+  TabletEventRotation -> g+  TabletEventTangentialPressure -> g+  TabletEventDeviceID -> f+  TabletEventVendor1 -> f+  TabletEventVendor2 -> f+  TabletEventVendor3 -> f+  TabletProximityEventVendorID -> f+  TabletProximityEventTabletID -> f+  TabletProximityEventPointerID -> f+  TabletProximityEventDeviceID -> f+  TabletProximityEventSystemTabletID -> f+  TabletProximityEventVendorPointerType -> f+  TabletProximityEventVendorPointerSerialNumber -> f+  TabletProximityEventVendorUniqueID -> f+  TabletProximityEventCapabilityMask -> f+  TabletProximityEventPointerType -> f+  TabletProximityEventEnterProximity -> f+  EventTargetProcessSerialNumber -> f+  EventTargetUnixProcessID -> f+  EventSourceUnixProcessID -> f+  EventSourceUserData -> f+  EventSourceUserID -> f+  EventSourceGroupID -> f+  EventSourceStateID -> f+  ScrollWheelEventIsContinuous -> f+  MouseEventWindowUnderMousePointer -> f+  MouseEventWindowUnderMousePointerThatCanHandleThisEvent -> f+  ScrollWheelEventMomentumPhase -> f+  ScrollWheelEventScrollCount -> f+  ScrollWheelEventScrollPhase -> f
+ src/MacSdk/Framework/CoreGraphics/Event/Flag.hsc view
@@ -0,0 +1,126 @@+{-|++Constants that indicate the modifier key state at the time an event is created,+as well as other event-related states.++-}++module MacSdk.Framework.CoreGraphics.Event.Flag where++#include <Carbon/Carbon.h>++import Data.Word+import Data.Bits+import Data.Maybe (catMaybes)++type CGEventFlags = Word64++data EventFlag+  -- | Indicates that the Caps Lock key is down for a keyboard, mouse, or+  -- flag-changed event.+  = EventFlagAlphaShift+  -- | Indicates that the Shift key is down for a keyboard, mouse,+  -- or flag-changed event.+  | EventFlagShift+  | EventFlagLeftShift+  | EventFlagRightShift+  -- | Indicates that the Control key is down for a keyboard, mouse,+  -- or flag-changed event.+  | EventFlagControl+  | EventFlagLeftControl+  | EventFlagRightControl+  -- | Indicates that the Alt or Option key is down for a keyboard, mouse, or+  -- flag-changed event.+  | EventFlagAlternate+  | EventFlagLeftAlternate+  | EventFlagRightAlternate+  -- | Indicates that the Command key is down for a keyboard, mouse,+  -- or flag-changed event.+  | EventFlagCommand+  | EventFlagLeftCommand+  | EventFlagRightCommand+  -- | Indicates that the Help modifier key is down for a keyboard, mouse, or+  -- flag-changed event. This key is not present on most keyboards, and is+  -- different than the Help key found in the same row as Home and Page Up.+  | EventFlagHelp+  -- | Indicates that the Fn (Function) key is down for a keyboard, mouse,+  -- or flag-changed event. This key is found primarily on laptop keyboards.+  | EventFlagSecondaryFn+  -- | Identifies key events from the numeric keypad area on extended keyboards.+  | EventFlagNumericPad+  -- | Indicates that mouse and pen movement events are not being coalesced.+  | EventFlagNonCoalesced++toCGEventFlags :: [EventFlag] -> CGEventFlags+toCGEventFlags = foldr (.|.) 0 . fmap toCGEventFlag++fromCGEventFlags :: CGEventFlags -> [EventFlag]+fromCGEventFlags flags =+  catMaybes . fmap (\f -> if (toCGEventFlag f .&. flags) == toCGEventFlag f+                            then Just f+                            else Nothing) $+  [ EventFlagAlphaShift+  , EventFlagShift+  , EventFlagLeftShift+  , EventFlagRightShift+  , EventFlagControl+  , EventFlagLeftControl+  , EventFlagRightControl+  , EventFlagAlternate+  , EventFlagLeftAlternate+  , EventFlagRightAlternate+  , EventFlagCommand+  , EventFlagLeftCommand+  , EventFlagRightCommand+  , EventFlagHelp+  , EventFlagSecondaryFn+  , EventFlagNumericPad+  , EventFlagNonCoalesced+  ]++toCGEventFlag :: EventFlag -> CGEventFlags+toCGEventFlag = \case+  EventFlagAlphaShift -> eventFlagMaskAlphaShift+  EventFlagShift -> eventFlagMaskShift+  EventFlagLeftShift -> 0x00000002+  EventFlagRightShift -> 0x00000004+  EventFlagControl -> eventFlagMaskControl+  EventFlagLeftControl -> 0x00000001+  EventFlagRightControl -> 0x00002000+  EventFlagAlternate -> eventFlagMaskAlternate+  EventFlagLeftAlternate -> 0x00000020+  EventFlagRightAlternate -> 0x00000040+  EventFlagCommand -> eventFlagMaskCommand+  EventFlagLeftCommand -> 0x00000008+  EventFlagRightCommand -> 0x00000010+  EventFlagHelp -> eventFlagMaskHelp+  EventFlagSecondaryFn -> eventFlagMaskSecondaryFn+  EventFlagNumericPad -> eventFlagMaskNumericPad+  EventFlagNonCoalesced -> eventFlagMaskNonCoalesced++eventFlagMaskAlphaShift :: Word64+eventFlagMaskAlphaShift = #const kCGEventFlagMaskAlphaShift++eventFlagMaskShift :: Word64+eventFlagMaskShift = #const kCGEventFlagMaskShift++eventFlagMaskControl :: Word64+eventFlagMaskControl = #const kCGEventFlagMaskControl++eventFlagMaskAlternate :: Word64+eventFlagMaskAlternate = #const kCGEventFlagMaskAlternate++eventFlagMaskCommand :: Word64+eventFlagMaskCommand = #const kCGEventFlagMaskCommand++eventFlagMaskHelp :: Word64+eventFlagMaskHelp = #const kCGEventFlagMaskHelp++eventFlagMaskSecondaryFn :: Word64+eventFlagMaskSecondaryFn = #const kCGEventFlagMaskSecondaryFn++eventFlagMaskNumericPad :: Word64+eventFlagMaskNumericPad = #const kCGEventFlagMaskNumericPad++eventFlagMaskNonCoalesced :: Word64+eventFlagMaskNonCoalesced = #const kCGEventFlagMaskNonCoalesced
+ src/MacSdk/Framework/CoreGraphics/Event/Location.hsc view
@@ -0,0 +1,26 @@+-- | Constants and types that specify possible tapping points for events.++module MacSdk.Framework.CoreGraphics.Event.Location where++#include <Carbon/Carbon.h>++import Foreign.C.Types (CInt(..))++type CGEventTapLocation = CInt++data EventTapLocation+  = HIDEventTap+  -- ^ Specifies that an event tap is placed at the point where HID system+  -- events enter the window server.+  | SessionEventTap+  -- ^ Specifies that an event tap is placed at the point where HID system and+  -- remote control events enter a login session.+  | AnnotatedSessionEventTap+  -- ^ Specifies that an event tap is placed at the point where session events+  -- have been annotated to flow to an application.++toCGEventTapLocation :: EventTapLocation -> CGEventTapLocation+toCGEventTapLocation = \case+  HIDEventTap -> (#const kCGHIDEventTap)+  SessionEventTap -> (#const kCGSessionEventTap)+  AnnotatedSessionEventTap -> (#const kCGAnnotatedSessionEventTap)
+ src/MacSdk/Framework/CoreGraphics/Event/Mask.hsc view
@@ -0,0 +1,32 @@+-- | Constants and ADTs to define a mask that identifies the set of Quartz+-- events to be observed in an event tap.++module MacSdk.Framework.CoreGraphics.Event.Mask where++#include <Carbon/Carbon.h>++import Data.Word+import Data.Bits+import MacSdk.Framework.CoreGraphics.Event.Type++foreign import ccall unsafe event_type_to_mask_bit :: Word32 -> Word64++type CGEventMask = Word64+newtype EventMask = EventMask { getEventMask :: Word64 }++instance Semigroup EventMask where+  EventMask m1 <> EventMask m2 = EventMask (m1 .|. m2)++instance Monoid EventMask where+  mempty = EventMask 0+  mappend = (<>)++data QuartzEvents = AllEvents | EventList [EventType]++allEvents :: Word64+allEvents = #const kCGEventMaskForAllEvents++toMask :: QuartzEvents -> EventMask+toMask AllEvents = EventMask allEvents+toMask (EventList tys) =+  mconcat (fmap (EventMask . event_type_to_mask_bit . toEventTypeCode) tys)
+ src/MacSdk/Framework/CoreGraphics/Event/Type.hsc view
@@ -0,0 +1,117 @@+{-# LANGUAGE LambdaCase #-}++{-# OPTIONS_GHC -Wno-missing-signatures #-}++-- | Constants and ADTs that specify the different types of input events.++module MacSdk.Framework.CoreGraphics.Event.Type where++#include <Carbon/Carbon.h>++import Data.Word++-- | The different types of Quartz input events.+data EventType+  = EventNull+  -- ^ Specifies a null event.+  | EventLeftMouseDown+  -- ^ Specifies a mouse down event with the left button.+  | EventLeftMouseUp+  -- ^ Specifies a mouse up event with the left button.+  | EventRightMouseDown+  -- ^ Specifies a mouse down event with the right button.+  | EventRightMouseUp+  -- ^ Specifies a mouse up event with the right button.+  | EventMouseMoved+  -- ^ Specifies a mouse moved event.+  | EventLeftMouseDragged+  -- ^ Specifies a mouse drag event with the left button down.+  | EventRightMouseDragged+  -- ^ Specifies a mouse drag event with the right button down.+  | EventKeyDown+  -- ^ Specifies a key down event.+  | EventKeyUp+  -- ^ Specifies a key up event.+  | EventFlagsChanged+  -- ^ Specifies a key changed event for a modifier or status key.+  | EventScrollWheel+  -- ^ Specifies a scroll wheel moved event.+  | EventTabletPointer+  -- ^ Specifies a tablet pointer event.+  | EventTabletProximity+  -- ^ Specifies a tablet proximity event.+  | EventOtherMouseDown+  -- ^ Specifies a mouse down event with one of buttons 2-31.+  | EventOtherMouseUp+  -- ^ Specifies a mouse up event with one of buttons 2-31.+  | EventOtherMouseDragged+  -- ^ Specifies a mouse drag event with one of buttons 2-31 down.+  | EventTapDisabledByTimeout+  -- ^ Specifies an event indicating the event tap is disabled because of timeout.+  | EventTapDisabledByUserInput+  -- ^ Specifies an event indicating the event tap is disabled because of user input.++eventNull = #const kCGEventNull+eventLeftMouseDown = #const kCGEventLeftMouseDown+eventLeftMouseUp = #const kCGEventLeftMouseUp+eventRightMouseDown = #const kCGEventRightMouseDown+eventRightMouseUp = #const kCGEventRightMouseUp+eventMouseMoved = #const kCGEventMouseMoved+eventLeftMouseDragged = #const kCGEventLeftMouseDragged+eventRightMouseDragged = #const kCGEventRightMouseDragged+eventKeyDown = #const kCGEventKeyDown+eventKeyUp = #const kCGEventKeyUp+eventFlagsChanged = #const kCGEventFlagsChanged+eventScrollWheel = #const kCGEventScrollWheel+eventTabletPointer = #const kCGEventTabletPointer+eventTabletProximity = #const kCGEventTabletProximity+eventOtherMouseDown = #const kCGEventOtherMouseDown+eventOtherMouseUp = #const kCGEventOtherMouseUp+eventOtherMouseDragged = #const kCGEventOtherMouseDragged+eventTapDisabledByTimeout = #const kCGEventTapDisabledByTimeout+eventTapDisabledByUserInput = #const kCGEventTapDisabledByUserInput++toEventTypeCode :: EventType -> Word32+toEventTypeCode = \case+  EventNull -> eventNull+  EventLeftMouseDown -> eventLeftMouseDown+  EventLeftMouseUp -> eventLeftMouseUp+  EventRightMouseDown -> eventRightMouseDown+  EventRightMouseUp -> eventRightMouseUp+  EventMouseMoved -> eventMouseMoved+  EventLeftMouseDragged -> eventLeftMouseDragged+  EventRightMouseDragged -> eventRightMouseDragged+  EventKeyDown -> eventKeyDown+  EventKeyUp -> eventKeyUp+  EventFlagsChanged -> eventFlagsChanged+  EventScrollWheel -> eventScrollWheel+  EventTabletPointer -> eventTabletPointer+  EventTabletProximity -> eventTabletProximity+  EventOtherMouseDown -> eventOtherMouseDown+  EventOtherMouseUp -> eventOtherMouseUp+  EventOtherMouseDragged -> eventOtherMouseDragged+  EventTapDisabledByTimeout -> eventTapDisabledByTimeout+  EventTapDisabledByUserInput -> eventTapDisabledByUserInput++fromEventTypeCode :: Word32 -> EventType+fromEventTypeCode code+  | code == eventNull = EventNull+  | code == eventLeftMouseDown = EventLeftMouseDown+  | code == eventLeftMouseUp = EventLeftMouseUp+  | code == eventRightMouseDown = EventRightMouseDown+  | code == eventRightMouseUp = EventRightMouseUp+  | code == eventMouseMoved = EventMouseMoved+  | code == eventLeftMouseDragged = EventLeftMouseDragged+  | code == eventRightMouseDragged = EventRightMouseDragged+  | code == eventKeyDown = EventKeyDown+  | code == eventKeyUp = EventKeyUp+  | code == eventFlagsChanged = EventFlagsChanged+  | code == eventScrollWheel = EventScrollWheel+  | code == eventTabletPointer = EventTabletPointer+  | code == eventTabletProximity = EventTabletProximity+  | code == eventOtherMouseDown = EventOtherMouseDown+  | code == eventOtherMouseUp = EventOtherMouseUp+  | code == eventOtherMouseDragged = EventOtherMouseDragged+  | code == eventTapDisabledByTimeout = EventTapDisabledByTimeout+  | code == eventTapDisabledByUserInput = EventTapDisabledByUserInput+  | otherwise = error "fromEventTypeCode: unrecognized event type code"
+ src/MacSdk/Framework/CoreGraphics/Mouse.hs view
@@ -0,0 +1,17 @@+-- | Core Graphics functions to control the mouse cursor.++module MacSdk.Framework.CoreGraphics.Mouse where++import MacSdk.Framework.CoreGraphics.Error+import MacSdk.Framework.CoreGraphics.Rect+import Foreign.C.Types+import Foreign+import Control.Monad.IO.Class(MonadIO(..))++-- | Moves the mouse cursor without generating events.+foreign import ccall unsafe "CGWarpMouseCursorPosition_"+  cgWarpMouseCursorPosition :: Ptr Point -> IO CInt++warpMouseCursorPosition :: (MonadIO m, MonadError e m, AsCGError e) => Point -> m ()+warpMouseCursorPosition p = except . liftIO $+  intToCGError <$> alloca (\ptr -> poke ptr p >> cgWarpMouseCursorPosition ptr)
+ src/MacSdk/Framework/CoreGraphics/Rect.hsc view
@@ -0,0 +1,133 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}++#include <Carbon/Carbon.h>++{- | Storable rectangles. -}++module MacSdk.Framework.CoreGraphics.Rect where++import Foreign hiding (with)+import Foreign.C.Types (CBool(..))+import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.Accessibility.Value+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Managed++type Lens' s a = forall f . Functor f => (a -> f a) -> s -> f s++lens :: (s -> a) -> (s -> a -> s) -> Lens' s a+lens getter setter f s = setter s <$> f (getter s)++data Point = Point { xCoord :: !Double, yCoord :: !Double } deriving (Eq, Show)+data Size = Size { width :: !Double, height :: !Double } deriving (Eq, Show)++-- | Lens focused on the origin of a rectangle.+originL :: Lens' Rect Point+originL = lens origin $ \r p -> case r of Rect _ s -> Rect p s++-- | Lens focused on the size of a rectangle.+sizeL :: Lens' Rect Size+sizeL = lens size $ \r s -> case r of Rect o _ -> Rect o s++-- | Lens focused on the @x@ coordinate of a rectangle.+xL :: Lens' Point Double+xL = lens xCoord $ \p x -> case p of Point _ y -> Point x y++-- | Lens focused on the @y@ coordinate of a rectangle.+yL :: Lens' Point Double+yL = lens yCoord $ \p y -> case p of Point x _ -> Point x y++-- | Lens focused on the width of a rectangle.+widthL :: Lens' Size Double+widthL = lens width $ \s w -> case s of Size _ h -> Size w h++-- | Lens focused on the height of a rectangle.+heightL :: Lens' Size Double+heightL = lens height $ \s h -> case s of Size w _ -> Size w h++-- | Type of rectangular shapes.+data Rect = Rect+  { origin :: Point+  -- ^ Origin of the rectangle, corresponding to the top-left corner.+  , size :: Size+  -- ^ Size of the rectangle.+  } deriving (Eq, Show)++instance Storable Point where+  sizeOf _ = #{size CGPoint}+  alignment _ = #{alignment CGPoint}+  peek ptr = do+    x' <- #{peek CGPoint, x} ptr+    y' <- #{peek CGPoint, y} ptr+    return $ Point x' y'+  poke ptr (Point x' y') = do+    #{poke CGPoint, x} ptr x'+    #{poke CGPoint, y} ptr y'++instance Storable Size where+  sizeOf _ = #{size CGSize}+  alignment _ = #{alignment CGSize}+  peek ptr = do+    width' <- #{peek CGSize, width} ptr+    height' <- #{peek CGSize, height} ptr+    return $ Size width' height'+  poke ptr (Size width' height') = do+    #{poke CGSize, width} ptr width'+    #{poke CGSize, height} ptr height'++instance Storable Rect where+  sizeOf _ = #{size CGRect}+  alignment _ = #{alignment CGRect}+  peek ptr = do+    origin' <- #{peek CGRect, origin} ptr+    size' <- #{peek CGRect, size} ptr+    return $ Rect origin' size'+  poke ptr (Rect origin' size') = do+    #{poke CGRect, origin} ptr origin'+    #{poke CGRect, size} ptr size'++foreign import ccall unsafe create_cfpoint :: Ptr Point -> IO CFTypeRef+foreign import ccall unsafe create_cfsize :: Ptr Size -> IO CFTypeRef++foreign import ccall unsafe+  ax_value_get_cgpoint :: AXValueRef -> Ptr Point -> IO CBool+foreign import ccall unsafe+  ax_value_get_cgsize  :: AXValueRef -> Ptr Size -> IO CBool++axValueGetPoint :: AXValueRef -> IO (Maybe Point)+axValueGetPoint ref = alloca $ \p -> do+  res <- ax_value_get_cgpoint ref p+  if Foreign.toBool res then Just <$> peek p else pure Nothing++valueGetPoint :: Value -> IO (Maybe Point)+valueGetPoint = flip withCFPtr axValueGetPoint++axValueGetSize :: AXValueRef -> IO (Maybe Size)+axValueGetSize ref = alloca $ \p -> do+  res <- ax_value_get_cgsize ref p+  if Foreign.toBool res then Just <$> peek p else pure Nothing++valueGetSize :: Value -> IO (Maybe Size)+valueGetSize = flip withCFPtr axValueGetSize++-- | Turn a point value into a Core Foundation object.+createCFPoint :: Point -> IO CFObject+createCFPoint pt = alloca $ \p ->+  poke p pt >> create_cfpoint p >>= manageCFObj++-- | Turn a size value into a Core Foundation object.+createCFSize :: Size -> IO CFObject+createCFSize sz = alloca $ \p ->+  poke p sz >> create_cfsize p >>= manageCFObj++foreign import ccall unsafe "CGRectMakeWithDictionaryRepresentation"+  cgRectMakeWithDictionaryRepresentation+  :: CFDictionaryRef -> Ptr Rect -> IO CBool++rectMakeWithDictionaryRepresentation :: MonadIO m => Dictionary -> m (Maybe Rect)+rectMakeWithDictionaryRepresentation dict = liftIO . flip with pure $ do+  d <- managed $ withCFPtr dict+  ptr <- managed alloca+  liftIO $ cgRectMakeWithDictionaryRepresentation d ptr >>= \b ->+    if toBool b then Just <$> peek ptr else pure Nothing
+ src/MacSdk/Framework/CoreGraphics/Space.hs view
@@ -0,0 +1,135 @@+module MacSdk.Framework.CoreGraphics.Space where++import Control.Monad+import Foreign+import Foreign.C.Types (CInt(..), CUInt(..))+import MacSdk.Framework.CoreGraphics.Connection+import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.Types+import Prelude hiding (String)+import Control.Arrow ((>>>))++type SpaceID = Word32+type CGSSpaceType = CInt++data SpaceType = UserSpace | SystemSpace | FullscreenSpace deriving (Eq, Show)++toSpaceType :: CGSSpaceType -> SpaceType+toSpaceType st+  | st == cgSSpaceTypeUser = UserSpace+  | st == cgSSpaceTypeFullscreen = FullscreenSpace+  | st == cgSSpaceTypeSystem = SystemSpace+  | otherwise = error "unknown CGSSpaceType code"++fromSpaceType :: SpaceType -> CGSSpaceType+fromSpaceType UserSpace = cgSSpaceTypeUser+fromSpaceType SystemSpace = cgSSpaceTypeSystem+fromSpaceType FullscreenSpace = cgSSpaceTypeFullscreen++cgSSpaceTypeUser, cgSSpaceTypeFullscreen, cgSSpaceTypeSystem :: CGSSpaceType+cgSSpaceTypeUser = 0+cgSSpaceTypeFullscreen = 4+cgSSpaceTypeSystem = 2++foreign import ccall unsafe "CGSManagedDisplayGetCurrentSpace"+  cgSManagedDisplayGetCurrentSpace+  :: ConnectionID -> CFStringRef -> IO SpaceID++currentSpace :: ConnectionID -> CFString -> IO SpaceID+currentSpace cid str = withCFPtr str $ cgSManagedDisplayGetCurrentSpace cid++currentSpace' :: CFString -> IO SpaceID+currentSpace' uuid = defaultConnection >>= \conn -> currentSpace conn uuid++foreign import ccall unsafe "CGSSpaceGetType"+  cgSSpaceGetType :: ConnectionID -> SpaceID -> IO CGSSpaceType++spaceType :: ConnectionID -> SpaceID -> IO SpaceType+spaceType cid sid = fmap toSpaceType $ cgSSpaceGetType cid sid++spaceType' :: SpaceID -> IO SpaceType+spaceType' sid = defaultConnection >>= \conn -> spaceType conn sid++type CGSSpaceSelector = CInt++data SpaceSelector = SpaceCurrent | SpaceOther | SpaceAll deriving (Eq, Show)++fromSelector :: SpaceSelector -> CGSSpaceSelector+fromSelector SpaceCurrent = 5+fromSelector SpaceOther = 6+fromSelector SpaceAll = 7++foreign import ccall unsafe "CGSCopySpacesForWindows"+  cgSCopySpacesForWindows+  :: ConnectionID -> CGSSpaceSelector -> CFArrayRef -> IO CFArrayRef++spacesForWindows+  :: ConnectionID -> SpaceSelector -> Array Number -> IO (Array Number)+spacesForWindows conn sel arr = withCFPtr (getArray arr) $ \parr ->+  cgSCopySpacesForWindows conn (fromSelector sel) parr >>=+    (manageCFObj >>> fmap Array)++foreign import ccall unsafe "CGSMoveWindowsToManagedSpace"+  cgsMoveWindowsToManagedSpace+  :: ConnectionID -> CFArrayRef -> ForeignSpaceID -> IO ()++moveWindowsToSpace :: ConnectionID -> Array Number -> SpaceID -> IO ()+moveWindowsToSpace cid arr sid = withCFPtr (getArray arr) $ \parr ->+  cgsMoveWindowsToManagedSpace cid parr (fromIntegral sid)++foreign import ccall "CGSCopyManagedDisplaySpaces"+  cgsCopyManagedDisplaySpaces :: ConnectionID -> IO CFArrayRef++managedDisplaySpaces :: ConnectionID -> IO (Array Dictionary)+managedDisplaySpaces = cgsCopyManagedDisplaySpaces >=> manageCFObj >>> fmap Array++--------------------------------------------------------------------------------++type ForeignSpaceID = CUInt++-- foreign import ccall "init_workspace" startWorkspaceEvents :: IO ()++data SpaceEvent+  = SEDisplayChanged+  | SESpaceChanged+  | SEAppActivated+  | SEAppDeactivated+  | SEAppHidden+  | SEAppVisible+  deriving (Eq, Show)++seFromInt :: Integral a => a -> SpaceEvent+seFromInt e | e == 0 = SEDisplayChanged+seFromInt e | e == 1 = SESpaceChanged+seFromInt e | e == 2 = SEAppActivated+seFromInt e | e == 3 = SEAppDeactivated+seFromInt e | e == 4 = SEAppHidden+seFromInt e | e == 5 = SEAppVisible+seFromInt _ = error "unknown SpaceEvent code"++type ForeignWorkspaceCallback = CUInt -> PID -> IO ()+type WorkspaceCallback = SpaceEvent -> PID -> IO ()++toForeignWCallb :: WorkspaceCallback -> ForeignWorkspaceCallback+toForeignWCallb f e = f (seFromInt e)++foreign import ccall "wrapper" wrap_workspace_callback+  :: ForeignWorkspaceCallback -> IO (FunPtr ForeignWorkspaceCallback)++-- foreign import ccall unsafe+--   set_workspace_callback :: FunPtr ForeignWorkspaceCallback -> IO ()++data WorkspaceWatcher_+newtype WorkspaceWatcher = WorkspaceWatcher (Ptr WorkspaceWatcher_)+foreign import ccall unsafe new_workspace_watcher+  :: FunPtr ForeignWorkspaceCallback -> IO (Ptr WorkspaceWatcher_)+foreign import ccall unsafe stop_workspace_watcher+  :: Ptr WorkspaceWatcher_ -> IO ()++newWorkspaceWatcher :: WorkspaceCallback -> IO WorkspaceWatcher+newWorkspaceWatcher f = do+  callb <- wrap_workspace_callback (toForeignWCallb f)+  WorkspaceWatcher <$> new_workspace_watcher callb++stopWorkspaceWatcher :: WorkspaceWatcher -> IO ()+stopWorkspaceWatcher (WorkspaceWatcher p) = stop_workspace_watcher p
+ src/MacSdk/Framework/CoreGraphics/Window.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE GADTs #-}++-- | Quartz Window Services+--+-- This includes the onscreen windows seen on the user’s desktop and any+-- offscreen windows used by the running applications. You can also use Quartz+-- Window Services to generate images based on the contents of windows.+--+-- See: https://developer.apple.com/documentation/coregraphics/quartz_window_services++module MacSdk.Framework.CoreGraphics.Window+  ( WindowID+  , CGWindowID+  , WindowListOption(..)+  , WindowInfoDictionary+  , WindowListKey(..)+  , OptionalWindowListKey(..)+  , getDictionary+  -- * Getting window information+  , windowListCopyWindowInfo+  , windowInfoLookupKey+  , windowInfoLookupOptionalKey+  ) where++import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.CoreGraphics.Window.Types+import MacSdk.Framework.CoreGraphics.Rect+import Foreign (nullPtr)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Maybe (fromMaybe)++--------------------------------------------------------------------------------+-- Getting window information++newtype WindowInfoDictionary = WindowInfoDictionary+  { getDictionary :: Dictionary+  }++-- CFArrayRef CGWindowListCopyWindowInfo(CGWindowListOption option, CGWindowID relativeToWindow);+foreign import ccall unsafe "CGWindowListCopyWindowInfo"+  cg_window_list_copy_window_info :: CGWindowListOption -> CGWindowID -> IO CFArrayRef++-- | Returns an array of 'Dictionary' elements, each of which contains+-- information about one of the windows in the current user session.+--+-- The second parameter specifies the ID of the window to use as a reference+-- point when determining which other window dictionaries to return. For options+-- that do not require a reference window, this parameter should be 'Nothing'.+--+-- The first parameter is a list of options describing which window dictionaries+-- to return. An empty list retrieves all windows, including both onscreen and+-- offscreen windows. When retrieving a list with this option, the second+-- parameter should be set to 'Nothing'.+--+-- If there are no windows matching the desired criteria, the function+-- returns an empty array. If you call this function from outside of a GUI+-- security session or when no window server is running, this function returns+-- 'Nothing'.+windowListCopyWindowInfo+  :: MonadIO m+  => [WindowListOption]+  -> Maybe WindowID+  -> m (Maybe (Array WindowInfoDictionary))+windowListCopyWindowInfo opts mwid = fmap (fmap Array) . liftIO $ do+  arr <- cg_window_list_copy_window_info (orEdOptions opts)+           (fromMaybe nullWindowID mwid)+  if arr == nullPtr then pure Nothing else fmap Just (retainManageCFObj arr)++windowInfoLookupKey :: MonadIO m => WindowInfoDictionary -> WindowListKey ty -> m ty+windowInfoLookupKey (WindowInfoDictionary dict) key = case key of+  WindowNumber -> do+    int <- getDictValue' dict skey >>= flip numberGetValue NumberSInt32Type+    pure (maybe (err key) fromIntegral int)+  WindowStoreType -> undefined+  WindowLayer -> undefined+  +  WindowBounds -> do+    rectDict <- getDictValue' dict skey+    fromMaybe (err key) <$> rectMakeWithDictionaryRepresentation rectDict+    +  WindowSharingState -> undefined+  WindowAlpha -> undefined+  WindowOwnerPID -> do+    int <- getDictValue' dict skey >>= flip numberGetValue NumberIntType+    pure (maybe (err key) fromIntegral int)++  WindowMemoryUsage -> undefined+  where skey = toWindowListKeyString key+        err :: WindowListKey ty -> ty+        err k = error ("windowInfoLookupKey: failed to lookup a required window list key: " ++ show k)++windowInfoLookupOptionalKey+  :: MonadIO m+  => WindowInfoDictionary -> OptionalWindowListKey ty -> m (Maybe ty)+windowInfoLookupOptionalKey (WindowInfoDictionary dict) key = case key of+  WindowOwnerName -> getDictValueSafe dict skey+  WindowName -> getDictValueSafe dict skey+  WindowIsOnscreen -> undefined+  WindowBackingLocationVideoMemory -> undefined+  where skey = toOptionalWindowListKeyString key++-- foo :: WindowInfoDictionary -> IO ()+-- foo d = do+--   windowInfoLookupKey d WindowNumber >>= print+--   windowInfoLookupOptionalKey d WindowName >>=+--     maybe (pure ()) (toString CFStringEncodingUTF8 >=> print)+--   windowInfoLookupOptionalKey d WindowOwnerName >>=+--     maybe (pure ()) (toString CFStringEncodingUTF8 >=> print)+--   putStrLn ""
+ src/MacSdk/Framework/CoreGraphics/Window/Types.hsc view
@@ -0,0 +1,116 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}++module MacSdk.Framework.CoreGraphics.Window.Types where++#include <Carbon/Carbon.h>++import Data.Word+import Data.Bits+import MacSdk.Framework.Types (PID)+import MacSdk.Framework.CoreFoundation+import MacSdk.Framework.CoreGraphics.Rect+import System.IO.Unsafe (unsafePerformIO)++type CGWindowID = Word32+type CGWindowListOption = Word32+type WindowID = CGWindowID++nullWindowID :: WindowID+nullWindowID = #const kCGNullWindowID++-- | The data type used to specify the options for gathering a list of windows.+data WindowListOption+  = ExcludeDesktopElements+  -- ^ Exclude any windows from the list that are elements of the desktop,+  -- including the background picture and desktop icons.+  | OptionIncludingWindow+  -- ^ Include the specified window (from the second parameter in+  -- 'windowListCopyWindowInfo') in the returned list. You must combine this+  -- option with the 'OnScreenAboveWindow' or 'OnScreenBelowWindow' option to+  -- retrieve meaningful results.+  | OptionOnScreenAboveWindow+  -- ^ List all windows that are currently onscreen and in front of the window+  -- specified in the second parameter of 'windowListCopyWindowInfo'. Windows+  -- are returned in order from front to back.+  | OptionOnScreenBelowWindow+  -- ^ List all windows that are currently onscreen and in behind the window+  -- specified in the second parameter of 'windowListCopyWindowInfo'. Windows+  -- are returned in order from front to back.+  | OptionOnScreenOnly+  -- ^ List all windows that are currently onscreen. Windows are returned in+  -- order from front to back. When retrieving a list with this option, the+  -- second parameter of 'windowListCopyWindowInfo' should be set to 'Nothing'.++toCGWindowListOption :: WindowListOption -> CGWindowListOption+toCGWindowListOption = \case+  ExcludeDesktopElements -> (#const kCGWindowListExcludeDesktopElements)+  OptionIncludingWindow -> (#const kCGWindowListOptionIncludingWindow)+  OptionOnScreenAboveWindow -> (#const kCGWindowListOptionOnScreenAboveWindow)+  OptionOnScreenBelowWindow -> (#const kCGWindowListOptionOnScreenBelowWindow)+  OptionOnScreenOnly -> (#const kCGWindowListOptionOnScreenOnly)++orEdOptions :: [WindowListOption] -> CGWindowListOption+orEdOptions = foldr (\o cgo -> toCGWindowListOption o .|. cgo) 0++--------------------------------------------------------------------------------++foreign import ccall unsafe kCGWindowNumber_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowStoreType_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowLayer_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowBounds_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowSharingState_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowAlpha_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowOwnerPID_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowMemoryUsage_ :: IO CFStringRef++foreign import ccall unsafe kCGWindowOwnerName_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowName_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowIsOnscreen_ :: IO CFStringRef+foreign import ccall unsafe kCGWindowBackingLocationVideoMemory_ :: IO CFStringRef++data WindowListKey :: * -> * where+  -- | ID of the window. The ID is unique within the current user session.+  WindowNumber :: WindowListKey WindowID+  WindowStoreType :: WindowListKey Number+  WindowLayer :: WindowListKey Number+  -- | The coordinates of the rectangle are specified in screen space, where the+  -- origin is in the upper-left corner of the main display.+  WindowBounds :: WindowListKey Rect+  WindowSharingState :: WindowListKey Number+  -- | The window’s alpha fade level. This number is in the range 0.0 to 1.0,+  -- where 0.0 is fully transparent and 1.0 is fully opaque.+  WindowAlpha :: WindowListKey Number+  WindowOwnerPID :: WindowListKey PID+  -- | An estimate of the amount of memory (measured in bytes) used by the+  -- window and its supporting data structures.+  WindowMemoryUsage :: WindowListKey Number++deriving instance Show (WindowListKey ty)++data OptionalWindowListKey :: * -> * where+  WindowOwnerName :: OptionalWindowListKey CFString+  WindowName :: OptionalWindowListKey CFString+  WindowIsOnscreen :: OptionalWindowListKey Bool+  WindowBackingLocationVideoMemory :: OptionalWindowListKey Bool++deriving instance Show (OptionalWindowListKey ty)++toWindowListKeyString :: WindowListKey a -> CFStringRef+toWindowListKeyString = unsafePerformIO . \case+  WindowNumber -> kCGWindowNumber_+  WindowStoreType -> kCGWindowStoreType_+  WindowLayer -> kCGWindowLayer_+  WindowBounds -> kCGWindowBounds_+  WindowSharingState -> kCGWindowSharingState_+  WindowAlpha -> kCGWindowAlpha_+  WindowOwnerPID -> kCGWindowOwnerPID_+  WindowMemoryUsage -> kCGWindowMemoryUsage_++toOptionalWindowListKeyString :: OptionalWindowListKey a -> CFStringRef+toOptionalWindowListKeyString = unsafePerformIO . \case+  WindowOwnerName -> kCGWindowOwnerName_+  WindowName -> kCGWindowName_+  WindowIsOnscreen -> kCGWindowIsOnscreen_+  WindowBackingLocationVideoMemory -> kCGWindowBackingLocationVideoMemory_
+ src/MacSdk/Framework/Types.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FunctionalDependencies #-}++module MacSdk.Framework.Types (PID) where++-- , WindowID+  -- , DesktopID+  -- , OSStatus+  -- , OSErr+  -- ) where++import Foreign++type PID = Int32+-- type WindowID = Word32+-- type DesktopID = Int+-- type OSStatus = Int+-- type OSErr = Int
+ src/MacSdk/Prism.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE RankNTypes #-}++module MacSdk.Prism where++import Data.Functor.Identity (Identity(..))+import Data.Profunctor.Choice (Choice(..))+import Control.Monad.Error.Class (MonadError(..))+import Data.Tagged++type Prism' s a =+  forall p f. (Choice p, Applicative f) => p a (f a) -> p s (f s)++type AReview t b = Tagged b (Identity b) -> Tagged t (Identity t)++review :: AReview t b -> b -> t+review r = runIdentity . unTagged . r . Tagged . Identity++throwing :: MonadError t m => Prism' t e -> e -> m a+throwing p e = throwError (review p e)