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
|
{-
- Copyright 2015 Egor Tensin <Egor.Tensin@gmail.com>
- This file is licensed under the terms of the MIT License.
- See LICENSE.txt for details.
-}
module Registry
( KeyPath
, keyPathFromString
, keyPathJoin
, keyPathSplit
, KeyHandle
, openSubKey
, RootKey(..)
, openRootKey
, rootKeyPath
, ValueName
, delValue
, ValueData
, getString
, setString
) where
import Data.List (intercalate)
import Data.List.Split (splitOn)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Ptr (castPtr, plusPtr)
import Foreign.Storable (peek, poke, sizeOf)
import System.IO.Error (catchIOError, doesNotExistErrorType, mkIOError, isDoesNotExistError)
import qualified System.Win32.Types as WinAPI
import qualified System.Win32.Registry as WinAPI
type KeyName = String
type KeyPath = KeyName
keyPathSep :: KeyPath
keyPathSep = "\\"
keyPathFromString :: String -> KeyPath
keyPathFromString = keyPathJoin . keyPathSplit
keyPathSplit :: KeyPath -> [KeyName]
keyPathSplit = filter (not . null) . splitOn keyPathSep
keyPathJoin :: [KeyName] -> KeyPath
keyPathJoin = intercalate keyPathSep . filter (not . null)
type KeyHandle = WinAPI.HKEY
openSubKey :: KeyHandle -> KeyPath -> IO KeyHandle
openSubKey = WinAPI.regOpenKey
data RootKey = CurrentUser
| LocalMachine
deriving (Eq, Show)
rootKeyPath :: RootKey -> KeyName
rootKeyPath CurrentUser = "HKCU"
rootKeyPath LocalMachine = "HKLM"
openRootKey :: RootKey -> KeyHandle
openRootKey CurrentUser = WinAPI.hKEY_CURRENT_USER
openRootKey LocalMachine = WinAPI.hKEY_LOCAL_MACHINE
type ValueName = String
raiseDoesNotExistError :: String -> IO a
raiseDoesNotExistError functionName =
ioError $ mkIOError doesNotExistErrorType functionName Nothing Nothing
raiseUnknownError :: String -> WinAPI.ErrCode -> IO a
raiseUnknownError functionName exitCode = WinAPI.failWith functionName exitCode
exitCodeSuccess :: WinAPI.ErrCode
exitCodeSuccess = 0
exitCodeFileNotFound :: WinAPI.ErrCode
exitCodeFileNotFound = 0x2
exitCodeMoreData :: WinAPI.ErrCode
exitCodeMoreData = 0xea
raiseError :: String -> WinAPI.ErrCode -> IO a
raiseError functionName ret
| ret == exitCodeFileNotFound = raiseDoesNotExistError functionName
| otherwise = raiseUnknownError functionName ret
delValue :: KeyHandle -> ValueName -> IO ()
delValue keyHandle valueName =
withForeignPtr keyHandle $ \keyPtr ->
WinAPI.withTString valueName $ \valueNamePtr -> do
ret <- WinAPI.c_RegDeleteValue keyPtr valueNamePtr
if ret == exitCodeSuccess
then return ()
else raiseError "RegDeleteValue" ret
type ValueType = WinAPI.RegValueType
getType :: KeyHandle -> ValueName -> IO ValueType
getType keyHandle valueName =
withForeignPtr keyHandle $ \keyPtr ->
WinAPI.withTString valueName $ \valueNamePtr ->
alloca $ \typePtr -> do
ret <- WinAPI.c_RegQueryValueEx keyPtr valueNamePtr WinAPI.nullPtr typePtr WinAPI.nullPtr WinAPI.nullPtr
if ret == exitCodeSuccess
then peek typePtr
else raiseError "RegQueryValueEx" ret
type ValueData = String
getString :: KeyHandle -> ValueName -> IO ValueData
getString keyHandle valueName =
withForeignPtr keyHandle $ \keyPtr ->
WinAPI.withTString valueName $ \valueNamePtr ->
alloca $ \dataSizePtr -> do
poke dataSizePtr 0
ret <- WinAPI.c_RegQueryValueEx keyPtr valueNamePtr WinAPI.nullPtr WinAPI.nullPtr WinAPI.nullPtr dataSizePtr
if ret == exitCodeSuccess
then return ""
else if ret /= exitCodeMoreData
then raiseError "RegQueryValueEx" ret
else getStringTerminated keyPtr valueNamePtr dataSizePtr
where
getStringTerminated keyPtr valueNamePtr dataSizePtr = do
dataSize <- peek dataSizePtr
let newDataSize = dataSize + fromIntegral (sizeOf (undefined :: WinAPI.TCHAR))
poke dataSizePtr newDataSize
allocaBytes (fromIntegral newDataSize) $ \dataPtr -> do
poke (castPtr $ plusPtr dataPtr $ fromIntegral dataSize) '\0'
ret <- WinAPI.c_RegQueryValueEx keyPtr valueNamePtr WinAPI.nullPtr WinAPI.nullPtr dataPtr dataSizePtr
if ret == exitCodeSuccess
then WinAPI.peekTString $ castPtr dataPtr
else raiseError "RegQueryValueEx" ret
setString :: KeyHandle -> ValueName -> ValueData -> IO ()
setString key name value =
WinAPI.withTString value $ \valuePtr -> do
type_ <- catchIOError (getType key name) stringTypeByDefault
WinAPI.regSetValueEx key name type_ valuePtr valueSize
where
stringTypeByDefault e = if isDoesNotExistError e
then return WinAPI.rEG_SZ
else ioError e
valueSize = (length value + 1) * sizeOf (undefined :: WinAPI.TCHAR)
|
