aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/src/Environment.hs
diff options
context:
space:
mode:
authorEgor Tensin <Egor.Tensin@gmail.com>2016-07-12 17:10:29 +0300
committerEgor Tensin <Egor.Tensin@gmail.com>2016-07-12 17:10:29 +0300
commitc7d5766463e5e99fcd2352c7177cf057c1971615 (patch)
tree04e2c34217dd498111965a17b9cafcb633ed5c13 /src/Environment.hs
parentminimize stack.yaml (diff)
downloadwindows-env-c7d5766463e5e99fcd2352c7177cf057c1971615.tar.gz
windows-env-c7d5766463e5e99fcd2352c7177cf057c1971615.zip
refactoring
Diffstat (limited to 'src/Environment.hs')
-rw-r--r--src/Environment.hs99
1 files changed, 47 insertions, 52 deletions
diff --git a/src/Environment.hs b/src/Environment.hs
index 5a3978e..c0dd723 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -5,23 +5,21 @@
-}
module Environment
- ( queryFromRegistry
- , saveToRegistry
- , saveToRegistryWithPrompt
- , wipeFromRegistry
- , wipeFromRegistryWithPrompt
- , getEnv
- , splitPaths
- , joinPaths
- , RegistryBasedEnvironment(..)
+ ( RegistryLocation(..)
+ , query
+ , engrave
+ , engraveWithPrompt
+ , wipe
+ , wipeWithPrompt
+
+ , pathJoin
+ , pathSplit
) where
-import Control.Monad (liftM, when)
-import Data.List (intercalate)
-import Data.List.Split (splitOn)
-import Data.Maybe (fromMaybe)
-import qualified System.Environment (lookupEnv)
-import System.IO.Error (catchIOError, isDoesNotExistError)
+import Control.Monad (when)
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
+import System.IO.Error (catchIOError, isDoesNotExistError)
import qualified Graphics.Win32.Window as WinAPI
import qualified System.Win32.Types as WinAPI
@@ -29,28 +27,28 @@ import qualified System.Win32.Types as WinAPI
import qualified Registry
import qualified Utils (promptToContinue)
-data RegistryBasedEnvironment
- = CurrentUserEnvironment
- | AllUsersEnvironment
+data RegistryLocation
+ = CurrentUser
+ | AllUsers
deriving (Eq, Show)
-subKeyPath :: RegistryBasedEnvironment -> Registry.KeyPath
-subKeyPath CurrentUserEnvironment =
+subKeyPath :: RegistryLocation -> Registry.KeyPath
+subKeyPath CurrentUser =
Registry.keyPathFromString "Environment"
-subKeyPath AllUsersEnvironment =
+subKeyPath AllUsers =
Registry.keyPathFromString "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
-rootKey :: RegistryBasedEnvironment -> Registry.RootKey
-rootKey CurrentUserEnvironment = Registry.CurrentUser
-rootKey AllUsersEnvironment = Registry.LocalMachine
+rootKey :: RegistryLocation -> Registry.RootKey
+rootKey CurrentUser = Registry.CurrentUser
+rootKey AllUsers = Registry.LocalMachine
-openRootKey :: RegistryBasedEnvironment -> Registry.KeyHandle
+openRootKey :: RegistryLocation -> Registry.KeyHandle
openRootKey = Registry.openRootKey . rootKey
-openRegistryKey :: RegistryBasedEnvironment -> IO Registry.KeyHandle
+openRegistryKey :: RegistryLocation -> IO Registry.KeyHandle
openRegistryKey env = Registry.openSubKey (openRootKey env) (subKeyPath env)
-registryKeyPath :: RegistryBasedEnvironment -> Registry.KeyPath
+registryKeyPath :: RegistryLocation -> Registry.KeyPath
registryKeyPath env = Registry.keyPathJoin [Registry.rootKeyPath $ rootKey env, subKeyPath env]
notifyEnvUpdate :: IO ()
@@ -66,50 +64,47 @@ notifyEnvUpdate =
allWindows = WinAPI.castUINTPtrToPtr 0xffff
-saveToRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> Registry.ValueData -> IO ()
-saveToRegistry env name value = do
+query :: RegistryLocation -> Registry.ValueName -> IO Registry.ValueData
+query env name = do
+ keyHandle <- openRegistryKey env
+ catchIOError (Registry.getString keyHandle name) emptyIfDoesNotExist
+ where
+ emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
+
+engrave :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
+engrave env name value = do
keyHandle <- openRegistryKey env
Registry.setString keyHandle name value
notifyEnvUpdate
-saveToRegistryWithPrompt :: RegistryBasedEnvironment -> Registry.ValueName -> Registry.ValueData -> IO ()
-saveToRegistryWithPrompt env name value = do
+engraveWithPrompt :: RegistryLocation -> Registry.ValueName -> Registry.ValueData -> IO ()
+engraveWithPrompt env name value = do
putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
- oldValue <- queryFromRegistry env name
+ oldValue <- query env name
putStrLn $ "\tOld value: " ++ oldValue
putStrLn $ "\tNew value: " ++ value
agreed <- Utils.promptToContinue
- when agreed $ saveToRegistry env name value
+ when agreed $ engrave env name value
-queryFromRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> IO Registry.ValueData
-queryFromRegistry env name = do
- keyHandle <- openRegistryKey env
- catchIOError (Registry.getString keyHandle name) emptyIfDoesNotExist
- where
- emptyIfDoesNotExist e = if isDoesNotExistError e then return "" else ioError e
-
-wipeFromRegistry :: RegistryBasedEnvironment -> Registry.ValueName -> IO ()
-wipeFromRegistry env name = do
+wipe :: RegistryLocation -> Registry.ValueName -> IO ()
+wipe env name = do
keyHandle <- openRegistryKey env
catchIOError (Registry.delValue keyHandle name) ignoreIfDoesNotExist
notifyEnvUpdate
where
ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
-wipeFromRegistryWithPrompt :: RegistryBasedEnvironment -> Registry.ValueName -> IO ()
-wipeFromRegistryWithPrompt env name = do
+wipeWithPrompt :: RegistryLocation -> Registry.ValueName -> IO ()
+wipeWithPrompt env name = do
putStrLn $ "Deleting variable '" ++ name ++ "' from '" ++ registryKeyPath env ++ "'..."
agreed <- Utils.promptToContinue
- when agreed $ wipeFromRegistry env name
-
-getEnv :: String -> IO String
-getEnv = liftM (fromMaybe "") . System.Environment.lookupEnv
+ when agreed $ wipe env name
pathSep :: String
pathSep = ";"
-splitPaths :: String -> [String]
-splitPaths = filter (not . null) . splitOn pathSep
+pathSplit :: String -> [String]
+pathSplit = filter (not . null) . splitOn pathSep
-joinPaths :: [String] -> String
-joinPaths = intercalate pathSep . filter (not . null)
+pathJoin :: [String] -> String
+pathJoin = intercalate pathSep . filter (not . null)