rename modules + fix compiler warnings

9 files changed, 77 insertions, 68 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index e17adc9..558c23c 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -12,7 +12,7 @@ import System.Environment ( getArgs, getProgName )
 import System.Exit ( exitFailure, exitSuccess )
 import System.IO ( hPutStr, stderr )
 
-import qualified EnvUtils
+import qualified Environment
 
 main :: IO ()
 main = do
@@ -27,20 +27,20 @@ addPath :: [String] -> Options -> IO ()
 addPath paths options = do
   missingPaths <- dropIncludedPaths paths
   when (not $ null missingPaths) $ do
-    oldPath <- EnvUtils.queryFromRegistry (env options) (name options)
-    EnvUtils.saveToRegistryWithPrompt (env options) (name options) $ EnvUtils.joinPaths $ missingPaths ++ [oldPath]
+    oldPath <- Environment.queryFromRegistry (env options) (name options)
+    Environment.saveToRegistryWithPrompt (env options) (name options) $ Environment.joinPaths $ missingPaths ++ [oldPath]
       where
         dropIncludedPaths paths = do
-          currentPath <- EnvUtils.getEnv $ name options
-          return $ filter (flip notElem $ EnvUtils.splitPaths currentPath) paths
+          currentPath <- Environment.getEnv $ name options
+          return $ filter (flip notElem $ Environment.splitPaths currentPath) paths
 
 data Options = Options { name :: String
-                       , env :: EnvUtils.RegistryBasedEnvironment }
+                       , env :: Environment.RegistryBasedEnvironment }
                        deriving (Eq, Show)
 
 defaultOptions :: Options
 defaultOptions = Options { name = "PATH"
-                         , env = EnvUtils.CurrentUserEnvironment }
+                         , env = Environment.CurrentUserEnvironment }
 
 buildHelpMessage :: IO String
 buildHelpMessage = do
@@ -71,6 +71,6 @@ invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"]
 optionDescription :: [OptDescr (Options -> IO Options)]
 optionDescription = [
     Option "n" ["name"] (ReqArg (\s opts -> return opts { name = s }) "NAME") "set the variable name ('PATH' by default)",
-    Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "add the path for all users",
+    Option "g" ["global"] (NoArg $ \opts -> return opts { env = Environment.AllUsersEnvironment }) "add the path for all users",
     Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
   ]
diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs
index 404dc77..9a02cf9 100644
--- a/apps/FixNtSymbolPath.hs
+++ b/apps/FixNtSymbolPath.hs
@@ -10,7 +10,7 @@ import Control.Monad ( unless )
 import System.Directory ( createDirectoryIfMissing, getCurrentDirectory )
 import System.FilePath ( combine )
 
-import qualified EnvUtils
+import qualified Environment
 
 getRemoteSymbolsDirectoryPath :: IO String
 getRemoteSymbolsDirectoryPath = do
@@ -34,16 +34,16 @@ getPdbsDirectoryPath = do
 
 fixNtSymbolPath :: IO ()
 fixNtSymbolPath = do
-  let env = EnvUtils.CurrentUserEnvironment
-  val <- EnvUtils.queryFromRegistry env ntSymbolPath
-  let presentPaths = EnvUtils.splitPaths val
+  let env = Environment.CurrentUserEnvironment
+  val <- Environment.queryFromRegistry env ntSymbolPath
+  let presentPaths = Environment.splitPaths val
   remoteSymbolsPath <- getRemoteSymbolsDirectoryPath
   pdbsPath <- getPdbsDirectoryPath
   let requiredPaths = [pdbsPath, remoteSymbolsPath]
   let missingPaths = filter (`notElem` presentPaths) requiredPaths
   unless (null missingPaths) $ do
-    let newval = EnvUtils.joinPaths $ presentPaths ++ missingPaths
-    EnvUtils.saveToRegistry env ntSymbolPath newval
+    let newval = Environment.joinPaths $ presentPaths ++ missingPaths
+    Environment.saveToRegistry env ntSymbolPath newval
   where
     ntSymbolPath = "_NT_SYMBOL_PATH"
 
diff --git a/apps/ListPath.hs b/apps/ListPath.hs
index ca72e87..75f1b27 100644
--- a/apps/ListPath.hs
+++ b/apps/ListPath.hs
@@ -12,7 +12,7 @@ import System.Environment ( getArgs, getProgName )
 import System.Exit ( exitFailure, exitSuccess )
 import System.IO ( hPutStr, stderr )
 
-import qualified EnvUtils
+import qualified Environment
 
 main :: IO ()
 main = do
@@ -27,8 +27,8 @@ main = do
 
 listPath :: Options -> IO ()
 listPath options = do
-  val <- EnvUtils.getEnv $ name options
-  mapM_ printPath $ EnvUtils.splitPaths val
+  val <- Environment.getEnv $ name options
+  mapM_ printPath $ Environment.splitPaths val
     where
       printPath p = do
         exists <- doesDirectoryExist p
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index 2e8fd01..3071708 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -12,7 +12,7 @@ import System.Environment ( getArgs, getProgName )
 import System.Exit ( exitFailure, exitSuccess )
 import System.IO ( hPutStr, stderr )
 
-import qualified EnvUtils
+import qualified Environment
 
 main :: IO ()
 main = do
@@ -26,17 +26,17 @@ main = do
 removePath :: [String] -> Options -> IO ()
 removePath paths options = do
   let varName = name options
-  userVal <- EnvUtils.queryFromRegistry EnvUtils.CurrentUserEnvironment varName
-  let userValParts = EnvUtils.splitPaths userVal
+  userVal <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName
+  let userValParts = Environment.splitPaths userVal
   let newUserValParts = filter (`notElem` paths) userValParts
   when (length userValParts /= length newUserValParts) $ do
-    EnvUtils.saveToRegistryWithPrompt EnvUtils.CurrentUserEnvironment varName $ EnvUtils.joinPaths newUserValParts
+    Environment.saveToRegistryWithPrompt Environment.CurrentUserEnvironment varName $ Environment.joinPaths newUserValParts
   when (global options) $ do
-    globalVal <- EnvUtils.queryFromRegistry EnvUtils.AllUsersEnvironment varName
-    let globalValParts = EnvUtils.splitPaths globalVal
+    globalVal <- Environment.queryFromRegistry Environment.AllUsersEnvironment varName
+    let globalValParts = Environment.splitPaths globalVal
     let newGlobalValParts = filter (`notElem` paths) globalValParts
     when (length globalValParts /= length newGlobalValParts) $ do
-      EnvUtils.saveToRegistryWithPrompt EnvUtils.AllUsersEnvironment varName $ EnvUtils.joinPaths newGlobalValParts
+      Environment.saveToRegistryWithPrompt Environment.AllUsersEnvironment varName $ Environment.joinPaths newGlobalValParts
 
 data Options = Options { name :: String
                        , global :: Bool }
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index 30f5b1e..fda9726 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -11,7 +11,7 @@ import System.Environment ( getArgs, getProgName )
 import System.Exit ( exitFailure, exitSuccess )
 import System.IO ( hPutStr, stderr )
 
-import qualified EnvUtils
+import qualified Environment
 
 main :: IO ()
 main = do
@@ -26,12 +26,12 @@ main = do
       exitWithUsageErrors errorMessages
 
 setEnv :: String -> String -> Options -> IO ()
-setEnv name value options = EnvUtils.saveToRegistryWithPrompt (env options) name value
+setEnv name value options = Environment.saveToRegistryWithPrompt (env options) name value
 
-data Options = Options { env :: EnvUtils.RegistryBasedEnvironment } deriving (Eq, Show)
+data Options = Options { env :: Environment.RegistryBasedEnvironment } deriving (Eq, Show)
 
 defaultOptions :: Options
-defaultOptions = Options { env = EnvUtils.CurrentUserEnvironment }
+defaultOptions = Options { env = Environment.CurrentUserEnvironment }
 
 buildHelpMessage :: IO String
 buildHelpMessage = do
@@ -61,6 +61,6 @@ invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"]
 
 optionDescription :: [OptDescr (Options -> IO Options)]
 optionDescription = [
-    Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "save under the registry key for all users",
+    Option "g" ["global"] (NoArg $ \opts -> return opts { env = Environment.AllUsersEnvironment }) "save under the registry key for all users",
     Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
   ]
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index cd43696..254f383 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -11,7 +11,7 @@ import System.Environment ( getArgs, getProgName )
 import System.Exit ( exitFailure, exitSuccess )
 import System.IO ( hPutStr, stderr )
 
-import qualified EnvUtils
+import qualified Environment
 
 main :: IO ()
 main = do
@@ -25,12 +25,12 @@ main = do
     (_, _, errorMessages) -> exitWithUsageErrors errorMessages
 
 unsetEnv :: String -> Options -> IO ()
-unsetEnv name options = EnvUtils.wipeFromRegistryWithPrompt (env options) name
+unsetEnv name options = Environment.wipeFromRegistryWithPrompt (env options) name
 
-data Options = Options { env :: EnvUtils.RegistryBasedEnvironment } deriving (Eq, Show)
+data Options = Options { env :: Environment.RegistryBasedEnvironment } deriving (Eq, Show)
 
 defaultOptions :: Options
-defaultOptions = Options { env = EnvUtils.CurrentUserEnvironment }
+defaultOptions = Options { env = Environment.CurrentUserEnvironment }
 
 buildHelpMessage :: IO String
 buildHelpMessage = do
@@ -60,6 +60,6 @@ invalidNumberOfArguments = exitWithUsageErrors ["invalid number of arguments\n"]
 
 optionDescription :: [OptDescr (Options -> IO Options)]
 optionDescription = [
-    Option "g" ["global"] (NoArg $ \opts -> return opts { env = EnvUtils.AllUsersEnvironment }) "delete from the registry key for all users",
+    Option "g" ["global"] (NoArg $ \opts -> return opts { env = Environment.AllUsersEnvironment }) "delete from the registry key for all users",
     Option "h" ["help"] (NoArg exitWithHelpMessage) "show this message and exit"
   ]
diff --git a/src/EnvUtils.hs b/src/Environment.hs
index 7e9bc96..0690278 100644
--- a/src/EnvUtils.hs
+++ b/src/Environment.hs
@@ -4,15 +4,15 @@
  - See LICENSE.txt for details.
 -}
 
-module EnvUtils ( saveToRegistry
-                , saveToRegistryWithPrompt
-                , queryFromRegistry
-                , wipeFromRegistry
-                , wipeFromRegistryWithPrompt
-                , getEnv
-                , splitPaths
-                , joinPaths
-                , RegistryBasedEnvironment ( CurrentUserEnvironment, AllUsersEnvironment ) ) where
+module Environment ( saveToRegistry
+                   , saveToRegistryWithPrompt
+                   , queryFromRegistry
+                   , wipeFromRegistry
+                   , wipeFromRegistryWithPrompt
+                   , getEnv
+                   , splitPaths
+                   , joinPaths
+                   , RegistryBasedEnvironment(..) ) where
 
 import Control.Monad ( liftM, when )
 import Data.List ( intercalate )
@@ -21,7 +21,7 @@ import Data.Maybe ( fromMaybe )
 import qualified System.Environment ( lookupEnv )
 import System.IO.Error ( catchIOError, isDoesNotExistError )
 
-import qualified RegUtils
+import qualified Registry
 import qualified Utils ( promptToContinue )
 
 data RegistryBasedEnvironment = CurrentUserEnvironment
@@ -32,15 +32,16 @@ registrySubKeyPath :: RegistryBasedEnvironment -> String
 registrySubKeyPath CurrentUserEnvironment = "Environment"
 registrySubKeyPath AllUsersEnvironment = "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
 
-registryKey CurrentUserEnvironment = RegUtils.hkcu
-registryKey AllUsersEnvironment = RegUtils.hklm
+registryKey :: RegistryBasedEnvironment -> Registry.KeyHandle
+registryKey CurrentUserEnvironment = Registry.hkcu
+registryKey AllUsersEnvironment = Registry.hklm
 
 registryKeyPath :: RegistryBasedEnvironment -> String
 registryKeyPath CurrentUserEnvironment = "HKCU\\" ++ registrySubKeyPath CurrentUserEnvironment
 registryKeyPath AllUsersEnvironment = "HKLM\\" ++ registrySubKeyPath AllUsersEnvironment
 
 saveToRegistry :: RegistryBasedEnvironment -> String -> String -> IO ()
-saveToRegistry env = RegUtils.setString (registryKey env) (registrySubKeyPath env)
+saveToRegistry env = Registry.setString (registryKey env) (registrySubKeyPath env)
 
 saveToRegistryWithPrompt :: RegistryBasedEnvironment -> String -> String -> IO ()
 saveToRegistryWithPrompt env name value = do
@@ -52,13 +53,13 @@ saveToRegistryWithPrompt env name value = do
   when agreed $ saveToRegistry env name value
 
 queryFromRegistry :: RegistryBasedEnvironment -> String -> IO String
-queryFromRegistry env name = catchIOError (RegUtils.getString (registryKey env) (registrySubKeyPath env) name) emptyIfDoesNotExist
+queryFromRegistry env name = catchIOError (Registry.getString (registryKey env) (registrySubKeyPath env) name) emptyIfDoesNotExist
   where
     emptyIfDoesNotExist :: IOError -> IO String
     emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
 
 wipeFromRegistry :: RegistryBasedEnvironment -> String -> IO ()
-wipeFromRegistry env name = catchIOError (RegUtils.delValue (registryKey env) (registrySubKeyPath env) name) ignoreIfDoesNotExist
+wipeFromRegistry env name = catchIOError (Registry.delValue (registryKey env) (registrySubKeyPath env) name) ignoreIfDoesNotExist
   where
     ignoreIfDoesNotExist :: IOError -> IO ()
     ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
@@ -72,6 +73,7 @@ wipeFromRegistryWithPrompt env name = do
 getEnv :: String -> IO String
 getEnv = liftM (fromMaybe "") . System.Environment.lookupEnv
 
+pathSep :: String
 pathSep = ";"
 
 splitPaths :: String -> [String]
diff --git a/src/RegUtils.hs b/src/Registry.hs
index eccb6ad..d6c3f26 100644
--- a/src/RegUtils.hs
+++ b/src/Registry.hs
@@ -4,11 +4,12 @@
  - See LICENSE.txt for details.
 -}
 
-module RegUtils ( delValue
+module Registry ( delValue
                 , getString
                 , hkcu
                 , hklm
-                , setString ) where
+                , setString
+                , KeyHandle ) where
 
 import Control.Exception ( bracket )
 import Data.Maybe ( fromMaybe )
@@ -21,10 +22,12 @@ import System.IO.Error ( mkIOError, doesNotExistErrorType )
 import System.Win32.Types
 import System.Win32.Registry
 
+newtype KeyHandle = KeyHandle HKEY
+
 getType :: HKEY -> String -> String -> IO (Maybe RegValueType)
 getType key subKeyPath valueName =
-  bracket (regOpenKey key subKeyPath) regCloseKey $ \key ->
-  withForeignPtr key $ \p_key ->
+  bracket (regOpenKey key subKeyPath) regCloseKey $ \hKey ->
+  withForeignPtr hKey $ \p_key ->
   withTString valueName $ \p_valueName ->
   alloca $ \p_type -> do
     ret <- c_RegQueryValueEx p_key p_valueName nullPtr p_type nullPtr nullPtr
@@ -35,10 +38,10 @@ getType key subKeyPath valueName =
       0x2 -> return Nothing
       _   -> failWith "RegQueryValueEx" ret
 
-getString :: HKEY -> String -> String -> IO String
-getString key subKeyPath valueName =
-  bracket (regOpenKey key subKeyPath) regCloseKey $ \key ->
-  withForeignPtr key $ \p_key ->
+getString :: KeyHandle -> String -> String -> IO String
+getString (KeyHandle hKey) subKeyPath valueName =
+  bracket (regOpenKey hKey subKeyPath) regCloseKey $ \hSubKey ->
+  withForeignPtr hSubKey $ \p_key ->
   withTString valueName $ \p_valueName ->
   alloca $ \dataSizePtr -> do
     poke dataSizePtr 0
@@ -56,11 +59,11 @@ getString key subKeyPath valueName =
       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 ->
+setString :: KeyHandle -> String -> String -> String -> IO ()
+setString (KeyHandle hKey) subKeyPath valueName valueValue =
+  bracket (regOpenKey hKey subKeyPath) regCloseKey $ \subKey ->
   withTString valueValue $ \p_valueValue -> do
-    type_ <- getType key subKeyPath valueName
+    type_ <- getType hKey subKeyPath valueName
     regSetValueEx subKey valueName (fromMaybe rEG_SZ type_) p_valueValue $ (length valueValue + 1) * sizeOf (undefined :: TCHAR)
     notifyEnvironmentUpdate
 
@@ -70,14 +73,14 @@ notifyEnvironmentUpdate =
     let wparam = 0
     let lparam = fromIntegral $ castPtrToUINTPtr p_lparam
     let hwnd = castUINTPtrToPtr 0xffff
-    sendMessage hwnd wM_SETTINGCHANGE wparam lparam
+    _ <- sendMessage hwnd wM_SETTINGCHANGE wparam lparam
     return ()
       where
         wM_SETTINGCHANGE = 0x1A
 
-delValue :: HKEY -> String -> String -> IO ()
-delValue key subKeyPath valueName =
-  bracket (regOpenKey key subKeyPath) regCloseKey $ \subKey ->
+delValue :: KeyHandle -> String -> String -> IO ()
+delValue (KeyHandle hKey) subKeyPath valueName =
+  bracket (regOpenKey hKey subKeyPath) regCloseKey $ \subKey ->
   withForeignPtr subKey $ \subKeyPtr ->
   withTString valueName $ \p_valueName -> do
     ret <- c_RegDeleteValue subKeyPtr p_valueName
@@ -87,5 +90,8 @@ delValue key subKeyPath valueName =
       0x2 -> ioError $ mkIOError doesNotExistErrorType "RegQueryValueEx" Nothing $ Just (subKeyPath ++ "\\" ++ valueName)
       _   -> failWith "RegDeleteValue" ret
 
-hkcu = hKEY_CURRENT_USER
-hklm = hKEY_LOCAL_MACHINE
+hkcu :: KeyHandle
+hkcu = KeyHandle hKEY_CURRENT_USER
+
+hklm :: KeyHandle
+hklm = KeyHandle hKEY_LOCAL_MACHINE
diff --git a/wintmp.cabal b/wintmp.cabal
index cbb4b2c..8e73e63 100644
--- a/wintmp.cabal
+++ b/wintmp.cabal
@@ -15,7 +15,8 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     EnvUtils, RegUtils, Utils
+  exposed-modules:     Environment, Registry, Utils
+  ghc-options:         -Wall -Werror
   build-depends:       base, split, Win32
   default-language:    Haskell2010