packages feed

CoreFoundation (empty) → 0.1

raw patch · 21 files changed

+1952/−0 lines, 21 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, deepseq, filepath, network, property-list, tagged, text, time, transformers, vector

Files

+ C2HS.hs view
@@ -0,0 +1,216 @@+--  C->Haskell Compiler: Marshalling library+--+--  Copyright (c) [1999...2005] Manuel M T Chakravarty+--+--  Redistribution and use in source and binary forms, with or without+--  modification, are permitted provided that the following conditions are met:+-- +--  1. Redistributions of source code must retain the above copyright notice,+--     this list of conditions and the following disclaimer. +--  2. 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. +--  3. The name of the author may not be used to endorse or promote products+--     derived from this software without specific prior written permission. +--+--  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.+--+--- Description ---------------------------------------------------------------+--+--  Language: Haskell 98+--+--  This module provides the marshaling routines for Haskell files produced by +--  C->Haskell for binding to C library interfaces.  It exports all of the+--  low-level FFI (language-independent plus the C-specific parts) together+--  with the C->HS-specific higher-level marshalling routines.+--++module C2HS (++  -- * Re-export the language-independent component of the FFI +  module Foreign,++  -- * Re-export the C language component of the FFI+  module Foreign.C,++  -- * Composite marshalling functions+  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,+  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,++  -- * Conditional results using 'Maybe'+  nothingIf, nothingIfNull,++  -- * Bit masks+  combineBitMasks, containsBitMask, extractBitMasks,++  -- * Conversion between C and Haskell types+  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum+) where +++import Foreign+import Foreign.C++import Control.Monad (liftM)+++-- Composite marshalling functions+-- -------------------------------++-- Strings with explicit length+--+withCStringLenIntConv :: Num n => String -> ((CString, n) -> IO a) -> IO a+withCStringLenIntConv s f    = withCStringLen s $ \(p, n) -> f (p, fromIntegral n)++peekCStringLenIntConv :: Integral n => (CString, n) -> IO String+peekCStringLenIntConv (s, n) = peekCStringLen (s, fromIntegral n)++-- Marshalling of numerals+--++withIntConv   :: (Storable b, Integral a, Integral b) +              => a -> (Ptr b -> IO c) -> IO c+withIntConv    = with . fromIntegral++withFloatConv :: (Storable b, RealFloat a, RealFloat b) +              => a -> (Ptr b -> IO c) -> IO c+withFloatConv  = with . realToFrac++peekIntConv   :: (Storable a, Integral a, Integral b) +              => Ptr a -> IO b+peekIntConv    = liftM fromIntegral . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) +              => Ptr a -> IO b+peekFloatConv  = liftM realToFrac . peek+++-- Everything else below is deprecated.+-- These functions are not used by code generated by c2hs.+{-# DEPRECATED withBool        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED peekBool        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED withEnum        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED peekEnum        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED nothingIf       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED nothingIfNull   "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED combineBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED containsBitMask "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED extractBitMasks "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cIntConv        "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cFloatConv      "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cFromBool       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cToBool         "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cToEnum         "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+{-# DEPRECATED cFromEnum       "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-}+++-- Passing Booleans by reference+--++withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b+withBool  = with . fromBool++peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool+peekBool  = liftM toBool . peek+++-- Passing enums by reference+--++withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c+withEnum  = with . cFromEnum++peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a+peekEnum  = liftM cToEnum . peek++++-- Conditional results using 'Maybe'+-- ---------------------------------++-- Wrap the result into a 'Maybe' type.+--+-- * the predicate determines when the result is considered to be non-existing,+--   ie, it is represented by `Nothing'+--+-- * the second argument allows to map a result wrapped into `Just' to some+--   other domain+--+nothingIf       :: (a -> Bool) -> (a -> b) -> a -> Maybe b+nothingIf p f x  = if p x then Nothing else Just $ f x++-- |Instance for special casing null pointers.+--+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b+nothingIfNull  = nothingIf (== nullPtr)+++-- Support for bit masks+-- ---------------------++-- Given a list of enumeration values that represent bit masks, combine these+-- masks using bitwise disjunction.+--+combineBitMasks :: (Enum a, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++-- Tests whether the given bit mask is contained in the given bit pattern+-- (i.e., all bits set in the mask are also set in the pattern).+--+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm+                            in+                            bm' .&. bits == bm'++-- |Given a bit pattern, yield all bit masks that it contains.+--+-- * This does *not* attempt to compute a minimal set of bit masks that when+--   combined yield the bit pattern, instead all contained bit masks are+--   produced.+--+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]+extractBitMasks bits = +  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]+++-- Conversion routines+-- -------------------++-- |Integral conversion+--+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv  = fromIntegral++-- |Floating conversion+--+cFloatConv :: (RealFloat a, RealFloat b) => a -> b+cFloatConv  = realToFrac++-- |Obtain C value from Haskell 'Bool'.+--+cFromBool :: Num a => Bool -> a+cFromBool  = fromBool++-- |Obtain Haskell 'Bool' from C value.+--+cToBool :: (Eq a, Num a) => a -> Bool+cToBool  = toBool++-- |Convert a C enumeration to Haskell.+--+cToEnum :: (Integral i, Enum e) => i -> e+cToEnum  = toEnum . fromIntegral++-- |Convert a Haskell enumeration to C.+--+cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum  = fromIntegral . fromEnum
+ CoreFoundation.cabal view
@@ -0,0 +1,83 @@+Name:                CoreFoundation+Version:             0.1+Synopsis:            Bindings to Mac OSX's CoreFoundation framework+Description:         Bindings to Mac OSX's CoreFoudnation framework+License:             BSD3+License-file:        LICENSE+Author:              Reiner Pope+Maintainer:          reiner.pope@gmail.com+homepage:            https://github.com/reinerp/CoreFoundation+bug-reports:         https://github.com/reinerp/CoreFoundation/issues+-- Copyright:+Category:            System+Build-type:          Simple+Extra-source-files:+  cbits/cbits.h+Cabal-version:       >=1.6++source-repository head+  type:                 git+  location:             git://github.com/reinerp/CoreFoundation.git++Library+  Exposed-modules:+     CoreFoundation.Types.Base+     CoreFoundation.Types.String+     CoreFoundation.Types.Data+     CoreFoundation.Types.Type+     CoreFoundation.Types.Array+     CoreFoundation.Types.Dictionary+     CoreFoundation.Types.Date+     CoreFoundation.Types.Boolean+     CoreFoundation.Types.Number+     CoreFoundation.Types.PropertyList+     CoreFoundation.Types+     CoreFoundation.Marshal+     CoreFoundation.Preferences+     CoreFoundation.URI+  Frameworks:+     CoreFoundation++  Extensions:+     ForeignFunctionInterface,+     TypeFamilies,+     GeneralizedNewtypeDeriving,+     EmptyDataDecls,+     ScopedTypeVariables,+     ViewPatterns,+     FlexibleInstances,+     FlexibleContexts,+     MultiParamTypeClasses,+     DeriveDataTypeable,+     OverloadedStrings+++  Build-depends:+     base < 5,+     bytestring >= 0.9 && < 0.10,+     containers < 0.5,+     text >= 0.7 && <0.12,+     vector >= 0.5 && < 0.10,+     time < 1.5,+     tagged == 0.2.*,+     transformers == 0.2.*,+     property-list >= 0.0.1 && < 0.2,+     network < 2.4,+     filepath < 1.4,+     deepseq >= 1.1 && < 1.4++  Build-tools:+    c2hs++  Include-dirs:+    cbits+  C-Sources:+    cbits/cbits.c++  Ghc-options:+    -funbox-strict-fields++  Other-modules:+    C2HS+    CoreFoundation.Types.Array.Internal+  -- Build-tools:
+ CoreFoundation/Marshal.hs view
@@ -0,0 +1,104 @@+{- |+Marshalling assistance for foreign calls using CoreFoundation types.+-}+module CoreFoundation.Marshal(+  -- * Accessing the underlying pointers+  withObject,+  withMaybe,+  -- * Managing memory+  -- $memory+  Ref,+  -- ** Schemes+  -- $scheme+  Scheme,+  create,+  maybeCreate,+  get,+  constant,+  passThrough,+  checkError,+  -- ** Helper functions+  -- $helper+  call1,+  call2,+  call3,+  call4,+  call5,+  call6,+  ) where++import Foreign+import CoreFoundation.Types.Base++-- | Get the pointer for the object, or a null pointer otherwise+withMaybe :: CF a => Maybe a -> (Ptr (Repr a) -> IO b) -> IO b+withMaybe Nothing f = f nullPtr+withMaybe (Just o) f = withObject o f+++{- $helper+These functions are all defined in roughly the same way. For example:++> call2 scheme f = \arg1 arg2 ->+>   withObject arg1 $ \parg1 ->+>   withObject arg2 $ \parg2 ->+>   scheme $+>   f parg1 parg2++That is, they all unpack their parameters into pointers, call the+given function, and then use the appropriate scheme to put the+resulting value under memory management. The Scheme section has some+common schemes to use. Also see the @createArray@ scheme in "CoreFoundation.Types.Array".++See "CoreFoundation.Preferences" for example uses of these helpers. For example:++> getValue :: Key -> AppID -> UserID -> HostID -> IO (Maybe Plist)+> getValue = call4 maybeCreate {#call unsafe CFPreferencesCopyValue as ^ #}++-}++call1 scheme f = \arg1 ->+  withObject arg1 $ \parg1 ->+  scheme $+  f parg1++call2 scheme f = \arg1 arg2 ->+  withObject arg1 $ \parg1 ->+  withObject arg2 $ \parg2 ->+  scheme $+  f parg1 parg2++call3 scheme f = \arg1 arg2 arg3 ->+  withObject arg1 $ \parg1 ->+  withObject arg2 $ \parg2 ->+  withObject arg3 $ \parg3 ->+  scheme $+  f parg1 parg2 parg3++call4 scheme f = \arg1 arg2 arg3 arg4 ->+  withObject arg1 $ \parg1 ->+  withObject arg2 $ \parg2 ->+  withObject arg3 $ \parg3 ->+  withObject arg4 $ \parg4 ->+  scheme $+  f parg1 parg2 parg3 parg4++call5 scheme f = \arg1 arg2 arg3 arg4 arg5 ->+  withObject arg1 $ \parg1 ->+  withObject arg2 $ \parg2 ->+  withObject arg3 $ \parg3 ->+  withObject arg4 $ \parg4 ->+  withObject arg5 $ \parg5 ->+  scheme $+  f parg1 parg2 parg3 parg4 parg5++call6 scheme f = \arg1 arg2 arg3 arg4 arg5 arg6 ->+  withObject arg1 $ \parg1 ->+  withObject arg2 $ \parg2 ->+  withObject arg3 $ \parg3 ->+  withObject arg4 $ \parg4 ->+  withObject arg5 $ \parg5 ->+  withObject arg6 $ \parg6 ->+  scheme $+  f parg1 parg2 parg3 parg4 parg5 parg6+
+ CoreFoundation/Preferences.chs view
@@ -0,0 +1,233 @@+{- |+Core Foundation provides a simple, standard way to manage user (and application) preferences. Core Foundation stores preferences as key-value pairs that are assigned a scope using a combination of user name, application ID, and host (computer) names. This makes it possible to save and retrieve preferences that apply to different classes of users. Core Foundation preferences is useful to all applications that support user preferences. Note that modification of some preferences domains (those not belonging to the \"Current User\") requires root privileges (or Admin privileges prior to Mac OS X v10.6)-see Authorization Services Programming Guide (<https://developer.apple.com/library/mac/#documentation/Security/Conceptual/authorization_concepts/01introduction/introduction.html>)+for information on how to gain suitable privileges.+-}+module CoreFoundation.Preferences(+  -- * Types+  Key,+  SuiteID,+  AppID,+  anyApp,+  currentApp,+  HostID,+  anyHost,+  currentHost,+  UserID,+  anyUser,+  currentUser,+  -- * Getting+  getAppValue,+  getKeyList,+  getMultiple,+  getValue,+  -- * Setting+  setAppValue,+  setMultiple,+  setValue,+  -- * Synchronizing+  SyncFailed(..),+  appSync,+  sync,+  -- * Suite preferences+  addSuiteToApp,+  removeSuiteFromApp,+  -- * Misc+  appValueIsForced,+  getAppList,+  ) where++import Prelude hiding(String)++import CoreFoundation.Types+import CoreFoundation.Marshal+#include <CoreFoundation/CFPreferences.h>+#include "cbits.h"++import Control.Applicative+import Control.Exception+import Data.Typeable+import Foreign+import Foreign.C.Types++{#pointer CFStringRef -> CFString#}+{#pointer CFArrayRef -> CFArray#}+{#pointer CFDictionaryRef -> CFDictionary#}+{#pointer CFPropertyListRef -> CFPropertyList#}++-- | Keys. These can be constructed using the OverloadedStrings+-- language extension.+type Key = String++-- | ID of a suite, for example @com.apple.iApps@.+type SuiteID = String++-- | Application ID. Takes the form of a java package name, @com.foosoft@, or one of the constants 'anyApp', 'currentApp'.+type AppID = String++-- | Matches any application. This may be passed to functions which \"search\", such as 'getAppValue', 'getValue', 'getKeyList', etc. However, this may not be passed to functions which put a value in a specific location, such as 'setAppValue', 'syncApp'.+anyApp :: AppID+anyApp = constant {#call pure unsafe hsAnyApp#}++-- | Specifies the current application+currentApp :: AppID+currentApp = constant {#call pure unsafe hsCurrentApp#}++-- | Host ID. User-provided, or see the constants 'anyHost', 'currentHost'+type HostID = String++-- | When passed to functions which \"search\", such as 'getValue', 'getKeyList', etc, this allows the search to match any host. When passed to \"setting\" functions such as 'setValue', 'sync', it sets the value for all hosts.+anyHost :: HostID+anyHost = constant {#call pure unsafe hsAnyHost#}++-- | Current host+currentHost :: HostID+currentHost = constant {#call pure unsafe hsCurrentHost#}++-- | User ID. User-provided, or see the constants 'anyUser',+              -- 'currentUser'+type UserID = String++-- | When passed to functions which \"search\", such as 'getValue', 'getKeyList', etc, this allows the search to match any user. When passed to \"setting\" functions such as 'setValue', 'sync', it sets the value for all users.+anyUser :: UserID+anyUser = constant {#call pure unsafe hsAnyUser#}++-- | Current user+currentUser :: UserID+currentUser = constant {#call pure unsafe hsCurrentUser#}++------------------------- Getting ----------------------------+{- |+Obtains a preference value for the specified key and application. Wraps CFPreferencesCopyAppValue.+-}+getAppValue :: Key -> AppID -> IO (Maybe Plist)+getAppValue = call2 maybeCreate {#call unsafe CFPreferencesCopyAppValue as ^#}++{- |+Constructs and returns the list of all keys set in the specified domain. Wraps CFPreferencesCopyKeyList+-}+getKeyList :: AppID -> UserID -> HostID -> IO (Array Key)+getKeyList = call3 createArray {#call unsafe CFPreferencesCopyKeyList as ^ #}++{- |+Returns a dictionary containing preference values for multiple keys. If no values were located, returns an empty dictionary. +-}+getMultiple :: Array Key -> AppID -> UserID -> HostID -> IO (Dictionary Key Plist)+getMultiple = call4 create {#call unsafe CFPreferencesCopyMultiple as ^ #}++{- |+Returns a preference value for a given domain.++This function is the primitive get mechanism for the higher level preference function 'getAppValue'. Unlike the high-level function, 'getValue' searches only the exact domain specified. Do not use this function directly unless you have a need. Do not use arbitrary user and host names, instead pass the pre-defined domain qualifier constants (i.e. 'currentUser', 'anyUser', 'currentHost', 'anyHost').+-}+getValue :: Key -> AppID -> UserID -> HostID -> IO (Maybe Plist)+getValue = call4 maybeCreate {#call unsafe CFPreferencesCopyValue as ^ #}++-------------------------- Setting ---------------------------+{- |+Adds, modifies, or removes a preference.++New preference values are stored in the standard application preference location, <~/Library/Preferences/>. When called with 'currentApp', modifications are performed in the preference domain \"Current User, Current Application, Any Host.\" If you need to create preferences in some other domain, use the low-level function 'setValue'.++You must call the 'appSync' function in order for your changes to be saved to permanent storage.++Wraps @CFPreferencesSetAppValue@.+-}+setAppValue :: Key -> Maybe Plist -> AppID -> IO ()+setAppValue key val app =+  withObject key $ \k ->+  withMaybe val $ \v ->+  withObject app $ \a ->+  {#call unsafe CFPreferencesSetAppValue as ^ #} k v a++{- |+Convenience function that allows you to set and remove multiple preference values.++Behavior is undefined if a key is in both keysToSet and keysToRemove.++Wraps @CFPreferencesSetMultiple@.+-}+setMultiple :: +    Dictionary Key Plist -- ^ values to set+ -> Array Key -- ^ keys to remove + -> AppID + -> UserID + -> HostID + -> IO ()+setMultiple = call5 passThrough {#call unsafe CFPreferencesSetMultiple as ^ #}++{- |+Adds, modifies, or removes a preference value for the specified domain.++This function is the primitive set mechanism for the higher level preference function 'setAppValue'. Only the exact domain specified is modified. Do not use this function directly unless you have a specific need. Do not use arbitrary user and host names, instead pass the pre-defined constants.++You must call the 'sync' function in order for your changes to be saved to permanent storage. Note that you can only save preferences for \"Any User\" if you have root privileges (or Admin privileges prior to Mac OS X v10.6).+-}+setValue :: Key -> Maybe Plist -> AppID -> UserID -> HostID -> IO ()+setValue key val app user host =+  withObject key $ \k ->+  withMaybe val $ \v ->+  withObject app $ \a ->+  withObject user $ \u ->+  withObject host $ \h ->+  {#call unsafe CFPreferencesSetValue as ^ #} k v a u h++------------------------- Synchronizing ---------------+-- | Exception thrown when 'appSync' or 'sync' fail.+data SyncFailed = SyncFailed+  deriving(Typeable)+instance Show SyncFailed where+  show _ = "Syncing Apple preferences failed"+instance Exception SyncFailed++{- |+Writes to permanent storage all pending changes to the preference data for the application, and reads the latest preference data from permanent storage.++Calling the function 'setAppValue' is not in itself sufficient for storing preferences. The 'appSync' function writes to permanent storage all pending preference changes for the application. Typically you would call this function after multiple calls to 'setAppValue'. Conversely, preference data is cached after it is first read. Changes made externally are not automatically incorporated. The 'appSync' function reads the latest preferences from permanent storage.++Throws 'SyncFailed' if synchronization failed.+-}+appSync :: AppID -> IO ()+appSync = call1 (checkError SyncFailed) {#call unsafe CFPreferencesAppSynchronize as ^ #}++{- |+For the specified domain, writes all pending changes to preference data to permanent storage, and reads latest preference data from permanent storage.++This function is the primitive synchronize mechanism for the higher level preference function 'appSync'; it writes updated preferences to permanent storage, and reads the latest preferences from permanent storage. Only the exact domain specified is modified. Note that to modify \"Any User\" preferences requires root privileges (or Admin privileges prior to Mac OS X v10.6) - see <https://developer.apple.com/library/mac/#documentation/Security/Conceptual/authorization_concepts/01introduction/introduction.html>+-}+sync :: AppID -> UserID -> HostID -> IO ()+sync = call3 (checkError SyncFailed) {#call unsafe CFPreferencesSynchronize as ^ #}++---------------------- Suite preferences -----------+{- |+Adds suite preferences to an application’s preference search chain.++Suite preferences allow you to maintain a set of preferences that are common to all applications in the suite. When a suite is added to an application’s search chain, all of the domains pertaining to that suite are inserted into the chain. Suite preferences are added between the \"Current Application\" domains and the \"Any Application\" domains. If you add multiple suite preferences to one application, the order of the suites in the search chain is non-deterministic. You can override a suite preference for a given application by defining the same preference key in the application specific preferences.++Wraps @CFPreferencesAddSuitePreferencesToApp@.+-}+addSuiteToApp :: AppID -> SuiteID -> IO ()+addSuiteToApp = call2 passThrough {#call unsafe CFPreferencesAddSuitePreferencesToApp as ^ #}++{- |+Removes suite preferences from an application’s search chain.+-}+removeSuiteFromApp :: AppID -> SuiteID -> IO ()+removeSuiteFromApp = call2 passThrough {#call unsafe CFPreferencesRemoveSuitePreferencesFromApp as ^ #}++----------------------- Misc ------------------+{- |+Determines whether or not a given key has been imposed on the user.++In cases where machines and/or users are under some kind of management, you should use this function to determine whether or not to disable UI elements corresponding to those preference keys.+-}+appValueIsForced :: Key -> AppID -> IO Bool+appValueIsForced = call2 (Foreign.toBool <$>) {#call unsafe CFPreferencesAppValueIsForced as ^ #}++{- |+Constructs and returns the list of all applications that have preferences in the scope of the specified user and host.+-}+getAppList :: UserID -> HostID -> IO (Array AppID)+getAppList = call2 createArray {#call unsafe CFPreferencesCopyApplicationList as ^ #}+++-- marshalling utils
+ CoreFoundation/Types.hs view
@@ -0,0 +1,22 @@+-- | Re-exports+module CoreFoundation.Types(+  module CoreFoundation.Types.Array,+  module CoreFoundation.Types.Boolean,+  module CoreFoundation.Types.Data,+  module CoreFoundation.Types.Date,+  module CoreFoundation.Types.Dictionary,+  module CoreFoundation.Types.Number,+  module CoreFoundation.Types.PropertyList,+  module CoreFoundation.Types.String,+  module CoreFoundation.Types.Type,+ ) where++import CoreFoundation.Types.Array+import CoreFoundation.Types.Boolean+import CoreFoundation.Types.Data+import CoreFoundation.Types.Date+import CoreFoundation.Types.Dictionary+import CoreFoundation.Types.Number+import CoreFoundation.Types.PropertyList+import CoreFoundation.Types.String+import CoreFoundation.Types.Type
+ CoreFoundation/Types/Array.chs view
@@ -0,0 +1,92 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFArrayRef/Reference/reference.html>+module CoreFoundation.Types.Array(+  Array,+  CFArray,+  fromVector,+  toVector,+  fromList,+  toList,+  createArray,+  ) where++#include "CoreFoundation/CFData.h"+#include "cbits.h"++import Control.Applicative+import Data.Maybe(fromMaybe)+import Data.Typeable+import Control.DeepSeq++import qualified System.IO.Unsafe as U+import Foreign+import Foreign.C.Types++{#import CoreFoundation.Types.Base#}+import CoreFoundation.Types.Array.Internal++import qualified Data.Vector as V++-- | The opaque CoreFoundation @CFArray@ type.+data CFArray+{- | +Arrays of pointers. Wraps the @CFArrayRef@ type.+-}+newtype Array a = Array { unArray :: Ref CFArray }+  deriving(Typeable)+{#pointer CFArrayRef -> CFArray#}++instance CF a => CF (Array a) where+  type Repr (Array a) = CFArray+  wrap = Array+  unwrap = unArray++type instance UnHs (V.Vector a) = Array a+instance CF a => CFConcrete (Array a) where+  type Hs (Array a) = V.Vector a+  fromHs v =+    U.unsafePerformIO $+    withVector v $ \buf len ->+    create $+    castPtr <$>+    {#call unsafe hsCFArrayCreate as ^ #} (castPtr buf) (fromIntegral len)+  toHs o =+    U.unsafePerformIO $+    withObject o $ \p -> do+      len <- {#call unsafe CFArrayGetCount as ^ #} (castPtr p)+      (res, _) <- buildVector (fromIntegral len) $ \buf ->+        {#call unsafe hsCFArrayGetValues#} (castPtr p) len (castPtr buf)+      return res+  staticType _ = TypeID {#call pure unsafe CFArrayGetTypeID as ^ #}++-- | Synonym for 'fromHs'+fromVector :: CF a => V.Vector a -> Array a+fromVector = fromHs++-- | Synonym for 'toHs'+toVector :: CF a => Array a -> V.Vector a+toVector = toHs++-- | Convert from a list+fromList :: CF a => [a] -> Array a+fromList = fromVector . V.fromList++-- | Convert to a list+toList :: CF a => Array a -> [a]+toList = V.toList . toVector++{- |+CoreFoundation represents empty arrays by null pointers, which+may not be passed to 'create'. Instead, use this scheme for wrapping+arrays.+-}+createArray :: CF a => Scheme (Ptr CFArray) (Array a)+createArray = fmap (fromMaybe (fromHs V.empty)) . maybeCreate++instance (CF a, Show a) => Show (Array a) where+  show = show . toHs+instance (CF a, Eq a) => Eq (Array a) where+  a == b = toHs a == toHs b+instance (CF a, Ord a) => Ord (Array a) where+  compare a b = compare (toHs a) (toHs b)+-- | For CoreFoundation 'Array's, 'seq' and 'deepSeq' are the same+instance (CF a, NFData a) => NFData (Array a)
+ CoreFoundation/Types/Array/Internal.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE MagicHash, UnboxedTuples #-}+module CoreFoundation.Types.Array.Internal where++import GHC.Exts(touch#)+import GHC.IO(IO(..))++import qualified Data.Vector as V+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Storable.Mutable as SM++import CoreFoundation.Types.Base+import Foreign++import Control.Exception++withVector :: CF a => V.Vector a -> (Ptr (Ptr (Repr a)) -> Int -> IO b) -> IO b+withVector v f =+  (S.unsafeWith (V.convert (V.map extractPtr v)) $ \buf -> f buf (V.length v))+  `finally` touch v++buildVector :: CF a => Int -> (Ptr (Ptr (Repr a)) -> IO b) -> IO (V.Vector a, b)+buildVector len f = do+  mvec <- SM.new (fromIntegral len)+  res <- SM.unsafeWith mvec $ \ptr -> f ptr+  vec <- S.unsafeFreeze mvec+  vec' <- V.mapM (get . return) $ S.convert vec+  return (vec', res)+++touch :: a -> IO ()+touch a = IO (\s -> (# touch# a s, () #))
+ CoreFoundation/Types/Base.chs view
@@ -0,0 +1,241 @@+{- | +Internal module. Prefer to use "CoreFoundation.Types" and+"CoreFoundation.Marshal"+-}+module CoreFoundation.Types.Base(+  -- * Object-oriented hierarchy+  CF(..),+  CFConcrete(..),+  UnHs,+  dynamicCast,+  -- ** The 'Object' type+  Object,+  withObject,+  toObject,+  -- * Internals+  CFType,+  CFTypeRef,+  -- ** Type IDs and coercions+  TypeID(..),+  dynamicType,+  -- ** Memory management+  Ref,+  unsafeCastCF,+  extractPtr,+  -- *** Schemes+  Scheme,+  checkError,+  passThrough,+  create,+  maybeCreate,+  get,+  constant,+  ) where++#include "CoreFoundation/CFBase.h"+#include "CoreFoundation/CFString.h"++import System.IO.Unsafe as U+import Foreign+import Foreign.ForeignPtr.Unsafe as U+import Foreign.C.Types+import Control.Applicative+import Control.Monad+import Control.Exception+import Data.Proxy+import Data.Typeable+import Control.DeepSeq+-------------------- Object-oriented hierarchy++{- |+The class of CoreFoundation objects. For communicating with CoreFoundation methods, the underlying CoreFoundation object can be accessed using 'withObject'. All objects can be converted to 'Object' using 'toObject'.+-}+class CF ty where+  type Repr ty+  wrap :: Ref (Repr ty) -> ty+  unwrap :: ty -> Ref (Repr ty)++{- |+\"Concrete\" CoreFoundation objects. These are immutable, and can be marshalled in pure code+using 'toHs' and 'fromHs'. Checked coercions (i.e. ones which may fail at runtime) are provided by 'dynamicCast'.+-}+class (ty ~ UnHs (Hs ty), CF ty) => CFConcrete ty where+  -- converting to hs value+  type Hs ty+  toHs :: ty -> Hs ty+  fromHs :: Hs ty -> ty+  -- misc+  staticType :: Proxy ty -> TypeID++-- | Inverse of 'Hs'. Used as a superclass of 'CFConcrete'.+type family UnHs ty :: *++{- |+Dynamic cast between CoreFoundation types. The argument's type is compared at runtime to the+desired 'staticType'. On a match, 'Just' is returned; otherwise 'Nothing'.+-}+dynamicCast :: forall a b. (CF a, CFConcrete b) => a -> Maybe b+dynamicCast a = +  if dynamicType a == staticType (Proxy :: Proxy b)+     then Just (unsafeCastCF a)+     else Nothing++--- The 'Object' type+{#pointer CFTypeRef -> CFType #}++-- | Opaque @CFType@ object.+data CFType+{- | +Wrapper for @CFTypeRef@ object. This is the base type of the CoreFoundation type hierarchy.+-}+newtype Object = Object { unObject :: Ref CFType }+  deriving(Typeable)+instance CF Object where+  type Repr Object = CFType+  wrap = Object+  unwrap = unObject+instance NFData Object+-- | Unsafe: don't modify the object (although most CoreFoundation functions don't allow you to)+withObject :: CF a => a -> (Ptr (Repr a) -> IO b) -> IO b+withObject = withForeignPtr . unRef . unwrap++toObject :: CF a => a -> Object+toObject = unsafeCastCF++----------------------- Type IDs+{- |+A type for unique, constant integer values that identify particular Core Foundation opaque types.++@typedef unsigned long CFTypeID;@++ [Discussion] Defines a type identifier in Core Foundation. A type ID is an integer that identifies the opaque type to which a Core Foundation object “belongs.” You use type IDs in various contexts, such as when you are operating on heterogeneous collections. Core Foundation provides programmatic interfaces for obtaining and evaluating type IDs. Because the value for a type ID can change from release to release, your code should not rely on stored or hard-coded type IDs nor should it hard-code any observed properties of a type ID (such as, for example, it being a small integer).+-}+newtype TypeID = TypeID {#type CFTypeID#}+  deriving(Eq, Ord)++{- |+Returns the unique identifier of an opaque type to which a Core Foundation object belongs. Underlying function: @CFGetTypeID@.++ [Discussion]  This function returns a value that uniquely identifies the opaque type of any Core Foundation object. You can compare this value with the 'CFTypeID' identifier from 'staticType'. These values might+change from release to release or platform to platform.++ [Availability] Available in Mac OS X v10.0 and later.+-}+dynamicType :: CF a => a -> TypeID+dynamicType o = +  TypeID $+  U.unsafePerformIO $+  withObject (toObject o) {#call unsafe CFGetTypeID as ^ #}++------------------- managing memory++-- | A managed reference to the object a. These are approximately pointers to a,+-- but when garbage-collected, they release their underlying objects as appropriate.+newtype Ref a = Ref { unRef :: ForeignPtr a }++-- | Extract the underlying pointer. Make sure to touch the 'ForeignPtr' after using the 'Ptr',+-- to make sure that the object isn't accidentally finalised.+--+-- To avoid this concern, prefer to use 'withObject' when possible+extractPtr :: CF a => a -> Ptr (Repr a)+extractPtr = U.unsafeForeignPtrToPtr . unRef . unwrap++unsafeCastCF :: (CF a, CF b) => a -> b+unsafeCastCF = wrap . Ref . castForeignPtr . unRef . unwrap++---------------- Schemes+{- |+Schemes describe how to put CoreFoundation pointers under Haskell's memory management. ++ * The Ownership Policy document (see <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Conceptual/CFMemoryMgmt/Concepts/Ownership.html>)+defines the \"Create Rule\" and the \"Get Rule\" for memory management. In the context of Haskell,+these rules can be adhered to by using the 'create' (or 'maybeCreate' or 'createArray') schemes+for any CoreFoundation function with @Copy@ or @Create@ in its name; and by using 'get' for+any other functions returning CoreFoundation objects.++ * The 'constant' scheme can be used for literal constant objects, or any other objects guaranteed never to be deallocated for the life of the program.++ * The 'checkError' scheme ensures that the return code is nonzero++ * The 'passThrough' scheme passes the result through unmodified+-}+type Scheme a b = IO a -> IO b++{- | +The 'checkError' scheme ensures that the return code for errors.+If the return code is zero, the exception is thrown; otherwise,+@()@ is returned.+-}+checkError :: (Num a, Eq a, Exception e) => e -> Scheme a ()+checkError exception gen = do+  res <- gen+  when (res == 0) $ throw exception++{- |+The 'passThrough' scheme does no processing.++> passThrough = id+-}+passThrough :: Scheme a a+passThrough = id++{- | +Put the newly-created object under Haskell's memory management, throwing an exception if the+object is null. When the Haskell object is garbage collected, the+CoreFoundation object has its reference count decremented.+-}+create :: CF a => Scheme (Ptr (Repr a)) a+create gen = do+  res <- maybeCreate gen+  case res of+    Nothing -> fail "CoreFoundation.create: null object"+    Just p -> return p++{- | +Put the newly-created object under Haskell's memory management. When+the Haskell object is garbage collected, the CoreFoundation object +has its reference count decremented.+-}+maybeCreate :: CF a => IO (Ptr (Repr a)) -> IO (Maybe a)+maybeCreate gen =+  bracketOnError+    gen+    unref+    (\ptr ->+        if ptr == nullPtr+          then return Nothing+          else (Just . wrap . Ref) <$> newForeignPtr unrefPtr ptr)++{- |+Own (i.e. retain) the object, and put it under Haskell's memory management.+The CoreFoundation object has its reference count incremented upon creation+of the Haskell object, and then decremented upon garbage collection of the+Haskell object.+-}+get :: CF a => IO (Ptr (Repr a)) -> IO a+get gen = create $ do+  ptr <- gen+  ref ptr+  return ptr++{- | +Wrap a constant object: the underlying object's reference count is neither+incremented nor decremented.+-}+constant :: CF a => Ptr (Repr a) -> a+constant = wrap . Ref . U.unsafePerformIO . newForeignPtr_++-- implementation functions+foreign import ccall unsafe "&CFRelease"+  unrefPtr :: FinalizerPtr a++-- | Manual memory management+unref :: Ptr a -> IO ()+unref ptr+  | ptr == nullPtr = return ()+  | otherwise = {#call unsafe CFRelease as ^ #} (castPtr ptr)++ref :: Ptr a -> IO ()+ref ptr+  | ptr == nullPtr = return ()+  | otherwise = Foreign.void $ {#call unsafe CFRetain as ^ #} (castPtr ptr)
+ CoreFoundation/Types/Boolean.chs view
@@ -0,0 +1,65 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFBooleanRef/Reference/reference.html#>+module CoreFoundation.Types.Boolean(+  Boolean,+  CFBoolean,+  toBool,+  fromBool,+  ) where++#include <CoreFoundation/CFDate.h>+#include "cbits.h"++import CoreFoundation.Types.Base+import System.IO.Unsafe as U++import Foreign hiding (toBool, fromBool)+import Foreign.C.Types++import Data.Typeable+import Control.DeepSeq++-- | Opaque type @CFBoolean@+data CFBoolean+{- |+Wrapper for @CFBooleanRef@+-}+newtype Boolean = Boolean { unBoolean :: Ref CFBoolean }+  deriving(Typeable)+{#pointer CFBooleanRef -> CFBoolean#}+instance CF Boolean where+  type Repr Boolean = CFBoolean+  wrap = Boolean+  unwrap = unBoolean++type instance UnHs Bool = Boolean+instance CFConcrete Boolean where+  type Hs Boolean = Bool+  toHs o =+    0 /= (U.unsafePerformIO $ withObject o {#call unsafe CFBooleanGetValue as ^#})++  fromHs True = kTrue+  fromHs False = kFalse++  staticType _ = TypeID {#call pure unsafe CFBooleanGetTypeID as ^ #}++-- | Synonym for 'toHs'+toBool :: Boolean -> Bool+toBool = toHs++-- | Synonym for 'fromHs'+fromBool :: Bool -> Boolean+fromBool = fromHs++kTrue :: Boolean+kTrue = constant {#call pure unsafe hsTrue#}++kFalse :: Boolean+kFalse = constant {#call pure unsafe hsFalse#}++instance Show Boolean where+  show = show . toHs+instance Eq Boolean where+  a == b = toHs a == toHs b+instance Ord Boolean where+  compare a b = compare (toHs a) (toHs b)+instance NFData Boolean
+ CoreFoundation/Types/Data.chs view
@@ -0,0 +1,69 @@+module CoreFoundation.Types.Data(+  Data,+  CFData,+  fromByteString,+  toByteString,+  ) where++#include "CoreFoundation/CFData.h"+#include "cbits.h"++import qualified System.IO.Unsafe as U+import Foreign+import Foreign.C.Types++import CoreFoundation.Types.Base++import Control.DeepSeq+import Data.String+import Data.Typeable++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.ByteString.Char8()++{- | Opaque type representing the CoreFoundation @CFData object@.+-}+data CFData+{- | Type wrapping @CFDataRef@. A 'ByteString' at heart. -}+newtype Data = Data { unData :: Ref CFData }+  deriving(Typeable)+instance CF Data where+  type Repr Data = CFData+  wrap = Data+  unwrap = unData+{#pointer CFDataRef -> CFData#}++type instance UnHs B.ByteString = Data+instance CFConcrete Data where+  type Hs Data = B.ByteString+  fromHs bs = +    U.unsafePerformIO $+    B.unsafeUseAsCStringLen bs $ \(buf, len) ->+    create $+    {#call unsafe CFDataCreate as ^ #} nullPtr (castPtr buf) (fromIntegral len)+  toHs o = +    U.unsafePerformIO $+    withObject o $ \p -> do+      buf <- {#call unsafe CFDataGetBytePtr as ^ #} p+      len <- {#call unsafe CFDataGetLength as ^ #} p+      B.packCStringLen (castPtr buf, fromIntegral len)+  staticType _ = TypeID {#call pure unsafe CFDataGetTypeID as ^ #}++-- | Synonym for 'fromHs'+fromByteString :: B.ByteString -> Data+fromByteString = fromHs++-- | Synonym for 'toHs'+toByteString :: Data -> B.ByteString+toByteString = toHs++instance Show Data where+  show = show . toHs+instance Eq Data where+  a == b = toHs a == toHs b+instance Ord Data where+  compare a b = compare (toHs a) (toHs b)+instance IsString Data where+  fromString = fromHs . fromString+instance NFData Data
+ CoreFoundation/Types/Date.chs view
@@ -0,0 +1,69 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFDateRef/Reference/reference.html>+module CoreFoundation.Types.Date(+  Date,+  CFDate,+  toUTCTime,+  fromUTCTime,+  ) where++#include <CoreFoundation/CFDate.h>++import qualified System.IO.Unsafe as U+import Data.Time+import Foreign+import Foreign.C.Types+import Data.Typeable+import Control.DeepSeq+import CoreFoundation.Types.Base++-- | CoreFoundation @CFDate@ type.+data CFDate++{- |+Wraps the @CFDateRef@ type.+-}+newtype Date = Date { unDate :: Ref CFDate }+ deriving(Typeable)+{#pointer CFDateRef -> CFDate#}+instance CF Date where+  type Repr Date = CFDate+  wrap = Date+  unwrap = unDate++type instance UnHs UTCTime = Date+instance CFConcrete Date where+  type Hs Date = UTCTime+  toHs o =+    realToFrac +      (U.unsafePerformIO $ withObject o {#call unsafe CFDateGetAbsoluteTime as ^ #})+    `addUTCTime` appleEpoch+  fromHs t =+    U.unsafePerformIO $+    create $+    {#call unsafe CFDateCreate as ^#}+      nullPtr +      (realToFrac (t `diffUTCTime` appleEpoch))+  staticType _ = TypeID {#call pure unsafe CFDateGetTypeID as ^ #}++-- | Synonym for 'toHs'+toUTCTime :: Date -> UTCTime+toUTCTime = toHs++-- | Synonym for 'fromHs'+fromUTCTime :: UTCTime -> Date+fromUTCTime = fromHs++appleEpoch :: UTCTime+appleEpoch = +  UTCTime{+    utctDay = fromGregorian 2001 1 1,+    utctDayTime = 0+    }++instance Show Date where+  show = show . toHs+instance Eq Date where+  a == b = toHs a == toHs b+instance Ord Date where+  compare a b = compare (toHs a) (toHs b)+instance NFData Date
+ CoreFoundation/Types/Dictionary.chs view
@@ -0,0 +1,101 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFDictionaryRef/Reference/reference.html>+module CoreFoundation.Types.Dictionary(+  Dictionary,+  CFDictionary,+  fromVectors,+  toVectors,+  fromMap,+  toMap,+  ) where++#include "CoreFoundation/CFDictionary.h"+#include "cbits.h"++import Control.Applicative++import qualified System.IO.Unsafe as U+import Foreign+import Foreign.C.Types++import Data.Typeable+import Control.DeepSeq+import qualified Data.Text.Lazy as Text+++{#import CoreFoundation.Types.Base#}+import CoreFoundation.Types.Array.Internal++import qualified Data.Map as M+import qualified Data.Vector as V++{- |+The CoreFoundation @CFDictionary@ type.+-}+data CFDictionary+{- |+A dictionary with keys of type @k@ and values of type @v@. Wraps+@CFDictionaryRef@.+-}+newtype Dictionary k v = Dictionary { unDictionary :: Ref CFDictionary }+  deriving(Typeable)+{#pointer CFDictionaryRef -> CFDictionary #}+instance (CF k, CF v) => CF (Dictionary k v) where+  type Repr (Dictionary k v) = CFDictionary+  wrap = Dictionary+  unwrap = unDictionary++type instance UnHs (V.Vector k, V.Vector v) = Dictionary k v+instance (CF k, CF v) => CFConcrete (Dictionary k v) where+  type Hs (Dictionary k v) = (V.Vector k, V.Vector v)+  fromHs (keys, vals)+    | V.length keys /= V.length vals = error "CoreFoundation.Dictionary.fromHs: Vectors must have equal length"+    | otherwise =+        U.unsafePerformIO $+        withVector keys $ \pk len ->+        withVector vals $ \pv _ ->+        create $ +        castPtr <$> +        {#call unsafe hsCFDictionaryCreate as ^ #} +          (castPtr pk)+          (castPtr pv)+          (fromIntegral len)+  toHs o =+    U.unsafePerformIO $+    withObject o $ \p -> do+      len <- {#call unsafe CFDictionaryGetCount as ^ #} p+      buildVector (fromIntegral len) $ \kp ->+        fst <$> (buildVector (fromIntegral len) $ \vp ->+          {#call unsafe CFDictionaryGetKeysAndValues as ^ #} +             p +             (castPtr kp) +             (castPtr vp)+         )+  staticType _ = TypeID {#call pure unsafe CFDictionaryGetTypeID as ^ #}++-- | Synonym for 'fromHs'+fromVectors :: (CF k, CF v) => (V.Vector k, V.Vector v) -> Dictionary k v+fromVectors = fromHs++-- | Synonym for 'toHs'+toVectors :: (CF k, CF v) => Dictionary k v -> (V.Vector k, V.Vector v)+toVectors = toHs++-- | Convert from a 'Map'+fromMap :: (CF k, CF v) => M.Map k v -> Dictionary k v+fromMap = fromVectors . V.unzip . V.fromList . M.toList++-- | Convert to a 'Map'+toMap :: (Ord k, CF k, CF v) => Dictionary k v -> M.Map k v+toMap = M.fromList . V.toList . uncurry V.zip . toVectors++instance (CF k, CF v, Show k, Show v) => Show (Dictionary k v) where+  show = interCommas . V.map showPair . uncurry V.zip . toHs+    where+      showPair (k, v) = show k ++ ":" ++ show v+      interCommas = Text.unpack . Text.intercalate ", " . V.toList . V.map Text.pack+instance (CF k, CF v, Eq k, Eq v) => Eq (Dictionary k v) where+  a == b = toHs a == toHs b+-- | Equality by converting to a 'Map'+instance (CF k, CF v, Ord k, Ord v) => Ord (Dictionary k v) where+  compare a b = compare (toMap a) (toMap b)+instance NFData (Dictionary k v)
+ CoreFoundation/Types/Number.chs view
@@ -0,0 +1,96 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFNumberRef/Reference/reference.html>+module CoreFoundation.Types.Number(+  HsNumber(..),+  Number,+  CFNumber,+  toHsNumber,+  fromHsNumber,+  ) where++#include <CoreFoundation/CFNumber.h>+#include "cbits.h"+import CoreFoundation.Types.Base+import System.IO.Unsafe as U+import Control.Monad++import Data.Typeable+import Control.DeepSeq+import Data.Int+import Foreign hiding (toBool, fromBool)+import Foreign.C.Types++-- | A generic \"number\". The 'Eq' and 'Ord' instances respect+-- the structure of the type, but not the numeric structure.+data HsNumber+ = I !Int64+ | D !Double+  deriving(Eq, Ord, Show, Typeable)+instance NFData HsNumber+  ++-- | CoreFoundation @CFNumber@ type+data CFNumber+-- | Wraps @CFNumberRef@+newtype Number = Number { unNumber :: Ref CFNumber }+  deriving(Typeable)+{#pointer CFNumberRef -> CFNumber#}++type NumberType = {#type CFNumberType#}++float64Type, int64Type :: NumberType+float64Type = {#call pure unsafe hsFloat64Type#}+int64Type = {#call pure unsafe hsInt64Type#}++instance CF Number where+  type Repr Number = CFNumber+  wrap = Number+  unwrap = unNumber++type instance UnHs HsNumber = Number+instance CFConcrete Number where+  type Hs Number = HsNumber+  toHs o =+    U.unsafePerformIO $+    withObject o $ \p -> do+      isFloat <- {#call unsafe CFNumberIsFloatType as ^ #} p+      case isFloat /= 0 of+        True -> alloca $ \pres -> do+          success <- {#call unsafe CFNumberGetValue as ^ #} p float64Type (castPtr pres)+          when (success == 0) $ error "CoreFoundation.Number.toHs: conversion unexpectedly resulted in loss of precision"+          val <- peek pres+          return (D val)+        False -> alloca $ \pres -> do+          success <- {#call unsafe CFNumberGetValue as ^ #} p int64Type (castPtr pres)+          when (success == 0) $ error "CoreFoundation.Number.toHs: conversion unexpectedly resulted in loss of precision"+          val <- peek pres+          return (I val)++  fromHs (D d) = createWith d float64Type+  fromHs (I i) = createWith i int64Type++  staticType _ = TypeID {#call pure unsafe CFNumberGetTypeID as ^ #}++createWith n nty =+    U.unsafePerformIO $+    with n $ \np ->+    create $+    {#call unsafe CFNumberCreate as ^ #}+      nullPtr+      nty+      (castPtr np)++-- | Synonym for 'toHs'+toHsNumber :: Number -> HsNumber+toHsNumber = toHs++-- | Synonym for 'fromHs'+fromHsNumber :: HsNumber -> Number+fromHsNumber = fromHs++instance Show Number where+  show = show . toHs+instance Eq Number where+  a == b = toHs a == toHs b+instance Ord Number where+  compare a b = compare (toHs a) (toHs b)+instance NFData Number
+ CoreFoundation/Types/PropertyList.hs view
@@ -0,0 +1,171 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFPropertyListRef/Reference/reference.html>+module CoreFoundation.Types.PropertyList(+  -- * Basic interface+  Plist,+  CFPropertyList,+  PlistClass,+  toPlist,+  fromPlist,+  PlistView(..),+  viewPlist,+  -- * "Data.PropertyList" compat+  toPropertyList,+  fromPropertyList,+  ) where++import Prelude hiding(String)+import qualified Prelude++import CoreFoundation.Types.Base+import CoreFoundation.Types.String+import CoreFoundation.Types.Number+import CoreFoundation.Types.Boolean+import CoreFoundation.Types.Date+import CoreFoundation.Types.Data+import CoreFoundation.Types.Array+import CoreFoundation.Types.Dictionary++import Control.Arrow((***))+import Control.Applicative+import Data.Typeable+import Control.DeepSeq+import qualified Data.Vector as V+import Data.Functor.Identity+import qualified Data.Map as M+import qualified Data.Text as T++import qualified Data.PropertyList as PL+import           Data.PropertyList.Algebra hiding(toPlist, fromPlist)+import qualified Data.PropertyList.Algebra as PL++import Foreign hiding(fromBool)++-- | The CoreFoundation @CFPropertyList@ type+data CFPropertyList+{- |+Wraps the @CFPropertyListRef@ type. This is understood to be a+superclass of all of:++ * 'String'++ * 'Number'++ * 'Boolean'++ * 'Date'++ * 'Data'++ * 'Array Plist'++ * 'Dictionary String Plist'++These can be converted to 'Plist's using 'toPlist', and can be+extracted using either 'fromPlist' or 'viewPlist'.+-}+newtype Plist = Plist { unPlist :: Ref CFPropertyList }+  deriving(Typeable)++instance CF Plist where+  type Repr Plist = CFPropertyList+  wrap = Plist+  unwrap = unPlist++-- | Private class: don't add more instances!+class CFConcrete a => PlistClass a+instance PlistClass String+instance PlistClass Number+instance PlistClass Boolean+instance PlistClass Date+instance PlistClass Data+instance PlistClass (Array Plist)+instance PlistClass (Dictionary String Plist)++-- | Cast to 'Plist'+toPlist :: PlistClass a => a -> Plist+toPlist = unsafeCastCF++-- | Try coercing the 'Plist'+fromPlist :: PlistClass a => Plist -> Maybe a+fromPlist = dynamicCast . toObject++-- | Query the type of the 'Plist'+viewPlist :: Plist -> PlistView+viewPlist (fromPlist -> Just v) = String v+viewPlist (fromPlist -> Just v) = Number v+viewPlist (fromPlist -> Just v) = Boolean v+viewPlist (fromPlist -> Just v) = Date v+viewPlist (fromPlist -> Just v) = Data v+viewPlist (fromPlist -> Just v) = Array v+viewPlist (fromPlist -> Just v) = Dictionary v+viewPlist _ = error "CoreFoundation.PropertyList.viewPlist: Unexpected type in Plist"++-- | View of the \"outer level\" of a 'Plist'.+data PlistView+ = String !String+ | Number !Number+ | Boolean !Boolean+ | Date !Date+ | Data !Data+ | Array !(Array Plist)+ | Dictionary !(Dictionary String Plist)+  deriving(Show, Eq, Ord, Typeable)++instance NFData PlistView++instance Show Plist where+  show = show . viewPlist+instance Eq Plist where+  a == b = viewPlist a == viewPlist b+instance Ord Plist where+  compare a b = compare (viewPlist a) (viewPlist b)+instance NFData Plist  ++------------ support for Data.PropertyList+instance PListAlgebra Identity Plist where+  plistAlgebra (Identity v) = case v of+    PLArray w -> mk $ V.fromList w+    PLData w -> mk w+    PLDate w -> mk w+    PLDict w -> mk $ cvtMap w+    PLReal w -> mk $ D w+    PLInt w -> mk $ I $ fromIntegral w+    PLString w -> mk $ T.pack w+    PLBool w -> mk w+   where+     mk :: PlistClass a => Hs a -> Plist+     mk = toPlist . fromHs++cvtMap :: CF a => M.Map Prelude.String a -> (V.Vector String, V.Vector a)+cvtMap = (V.map fromString *** id) . V.unzip . V.fromList . M.toList++uncvtMap :: CF a => (V.Vector String, V.Vector a) -> M.Map Prelude.String a+uncvtMap = M.fromList . V.toList . uncurry V.zip . (V.map toString *** id)++plNumber (D d) = PLReal d+plNumber (I i) = PLInt (fromIntegral i)++instance Applicative f => PListCoalgebra f Plist where+  {-# SPECIALISE instance PListCoalgebra Identity Plist #-}+  plistCoalgebra v = case v of+    (fromPlist -> Just v) -> mk (PLArray . V.toList) v+    (fromPlist -> Just v) -> mk PLData v+    (fromPlist -> Just v) -> mk PLDate v+    (fromPlist -> Just v) -> mk (PLDict . uncvtMap) v+    (fromPlist -> Just v) -> mk plNumber v+    (fromPlist -> Just v) -> mk (PLString . T.unpack) v+    (fromPlist -> Just v) -> mk PLBool v+   where+    mk :: forall a. PlistClass a => (Hs a -> PropertyListS Plist) -> a -> f (PropertyListS Plist)+    mk ctor v = pure . ctor . toHs $ v++-- | Convert to 'PL.PropertyList'+toPropertyList :: Plist -> PL.PropertyList+toPropertyList = PL.toPlist++-- | Convert from 'PL.PropertyList'+fromPropertyList :: PL.PropertyList -> Plist+fromPropertyList = PL.toPlistWith idId+  where+    idId :: Identity a -> Identity a+    idId = id
+ CoreFoundation/Types/String.chs view
@@ -0,0 +1,90 @@+module CoreFoundation.Types.String(+  String,+  CFString,+  fromText,+  toText,+  fromString,+  toString,+  ) where++#include "CoreFoundation/CFString.h"+#include "cbits.h"++import qualified Data.String as S+import Prelude hiding(String)+import qualified Prelude+import qualified System.IO.Unsafe as U+import Foreign+import Foreign.C.Types++import qualified Data.Text as Text+import qualified Data.Text.Foreign as Text+import Data.Typeable+import Control.DeepSeq++{#import CoreFoundation.Types.Base#}++-- | The opaque CoreFoundation @CFString@ type.+data CFString+-- | +-- Wraps the CoreFoundation @CFStringRef@ type. Literals of this type+-- may be constructed with the @OverloadedStrings@ language extension:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > my_str = "example" :: CoreFoundation.Types.String+--+newtype String = String { unString :: Ref CFString }+  deriving(Typeable)+instance CF String where+  type Repr String = CFString+  wrap = String+  unwrap = unString+{#pointer CFStringRef -> CFString#}++type instance UnHs Text.Text = String+instance CFConcrete String where+  type Hs String = Text.Text+  fromHs t = +    U.unsafePerformIO $+    Text.useAsPtr t $ \buf len ->+    create $+    {#call unsafe CFStringCreateWithCharacters as ^ #} nullPtr (castPtr buf) (fromIntegral len)+  toHs str =+    U.unsafePerformIO $+    withObject str $ \str_p -> do+      len <- {#call unsafe CFStringGetLength as ^ #} str_p+      ptr <- {#call unsafe CFStringGetCharactersPtr as ^ #} str_p+      if ptr /= nullPtr+        then Text.fromPtr (castPtr ptr) (fromIntegral len)+        else allocaArray (fromIntegral len) $ \out_ptr -> do+          {#call unsafe hsCFStringGetCharacters as ^ #} str_p len out_ptr+          Text.fromPtr (castPtr out_ptr) (fromIntegral len)+  staticType _ = TypeID {#call pure unsafe CFStringGetTypeID as ^ #}+++-- | Synonym for 'fromHs'+fromText :: Text.Text -> String+fromText = fromHs++-- | Synonym for 'toHs'+toText :: String -> Text.Text+toText = toHs++-- | Convert from a Prelude 'Prelude.String'+fromString :: Prelude.String -> String+fromString = fromText . Text.pack++-- | Convert to a Prelude 'Prelude.String'+toString :: String -> Prelude.String+toString = Text.unpack . toText++instance S.IsString String where+  fromString = fromText . Text.pack+instance Show String where+  show = show . toHs+instance Eq String where+  a == b = toHs a == toHs b+instance Ord String where+  compare a b = compare (toHs a) (toHs b)+instance NFData String
+ CoreFoundation/Types/Type.chs view
@@ -0,0 +1,93 @@+-- | See <https://developer.apple.com/library/mac/#documentation/CoreFoundation/Reference/CFTypeRef/Reference/reference.html>+module CoreFoundation.Types.Type(+  -- * Object-oriented hierarchy+  CF(..),+  CFConcrete(..),+  dynamicCast,+  -- ** The 'Object' type+  Object,+  withObject,+  toObject,+  -- * Determining equality+  equal,+  -- * Hashing+  hash,+  -- * Description+  description,+  ) where++#include "CoreFoundation/CFBase.h"++import qualified System.IO.Unsafe as U+import C2HS++import Control.Applicative++import Data.Text(Text, unpack)+{#import CoreFoundation.Types.Base#}+import CoreFoundation.Types.String++{#pointer CFStringRef -> CFString#}++-------------------- Determining equality+{- |+Determines whether two Core Foundation objects are considered equal.++ [Discussion] Equality is something specific to each Core Foundation opaque type. For example, two CFNumber objects are equal if the numeric values they represent are equal. Two CFString objects are equal if they +represent identical sequences of characters, regardless of encoding.+-}+equal :: (CF a, CF b) => a -> b -> Bool+equal o1 o2 =+  U.unsafePerformIO $+  withObject (toObject o1) $ \p1 ->+  withObject (toObject o2) $ \p2 ->+  (/=0) <$> {#call unsafe CFEqual as ^ #} p1 p2++--------- Hashing+-- | type used for CoreFoundation hashes. Use 'fromIntegral' for conversions as necessary.+newtype HashCode = HashCode {#type CFHashCode#}+  deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real, Show)++{- |+Returns a code that can be used to identify an object in a hashing structure.++ [Discussion] Two objects that are equal (as determined by the 'equal' function) have the same hashing value. However, the converse is not true: two objects with the same hashing value might not be equal. That is, hashing values are not necessarily unique. The hashing value for an object might change from release to release or from platform to platform.+-}+hash :: CF a => a -> HashCode+hash o =+  HashCode $+  U.unsafePerformIO $+  withObject (toObject o) $+  {#call unsafe CFHash as ^ #}++--------- Description+{- |+Returns a textual description of a Core Foundation object.++[Discussion] The nature of the description differs by object. For example, a description of a CFArray object would include descriptions of each of the elements in the collection. You can use this function for debugging Core Foundation objects in your code. Note, however, that the description for a given object may be different in different releases of the operating system. Do not create dependencies in your code on the content or format of+the information returned by this function.++This function string is \"approximately\" referentially transparent: for equal objects @a@ and @b@,+one \"morally\" has @description a == description b@, except that descriptions contain pointer locations.+Thus this function lives in 'IO'.+-}+description :: CF a => a -> IO Text+description o =+  withObject (toObject o) $ \p ->+    toText <$> create ({#call unsafe CFCopyDescription as ^ #} p)++---------- Type ID++{- |+Returns a textual description of a Core Foundation type, as identified by its type ID, which can be used when debugging.++[Discussion] You can use this function for debugging Core Foundation objects in your code. Note, however, that the description for a given object may be different in different releases of the operating system. Do not create dependencies in your code on the content or format of the information returned by this function.++[Availability] Available in Mac OS X v10.0 and later.+-}+typeIDDescription :: TypeID -> Text+typeIDDescription (TypeID tid) =+  U.unsafePerformIO $+    toText <$> create ({#call unsafe CFCopyTypeIDDescription as ^ #} tid)++instance Show TypeID where show = unpack . typeIDDescription
+ CoreFoundation/URI.hs view
@@ -0,0 +1,68 @@+{- |+CoreFoundation tends to store filepaths as URIs rather than in POSIX+format. The functions 'uriToFilepath' and 'filepathToUri' provide the+appropriate conversions.+-}+module CoreFoundation.URI( +  Uri,+  uriToFilepath,+  filepathToUri,+ ) where++import qualified Prelude+import           Prelude hiding(String)++import CoreFoundation.Types.String++import Control.Monad+import Network.URI+import System.FilePath++-- | CoreFoundation strings which are formatted as uris+type Uri = String++fileScheme = "file:"+fileAuth = Just $ URIAuth "" "localhost" ""+fileQuery = ""+fileFragment = ""++{- |++>>> uriToFilepath "file://localhost/path/to/foo%20bar" +Just "/path/to/foo bar"++>>> uriToFilePath "malformed..."+Nothing++-}+uriToFilepath :: Uri -> Maybe FilePath+uriToFilepath str = do+  uri <- parseURI $ toString str+  guard $ uriScheme uri == fileScheme+  guard $ uriAuthority uri == fileAuth+  guard $ uriQuery uri == fileQuery+  guard $ uriFragment uri == fileFragment+  return $ unEscapeString $ uriPath uri++{- |++>>> filepathToUri "/path/to/foo bar"+"file://localhost/path/to/foo%20bar"++>>> filepathToUri "path/to/foo"+error: input path must be absolute++-}+filepathToUri :: FilePath -> Uri+filepathToUri fp +  | not (isAbsolute fp) = error "CoreFoundation.Utils.filepathToUri: input path must be absolute"+  | otherwise = fromString $ uriToString id uri ""+  where                    +    uri = +      URI {+        uriScheme = fileScheme,+        uriAuthority = fileAuth,+        uriPath = escapeURIString isUnescapedInURI fp,+        uriQuery = fileQuery,+        uriFragment = fileFragment+        }
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Reiner Pope++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 Reiner Pope 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/cbits.c view
@@ -0,0 +1,57 @@+#include "cbits.h"++void hsCFStringGetCharacters(CFStringRef theString, CFIndex len, UniChar *buffer) {+  CFStringGetCharacters(theString, CFRangeMake(0, len), buffer);+}++CFArrayRef hsCFArrayCreate(const void **values, CFIndex numValues) {+    CFArrayCreate(NULL, values, numValues, &kCFTypeArrayCallBacks);+}++void hsCFArrayGetValues(CFArrayRef theArray, CFIndex len, const void **values) {+  CFArrayGetValues(theArray, CFRangeMake(0, len), values);+}++CFDictionaryRef hsCFDictionaryCreate(const void **keys, const void **values, CFIndex numValues) {+  CFDictionaryCreate(NULL, keys, values, numValues, &kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks);+}++CFBooleanRef hsTrue() {+  return kCFBooleanTrue;+}++CFBooleanRef hsFalse() {+  return kCFBooleanFalse;+}++CFNumberType hsFloat64Type() {+  return kCFNumberFloat64Type;+}++CFNumberType hsInt64Type() {+  return kCFNumberSInt64Type;+}++CFStringRef hsAnyApp() {+  return kCFPreferencesAnyApplication;+}++CFStringRef hsAnyHost() {+  return kCFPreferencesAnyHost;+}++CFStringRef hsAnyUser() {+  return kCFPreferencesAnyUser;+}++CFStringRef hsCurrentApp() {+  return kCFPreferencesCurrentApplication;+}++CFStringRef hsCurrentHost() {+  return kCFPreferencesCurrentHost;+}++CFStringRef hsCurrentUser() {+  return kCFPreferencesCurrentUser;+}
+ cbits/cbits.h view
@@ -0,0 +1,19 @@+#include <CoreFoundation/CFString.h>+#include <CoreFoundation/CFArray.h>+#include <CoreFoundation/CFNumber.h>+#include <CoreFoundation/CFPreferences.h>++void hsCFStringGetCharacters(CFStringRef theString, CFIndex len, UniChar *buffer);+CFArrayRef hsCFArrayCreate(const void **values, CFIndex numValues);+void hsCFArrayGetValues(CFArrayRef theArray, CFIndex len, const void **values);+CFDictionaryRef hsCFDictionaryCreate(const void **keys, const void **values, CFIndex numValues);+CFBooleanRef hsFalse();+CFBooleanRef hsTrue();+CFNumberType hsFloat64Type();+CFNumberType hsInt64Type();+CFStringRef hsAnyApp();+CFStringRef hsAnyHost();+CFStringRef hsAnyUser();+CFStringRef hsCurrentApp();+CFStringRef hsCurrentHost();+CFStringRef hsCurrentUser();