blob: 2b532585f2bc9e209fe1e0d1c19d524942884320 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
{-
- 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 Environment
( saveToRegistry
, saveToRegistryWithPrompt
, queryFromRegistry
, wipeFromRegistry
, wipeFromRegistryWithPrompt
, getEnv
, splitPaths
, joinPaths
, RegistryBasedEnvironment(..)
) 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 qualified Registry
import qualified Utils (promptToContinue)
data RegistryBasedEnvironment
= CurrentUserEnvironment
| AllUsersEnvironment
deriving (Eq, Show)
registrySubKeyPath :: RegistryBasedEnvironment -> String
registrySubKeyPath CurrentUserEnvironment = "Environment"
registrySubKeyPath AllUsersEnvironment = "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
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 = Registry.setString (registryKey env) (registrySubKeyPath env)
saveToRegistryWithPrompt :: RegistryBasedEnvironment -> String -> String -> IO ()
saveToRegistryWithPrompt env name value = do
putStrLn $ "Saving variable '" ++ name ++ "' to '" ++ registryKeyPath env ++ "'..."
oldValue <- queryFromRegistry env name
putStrLn $ "\tOld value: " ++ oldValue
putStrLn $ "\tNew value: " ++ value
agreed <- Utils.promptToContinue
when agreed $ saveToRegistry env name value
queryFromRegistry :: RegistryBasedEnvironment -> String -> IO String
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 (Registry.delValue (registryKey env) (registrySubKeyPath env) name) ignoreIfDoesNotExist
where
ignoreIfDoesNotExist :: IOError -> IO ()
ignoreIfDoesNotExist e = if isDoesNotExistError e then return () else ioError e
wipeFromRegistryWithPrompt :: RegistryBasedEnvironment -> String -> IO ()
wipeFromRegistryWithPrompt 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
pathSep :: String
pathSep = ";"
splitPaths :: String -> [String]
splitPaths = filter (not . null) . splitOn pathSep
joinPaths :: [String] -> String
joinPaths = intercalate pathSep . filter (not . null)
|
