From 244c26f595daceb3adeaa91343b8a7de26e1b27b Mon Sep 17 00:00:00 2001
From: Egor Tensin <Egor.Tensin@gmail.com>
Date: Sat, 24 Oct 2015 06:40:16 +0300
Subject: bugfix

---
 RegUtils.hs | 15 +++++++--------
 1 file 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
-- 
cgit v1.2.3