1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
module System.Environment.Executable.MacOSX
( getExecutablePath
, getApplicationBundlePath
)
where
import Data.Bits
import Data.Word
import Data.Int
import Control.Monad
import Foreign
import Foreign.C
--import System.FilePath
--------------------------------------------------------------------------------
type UInt8 = Word8
type UInt16 = Word16
type UInt32 = Word32
type UInt64 = Word64
type SInt8 = Int8
type SInt16 = Int16
type SInt32 = Int32
type SInt64 = Int64
type OSErr = SInt16
type OSStatus = SInt32
type Boolean = Bool
type Float32 = Float
type Float64 = Double
type UniChar = Char
type CFIndex = SInt32
type ItemCount = UInt32
type ByteCount = UInt32
data CFData
data CFString
data CFAllocator
type CFDataRef = Ptr CFData
type CFStringRef = Ptr CFString
type CFAllocatorRef = Ptr CFAllocator
--------------------------------------------------------------------------------
kCFAllocatorDefault :: CFAllocatorRef
kCFAllocatorDefault = nullPtr
osStatusString :: OSStatus -> String
osStatusString osstatus = "OSStatus = " ++ show osstatus
osStatusError :: OSStatus -> IO a
osStatusError osstatus = fail $ osStatusString osstatus
foreign import ccall unsafe "CFBase.h CFRelease"
c_CFRelease :: Ptr a -> IO ()
foreign import ccall unsafe "CFString.h CFStringGetLength"
c_CFStringGetLength :: CFStringRef -> IO CFIndex
foreign import ccall unsafe "CFString.h CFStringGetCharactersPtr"
c_CFStringGetCharactersPtr :: CFStringRef -> IO (Ptr UniChar)
foreign import ccall unsafe "CFString.h CFStringGetCharacterAtIndex"
c_CFStringGetCharacterAtIndex :: CFStringRef -> CFIndex -> IO UniChar
foreign import ccall unsafe "CFString.h CFStringCreateWithCharacters"
c_CFStringCreateWithCharacters :: CFAllocatorRef -> Ptr UniChar -> CFIndex -> IO CFStringRef
-- | Manually releasing a CFString.
releaseCFString :: CFStringRef -> IO ()
releaseCFString = c_CFRelease
-- | Peeks a CFString.
peekCFString :: CFStringRef -> IO String
peekCFString cfstring = do
n <- c_CFStringGetLength cfstring
p <- c_CFStringGetCharactersPtr cfstring
if p /= nullPtr
then forM [0..n-1] $ \i -> peekElemOff p (fromIntegral i)
else forM [0..n-1] $ \i -> c_CFStringGetCharacterAtIndex cfstring i
-- | Creates a new CFString. You have to release it manually.
newCFString :: String -> IO CFStringRef
newCFString string =
let n = length string in allocaArray n $ \p ->
c_CFStringCreateWithCharacters kCFAllocatorDefault p (fromIntegral n)
-- | Safe passing of a CFString to the OS (releases it afterwards).
withCFString :: String -> (CFStringRef -> IO a) -> IO a
withCFString string action = do
cfstring <- newCFString string
x <- action cfstring
releaseCFString cfstring
return x
--------------------------------------------------------------------------------
data CFBundle
type CFBundleRef = Ptr CFBundle
data CFURL
type CFURLRef = Ptr CFURL
type OSXEnum = CInt -- ?????????????
type CFURLPathStyle = OSXEnum
foreign import ccall unsafe "CFBundle.h CFBundleGetMainBundle"
c_CFBundleGetMainBundle :: IO CFBundleRef
foreign import ccall unsafe "CFBundle.h CFBundleCopyBundleURL"
c_CFBundleCopyBundleURL :: CFBundleRef -> IO CFURLRef
foreign import ccall unsafe "CFBundle.h CFBundleCopyExecutableURL"
c_CFBundleCopyExecutableURL :: CFBundleRef -> IO CFURLRef
foreign import ccall unsafe "CFURL.h CFURLCopyFileSystemPath"
c_CFURLCopyFileSystemPath :: CFURLRef -> CFURLPathStyle -> IO CFStringRef
kCFURLPOSIXPathStyle = 0 :: CFURLPathStyle
kCFURLHFSPathStyle = 1 :: CFURLPathStyle
kCFURLWindowsPathStyle = 2 :: CFURLPathStyle
-- | Mac OS X only.
getApplicationBundlePath :: IO FilePath
getApplicationBundlePath = do
bundle <- c_CFBundleGetMainBundle
url <- c_CFBundleCopyBundleURL bundle
cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle
peekCFString cfpath
getExecutablePath :: IO FilePath
getExecutablePath = do
bundle <- c_CFBundleGetMainBundle
url <- c_CFBundleCopyExecutableURL bundle
cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle
fname <- peekCFString cfpath
-- let (path,exename) = splitFileName fname
-- return path
return fname
--------------------------------------------------------------------------------
|
