diff options
author | Egor Tensin <Egor.Tensin@gmail.com> | 2016-11-10 15:18:30 +0300 |
---|---|---|
committer | Egor Tensin <Egor.Tensin@gmail.com> | 2016-11-10 15:18:30 +0300 |
commit | 0d8b7efe4d74aa59513790da795ac4fde21be79b (patch) | |
tree | 8a60217b6b8ac2c23e90dcb71df457c03d3c5acd /apps | |
parent | README update (diff) | |
download | windows-env-0d8b7efe4d74aa59513790da795ac4fde21be79b.tar.gz windows-env-0d8b7efe4d74aa59513790da795ac4fde21be79b.zip |
safer registry access routines
+ use patched Win32.
Diffstat (limited to '')
-rw-r--r-- | apps/AddPath.hs | 15 | ||||
-rw-r--r-- | apps/PromptMessage.hs | 13 | ||||
-rw-r--r-- | apps/RemovePath.hs | 34 | ||||
-rw-r--r-- | apps/SetEnv.hs | 2 |
4 files changed, 35 insertions, 29 deletions
diff --git a/apps/AddPath.hs b/apps/AddPath.hs index 5fba7ce..9f9a5b1 100644 --- a/apps/AddPath.hs +++ b/apps/AddPath.hs @@ -6,9 +6,9 @@ module Main (main) where -import Control.Monad (void, when) -import Data.List (union) -import Data.Maybe (fromMaybe) +import Control.Monad (void, when) +import Data.List (union) +import System.IO.Error (ioError, isDoesNotExistError) import Options.Applicative import qualified Windows.Environment as Env @@ -52,8 +52,8 @@ main = execParser parser >>= addPath addPath :: Options -> IO () addPath options = do - oldValue <- Env.query profile varName - let oldPaths = Env.pathSplit $ fromMaybe "" oldValue + oldValue <- Env.query profile varName >>= emptyIfNotFound + let oldPaths = Env.pathSplit oldValue let newPaths = oldPaths `union` pathsToAdd when (length oldPaths /= length newPaths) $ do let newValue = Env.pathJoin newPaths @@ -72,3 +72,8 @@ addPath options = do | otherwise = Env.CurrentUser skipPrompt = optYes options + + emptyIfNotFound (Left e) + | isDoesNotExistError e = return "" + | otherwise = ioError e + emptyIfNotFound (Right s) = return s diff --git a/apps/PromptMessage.hs b/apps/PromptMessage.hs index b02c0a2..27851cf 100644 --- a/apps/PromptMessage.hs +++ b/apps/PromptMessage.hs @@ -9,26 +9,23 @@ module PromptMessage , wipeMessage ) where -import Data.Maybe (isJust) import Text.Printf (printf) import qualified Windows.Environment as Env -engraveMessage :: Env.Profile -> Env.VarName -> Maybe Env.VarValue -> Env.VarValue -> String +engraveMessage :: Env.Profile -> Env.VarName -> Env.VarValue -> Env.VarValue -> String engraveMessage profile name oldValue newValue = descriptionMsg ++ oldValueMsg ++ newValueMsg where profileKey = Env.profileKeyPath profile - descriptionMsg = printf "Saving variable '%s' to '%s'...\n" name profileKey + descriptionMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey) - oldValueMsg = maybe "" (printf "\tOld value: %s\n") oldValue - newValueMsg - | isJust oldValue = printf "\tNew value: %s\n" newValue - | otherwise = printf "\tValue: %s\n" newValue + oldValueMsg = printf "\tOld value: %s\n" oldValue + newValueMsg = printf "\tNew value: %s\n" newValue wipeMessage :: Env.Profile -> Env.VarName -> String wipeMessage profile name = - printf "Deleting variable '%s' from '%s'...\n" name profileKey + printf "Deleting variable '%s' from '%s'...\n" name (show profileKey) where profileKey = Env.profileKeyPath profile diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs index 1c8ee51..2956517 100644 --- a/apps/RemovePath.hs +++ b/apps/RemovePath.hs @@ -6,9 +6,9 @@ module Main (main) where -import Control.Monad (void, when) -import Data.List ((\\)) -import Data.Maybe (fromJust, isJust) +import Control.Monad (void, when) +import Data.List ((\\)) +import System.IO.Error (ioError, isDoesNotExistError) import Options.Applicative import qualified Windows.Environment as Env @@ -63,15 +63,19 @@ removePath options = do skipPrompt = optYes options - removePathFrom profile = do - oldValue <- Env.query profile varName - when (isJust oldValue) $ do - let oldPaths = Env.pathSplit $ fromJust oldValue - let newPaths = oldPaths \\ pathsToRemove - when (length oldPaths /= length newPaths) $ do - let newValue = Env.pathJoin newPaths - let promptAnd = if skipPrompt - then withoutPrompt - else withPrompt $ engraveMessage profile varName oldValue newValue - let engrave = Env.engrave profile varName newValue - void $ promptAnd engrave + removePathFrom profile = Env.query profile varName >>= either ignoreMissing (doRemovePathFrom profile) + + ignoreMissing e + | isDoesNotExistError e = return () + | otherwise = ioError e + + doRemovePathFrom profile oldValue = do + let oldPaths = Env.pathSplit oldValue + let newPaths = oldPaths \\ pathsToRemove + when (length oldPaths /= length newPaths) $ do + let newValue = Env.pathJoin newPaths + let promptAnd = if skipPrompt + then withoutPrompt + else withPrompt $ engraveMessage profile varName oldValue newValue + let engrave = Env.engrave profile varName newValue + void $ promptAnd engrave diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs index 14c23ae..96ef7b1 100644 --- a/apps/SetEnv.hs +++ b/apps/SetEnv.hs @@ -61,6 +61,6 @@ setEnv options = void $ promptAnd engrave skipPrompt = optYes options promptAnd | skipPrompt = withoutPrompt - | otherwise = withPrompt $ engraveMessage profile varName Nothing varValue + | otherwise = withPrompt $ engraveMessage profile varName "" varValue engrave = Env.engrave profile varName varValue |