refactoring

4 files changed, 74 insertions, 110 deletions

diff --git a/src/Environment.hs b/src/Environment.hs
index 68a3917..f370de4 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -5,116 +5,84 @@
 -}
 
 module Environment
-    ( RegistryLocation(..)
+    ( Profile(..)
+    , profileKeyPath
+
+    , VarName
+    , VarValue
     , query
     , engrave
-    , engravePrompt
     , wipe
-    , wipePrompt
 
     , pathJoin
     , pathSplit
     ) where
 
-import Control.Monad   (when)
 import Data.List       (intercalate)
 import Data.List.Split (splitOn)
-import Data.Maybe      (fromJust, isJust)
 import System.IO.Error (catchIOError, isDoesNotExistError)
 
-import qualified Graphics.Win32.GDI.Types as WinAPI
-import qualified Graphics.Win32.Message   as WinAPI
-import qualified System.Win32.Types       as WinAPI
-
 import qualified Registry
-import qualified Utils (promptToContinue)
+import           WindowsUtils (notifyEnvironmentUpdate)
 
-data RegistryLocation
-    = CurrentUser
-    | AllUsers
-    deriving (Eq, Show)
+data Profile = CurrentUser
+             | AllUsers
+             deriving (Eq, Show)
 
-subKeyPath :: RegistryLocation -> Registry.KeyPath
-subKeyPath CurrentUser =
-    Registry.keyPathFromString "Environment"
-subKeyPath AllUsers =
-    Registry.keyPathFromString "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
+profileRootKey :: Profile -> Registry.RootKey
+profileRootKey CurrentUser = Registry.CurrentUser
+profileRootKey AllUsers    = Registry.LocalMachine
 
-rootKey :: RegistryLocation -> Registry.RootKey
-rootKey CurrentUser = Registry.CurrentUser
-rootKey AllUsers    = Registry.LocalMachine
+profileRootKeyPath :: Profile -> Registry.KeyPath
+profileRootKeyPath = Registry.rootKeyPath . profileRootKey
 
-openRootKey :: RegistryLocation -> Registry.KeyHandle
-openRootKey = Registry.openRootKey . rootKey
+profileSubKeyPath :: Profile -> Registry.KeyPath
+profileSubKeyPath CurrentUser =
+    Registry.keyPathFromString "Environment"
+profileSubKeyPath AllUsers =
+    Registry.keyPathFromString "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
 
-openRegistryKey :: RegistryLocation -> IO Registry.KeyHandle
-openRegistryKey env = Registry.openSubKey (openRootKey env) (subKeyPath env)
+profileKeyPath :: Profile -> Registry.KeyPath
+profileKeyPath profile = Registry.keyPathJoin
+    [ profileRootKeyPath profile
+    , profileSubKeyPath  profile
+    ]
 
-registryKeyPath :: RegistryLocation -> Registry.KeyPath
-registryKeyPath env = Registry.keyPathJoin [Registry.rootKeyPath $ rootKey env, subKeyPath env]
+openRootProfileKey :: Profile -> Registry.KeyHandle
+openRootProfileKey = Registry.openRootKey . profileRootKey
 
-foreign import ccall "SendNotifyMessageW"
-    c_SendNotifyMessage :: WinAPI.HWND -> WinAPI.WindowMessage -> WinAPI.WPARAM -> WinAPI.LPARAM -> IO WinAPI.LRESULT
+openProfileKey :: Profile -> IO Registry.KeyHandle
+openProfileKey profile = Registry.openSubKey (openRootProfileKey profile) (profileSubKeyPath profile)
 
-notifyEnvUpdate :: IO ()
-notifyEnvUpdate =
-    WinAPI.withTString "Environment" $ \lparamPtr -> do
-        let wparam = 0
-        let lparam = fromIntegral $ WinAPI.castPtrToUINTPtr lparamPtr
-        _ <- c_SendNotifyMessage allWindows messageCode wparam lparam
-        return ()
-  where
-    messageCode = WinAPI.wM_WININICHANGE
-    hWND_BROADCAST = WinAPI.castUINTPtrToPtr 0xffff
-    allWindows = hWND_BROADCAST
+type VarName  = Registry.ValueName
+type VarValue = Registry.ValueData
 
-query :: RegistryLocation -> Registry.ValueName -> IO (Maybe Registry.ValueData)
-query env name = do
-    keyHandle <- openRegistryKey env
+query :: Profile -> VarName -> IO (Maybe VarValue)
+query profile name = do
+    keyHandle <- openProfileKey profile
     catchIOError (Registry.getString keyHandle name >>= return . Just) emptyIfDoesNotExist
   where
     emptyIfDoesNotExist e = if isDoesNotExistError e then return Nothing else ioError e
 
-engrave :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
-engrave env name value = do
-    keyHandle <- openRegistryKey env
+engrave :: Profile -> VarName -> VarValue -> IO ()
+engrave profile name value = do
+    keyHandle <- openProfileKey profile
     Registry.setString keyHandle name value
-    notifyEnvUpdate
-
-engravePrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO Bool
-engravePrompt env name value = do
-    putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
-    oldValue <- query env name
-    if (isJust oldValue)
-        then do
-            putStrLn $ "\tOld value: " ++ fromJust oldValue
-            putStrLn $ "\tNew value: " ++ value
-        else do
-            putStrLn $ "\tValue: " ++ value
-    agreed <- Utils.promptToContinue
-    when agreed $ engrave env name value
-    return agreed
-
-wipe :: RegistryLocation -> Registry.ValueName -> IO ()
-wipe env name = do
-    keyHandle <- openRegistryKey env
+    notifyEnvironmentUpdate
+
+wipe :: Profile -> VarName -> IO ()
+wipe profile name = do
+    keyHandle <- openProfileKey profile
     catchIOError (Registry.delValue keyHandle name) ignoreIfDoesNotExist
-    notifyEnvUpdate
+    notifyEnvironmentUpdate
   where
     ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
 
-wipePrompt :: RegistryLocation -> Registry.ValueName -> IO Bool
-wipePrompt env name = do
-    putStrLn $ "Deleting variable '" ++ name ++ "' from '" ++ registryKeyPath env ++ "'..."
-    agreed <- Utils.promptToContinue
-    when agreed $ wipe env name
-    return agreed
-
-pathSep :: String
+pathSep :: VarValue
 pathSep = ";"
 
-pathSplit :: String -> [String]
+pathSplit :: VarValue -> [VarValue]
 pathSplit = filter (not . null) . splitOn pathSep
 
-pathJoin :: [String] -> String
+pathJoin :: [VarValue] -> VarValue
 pathJoin = intercalate pathSep . filter (not . null)
diff --git a/src/Registry.hs b/src/Registry.hs
index 4a7c593..48d69f0 100644
--- a/src/Registry.hs
+++ b/src/Registry.hs
@@ -14,8 +14,8 @@ module Registry
     , openSubKey
 
     , RootKey(..)
-    , openRootKey
     , rootKeyPath
+    , openRootKey
 
     , ValueName
     , delValue
diff --git a/src/Utils.hs b/src/Utils.hs
deleted file mode 100644
index 143696b..0000000
--- a/src/Utils.hs
+++ /dev/null
@@ -1,32 +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 Utils where
-
-import Control.Monad (liftM)
-import Data.Char     (toLower)
-import System.IO     (hFlush, stdout)
-
-prompt :: String -> IO String
-prompt banner = do
-    putStr banner
-    hFlush stdout
-    getLine
-
-promptYesNo :: String -> IO Bool
-promptYesNo banner = do
-    response <- liftM (map toLower) $ prompt banner
-    if response `elem` yeses
-        then return True
-        else if response `elem` noes
-            then return False
-            else promptToContinue
-  where
-    yeses = ["y", "yes"]
-    noes = ["n", "no"]
-
-promptToContinue :: IO Bool
-promptToContinue = promptYesNo "Continue? (y/n) "
diff --git a/src/WindowsUtils.hs b/src/WindowsUtils.hs
new file mode 100644
index 0000000..6fa1f0e
--- /dev/null
+++ b/src/WindowsUtils.hs
@@ -0,0 +1,28 @@
+{-
+ - Copyright 2016 Egor Tensin <Egor.Tensin@gmail.com>
+ - This file is licensed under the terms of the MIT License.
+ - See LICENSE.txt for details.
+-}
+
+module WindowsUtils
+    ( notifyEnvironmentUpdate
+    ) where
+
+import qualified Graphics.Win32.GDI.Types as WinAPI
+import qualified Graphics.Win32.Message   as WinAPI
+import qualified System.Win32.Types       as WinAPI
+
+foreign import ccall "SendNotifyMessageW"
+    c_SendNotifyMessage :: WinAPI.HWND -> WinAPI.WindowMessage -> WinAPI.WPARAM -> WinAPI.LPARAM -> IO WinAPI.LRESULT
+
+notifyEnvironmentUpdate :: IO ()
+notifyEnvironmentUpdate =
+    WinAPI.withTString "Environment" $ \lparamPtr -> do
+        let wparam = 0
+        let lparam = fromIntegral $ WinAPI.castPtrToUINTPtr lparamPtr
+        _ <- c_SendNotifyMessage allWindows messageCode wparam lparam
+        return ()
+  where
+    messageCode = WinAPI.wM_WININICHANGE
+    hWND_BROADCAST = WinAPI.castUINTPtrToPtr 0xffff
+    allWindows = hWND_BROADCAST