From c7d5766463e5e99fcd2352c7177cf057c1971615 Mon Sep 17 00:00:00 2001 From: Egor Tensin Date: Tue, 12 Jul 2016 17:10:29 +0300 Subject: refactoring --- apps/AddPath.hs | 12 +++--- apps/FixNtSymbolPath.hs | 14 +++---- apps/ListPath.hs | 12 ++++-- apps/RemovePath.hs | 12 +++--- apps/SetEnv.hs | 6 +-- apps/UnsetEnv.hs | 6 +-- src/Environment.hs | 99 +++++++++++++++++++++++-------------------------- 7 files changed, 81 insertions(+), 80 deletions(-) diff --git a/apps/AddPath.hs b/apps/AddPath.hs index 85f2aa4..5203723 100644 --- a/apps/AddPath.hs +++ b/apps/AddPath.hs @@ -44,11 +44,11 @@ addPath :: Options -> IO () addPath options = do missingPaths <- dropIncludedPaths $ paths options when (not $ null missingPaths) $ do - oldPath <- Environment.queryFromRegistry env $ name options - Environment.saveToRegistryWithPrompt env (name options) $ Environment.joinPaths $ missingPaths ++ [oldPath] + oldPath <- Environment.query env $ name options + Environment.engraveWithPrompt env (name options) $ Environment.pathJoin $ missingPaths ++ [oldPath] where dropIncludedPaths paths = do - currentPath <- Environment.getEnv $ name options - return $ filter (flip notElem $ Environment.splitPaths currentPath) paths - env | global options = Environment.AllUsersEnvironment - | otherwise = Environment.CurrentUserEnvironment + currentPath <- Environment.query env $ name options + return $ filter (flip notElem $ Environment.pathSplit currentPath) paths + env | global options = Environment.AllUsers + | otherwise = Environment.CurrentUser diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs index c75291e..a44a840 100644 --- a/apps/FixNtSymbolPath.hs +++ b/apps/FixNtSymbolPath.hs @@ -6,9 +6,9 @@ module Main (main) where -import Control.Monad (unless) +import Control.Monad (unless) import System.Directory (createDirectoryIfMissing, getCurrentDirectory) -import System.FilePath (combine) +import System.FilePath (combine) import qualified Environment @@ -32,16 +32,16 @@ getPdbsDirectoryPath = do fixNtSymbolPath :: IO () fixNtSymbolPath = do - let env = Environment.CurrentUserEnvironment - val <- Environment.queryFromRegistry env ntSymbolPath - let presentPaths = Environment.splitPaths val + let env = Environment.CurrentUser + val <- Environment.query env ntSymbolPath + let presentPaths = Environment.pathSplit val remoteSymbolsPath <- getRemoteSymbolsDirectoryPath pdbsPath <- getPdbsDirectoryPath let requiredPaths = [pdbsPath, remoteSymbolsPath] let missingPaths = filter (`notElem` presentPaths) requiredPaths unless (null missingPaths) $ do - let newval = Environment.joinPaths $ presentPaths ++ missingPaths - Environment.saveToRegistry env ntSymbolPath newval + let newval = Environment.pathJoin $ presentPaths ++ missingPaths + Environment.engrave env ntSymbolPath newval where ntSymbolPath = "_NT_SYMBOL_PATH" diff --git a/apps/ListPath.hs b/apps/ListPath.hs index 95d9c8b..63460b9 100644 --- a/apps/ListPath.hs +++ b/apps/ListPath.hs @@ -6,7 +6,10 @@ module Main (main) where -import System.Directory (doesDirectoryExist) +import Control.Monad (liftM) +import Data.Maybe (fromMaybe) +import System.Directory (doesDirectoryExist) +import System.Environment (lookupEnv) import Options.Applicative @@ -29,10 +32,13 @@ main = execParser parser >>= listPath parser = info (helper <*> options) $ fullDesc <> progDesc "List directories in your PATH" +getEnv :: String -> IO String +getEnv = liftM (fromMaybe "") . lookupEnv + listPath :: Options -> IO () listPath options = do - val <- Environment.getEnv $ name options - mapM_ printPath $ Environment.splitPaths val + val <- getEnv $ name options + mapM_ printPath $ Environment.pathSplit val where printPath p = do exists <- doesDirectoryExist p diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs index d85a7f4..e04a67b 100644 --- a/apps/RemovePath.hs +++ b/apps/RemovePath.hs @@ -42,14 +42,14 @@ main = execParser parser >>= removePath removePath :: Options -> IO () removePath options = do let varName = name options - userVal <- Environment.queryFromRegistry Environment.CurrentUserEnvironment varName - let userValParts = Environment.splitPaths userVal + userVal <- Environment.query Environment.CurrentUser varName + let userValParts = Environment.pathSplit userVal let newUserValParts = filter (flip notElem $ paths options) userValParts when (length userValParts /= length newUserValParts) $ do - Environment.saveToRegistryWithPrompt Environment.CurrentUserEnvironment varName $ Environment.joinPaths newUserValParts + Environment.engraveWithPrompt Environment.CurrentUser varName $ Environment.pathJoin newUserValParts when (global options) $ do - globalVal <- Environment.queryFromRegistry Environment.AllUsersEnvironment varName - let globalValParts = Environment.splitPaths globalVal + globalVal <- Environment.query Environment.AllUsers varName + let globalValParts = Environment.pathSplit globalVal let newGlobalValParts = filter (flip notElem $ paths options) globalValParts when (length globalValParts /= length newGlobalValParts) $ do - Environment.saveToRegistryWithPrompt Environment.AllUsersEnvironment varName $ Environment.joinPaths newGlobalValParts + Environment.engraveWithPrompt Environment.AllUsers varName $ Environment.pathJoin newGlobalValParts diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs index d3439ae..fad7526 100644 --- a/apps/SetEnv.hs +++ b/apps/SetEnv.hs @@ -39,7 +39,7 @@ main = execParser parser >>= setEnv fullDesc <> progDesc "Set environment variables" setEnv :: Options -> IO () -setEnv options = Environment.saveToRegistryWithPrompt env (name options) (value options) +setEnv options = Environment.engraveWithPrompt env (name options) (value options) where - env | global options = Environment.AllUsersEnvironment - | otherwise = Environment.CurrentUserEnvironment + env | global options = Environment.AllUsers + | otherwise = Environment.CurrentUser diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs index bf7ad93..6fa2f2c 100644 --- a/apps/UnsetEnv.hs +++ b/apps/UnsetEnv.hs @@ -34,7 +34,7 @@ main = execParser parser >>= unsetEnv fullDesc <> progDesc "Unset environment variables" unsetEnv :: Options -> IO () -unsetEnv options = Environment.wipeFromRegistryWithPrompt env $ name options +unsetEnv options = Environment.wipeWithPrompt env $ name options where - env | global options = Environment.AllUsersEnvironment - | otherwise = Environment.CurrentUserEnvironment + env | global options = Environment.AllUsers + | otherwise = Environment.CurrentUser 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) -- cgit v1.2.3