aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
authorEgor Tensin <Egor.Tensin@gmail.com>2015-10-24 06:40:16 +0300
committerEgor Tensin <Egor.Tensin@gmail.com>2015-10-24 06:40:16 +0300
commit244c26f595daceb3adeaa91343b8a7de26e1b27b (patch)
tree29fa5344661f895a95fa4086060bec34b5936794
parentREADME update (diff)
downloadwindows-env-244c26f595daceb3adeaa91343b8a7de26e1b27b.tar.gz
windows-env-244c26f595daceb3adeaa91343b8a7de26e1b27b.zip
bugfix
-rw-r--r--RegUtils.hs15
1 files changed, 7 insertions, 8 deletions
diff --git a/RegUtils.hs b/RegUtils.hs
index 429abec..ba997a1 100644
--- a/RegUtils.hs
+++ b/RegUtils.hs
@@ -12,7 +12,6 @@ module RegUtils ( delValue
import Control.Exception ( bracket )
import Data.Maybe ( fromMaybe )
-import Foreign.C.String ( peekCWString, withCWString )
import Foreign.ForeignPtr ( withForeignPtr )
import Foreign.Marshal.Alloc ( alloca, allocaBytes )
import Foreign.Ptr ( castPtr, plusPtr )
@@ -25,7 +24,7 @@ getType :: HKEY -> String -> String -> IO (Maybe RegValueType)
getType key subKeyPath valueName =
bracket (regOpenKey key subKeyPath) regCloseKey $ \key ->
withForeignPtr key $ \keyPtr ->
- withCWString valueName $ \valueNamePtr ->
+ withTString valueName $ \valueNamePtr ->
alloca $ \typePtr -> do
ret <- c_RegQueryValueEx keyPtr valueNamePtr nullPtr typePtr nullPtr nullPtr
case ret of
@@ -39,7 +38,7 @@ getString :: HKEY -> String -> String -> IO String
getString key subKeyPath valueName =
bracket (regOpenKey key subKeyPath) regCloseKey $ \key ->
withForeignPtr key $ \keyPtr ->
- withCWString valueName $ \valueNamePtr ->
+ withTString valueName $ \valueNamePtr ->
alloca $ \dataSizePtr -> do
poke dataSizePtr 0
ret <- c_RegQueryValueEx keyPtr valueNamePtr nullPtr nullPtr nullPtr dataSizePtr
@@ -52,16 +51,16 @@ getString key subKeyPath valueName =
poke (castPtr $ plusPtr dataPtr $ fromIntegral dataSize) '\0'
failUnlessSuccess "RegQueryValueEx" $
c_RegQueryValueEx keyPtr valueNamePtr nullPtr nullPtr dataPtr dataSizePtr
- peekCWString $ castPtr dataPtr
+ peekTString $ castPtr dataPtr
0x2 -> ioError $ mkIOError doesNotExistErrorType "RegQueryValueEx" Nothing $ Just (subKeyPath ++ "\\" ++ valueName)
_ -> failWith "RegQueryValueEx" ret
setString :: HKEY -> String -> String -> String -> IO ()
setString key subKeyPath valueName valueValue =
bracket (regOpenKey key subKeyPath) regCloseKey $ \subKey ->
- withTStringLen valueValue $ \(ptr, len) -> do
+ withTString valueValue $ \ptr -> do
type' <- getType key subKeyPath valueName
- regSetValueEx subKey valueName (fromMaybe rEG_SZ type') ptr $ len * sizeOf (undefined :: TCHAR)
+ regSetValueEx subKey valueName (fromMaybe rEG_SZ type') ptr $ (length valueValue + 1) * sizeOf (undefined :: TCHAR)
notifyEnvironmentUpdate
foreign import ccall "BroadcastSystemMessageW"
@@ -69,7 +68,7 @@ foreign import ccall "BroadcastSystemMessageW"
notifyEnvironmentUpdate :: IO ()
notifyEnvironmentUpdate =
- withCWString "Environment" $ \lparamPtr -> do
+ withTString "Environment" $ \lparamPtr -> do
let wparam = fromIntegral $ castPtrToUINTPtr nullPtr
let lparam = fromIntegral $ castPtrToUINTPtr lparamPtr
c_BroadcastSystemMessage bSF_POSTMESSAGE nullPtr wM_SETTINGCHANGE wparam lparam
@@ -82,7 +81,7 @@ delValue :: HKEY -> String -> String -> IO ()
delValue key subKeyPath valueName =
bracket (regOpenKey key subKeyPath) regCloseKey $ \subKey ->
withForeignPtr subKey $ \subKeyPtr ->
- withCWString valueName $ \valueNamePtr -> do
+ withTString valueName $ \valueNamePtr -> do
ret <- c_RegDeleteValue subKeyPtr valueNamePtr
notifyEnvironmentUpdate
case ret of