aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/src/Registry.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Registry.hs')
-rw-r--r--src/Registry.hs145
1 files changed, 0 insertions, 145 deletions
diff --git a/src/Registry.hs b/src/Registry.hs
deleted file mode 100644
index 48d69f0..0000000
--- a/src/Registry.hs
+++ /dev/null
@@ -1,145 +0,0 @@
-{-
- - 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(..)
- , rootKeyPath
- , openRootKey
-
- , 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.Registry as WinAPI
-import qualified System.Win32.Types 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
-
-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 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)