{-# LANGUAGE OverloadedStrings #-}

-- | Module for updating environment variables. All functions take either 'HKLM' to modify the
--   variable for the machine, or 'HKCU' to modify for the user.
--
--   /Warning:/ If you are modifying PATH, make sure you use a special build of NSIS which can cope
--   with longer strings, or you will corrupt your users path.
module Development.NSIS.Plugins.EnvVarUpdate(
    getEnvVar, setEnvVar, deleteEnvVar,
    setEnvVarAppend, setEnvVarPrepend, setEnvVarRemove
    ) where

import Development.NSIS
import Development.NSIS.Plugins.WinMessages
import Control.Monad
import Data.String


resolve :: HKEY -> String
resolve :: HKEY -> String
resolve HKEY
h | HKEY
h HKEY -> HKEY -> Bool
forall a. Eq a => a -> a -> Bool
== HKEY
HKLM Bool -> Bool -> Bool
|| HKEY
h HKEY -> HKEY -> Bool
forall a. Eq a => a -> a -> Bool
== HKEY
HKEY_LOCAL_MACHINE = String
"SYSTEM/CurrentControlSet/Control/Session Manager/Environment"
          | HKEY
h HKEY -> HKEY -> Bool
forall a. Eq a => a -> a -> Bool
== HKEY
HKCU Bool -> Bool -> Bool
|| HKEY
h HKEY -> HKEY -> Bool
forall a. Eq a => a -> a -> Bool
== HKEY
HKEY_CURRENT_USER = String
"Environment"
          | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Development.NSIS.Plugins.EnvVarUpdate, must use either HKLM or HKCU, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HKEY -> String
forall a. Show a => a -> String
show HKEY
h


-- | Given a string, and a ; separated variable, remove the string from it if it is present.
remove :: Exp String -> Exp String -> Exp String
remove :: Exp String -> Exp String -> Exp String
remove Exp String
x Exp String
xs = Exp String -> (Exp String -> Exp String) -> Exp String
forall t a. Exp t -> (Exp t -> Action a) -> Action a
share Exp String
x ((Exp String -> Exp String) -> Exp String)
-> (Exp String -> Exp String) -> Exp String
forall a b. (a -> b) -> a -> b
$ \Exp String
x -> Exp String -> (Exp String -> Exp String) -> Exp String
forall t a. Exp t -> (Exp t -> Action a) -> Action a
share Exp String
xs ((Exp String -> Exp String) -> Exp String)
-> (Exp String -> Exp String) -> Exp String
forall a b. (a -> b) -> a -> b
$ \Exp String
xs -> do
    Exp String
xs <- Exp String -> Action (Exp String)
forall t. Exp t -> Action (Exp t)
mutable_ Exp String
xs
    Exp String
xs Exp String -> Exp String -> Action ()
forall t. Exp t -> Exp t -> Action ()
@= Exp String -> Exp String -> Exp String -> Exp String
strReplace (Exp String
";" Exp String -> Exp String -> Exp String
& Exp String
x Exp String -> Exp String -> Exp String
& Exp String
";") Exp String
";" Exp String
xs
    Exp Bool -> Action () -> Action ()
while ((Exp String
x Exp String -> Exp String -> Exp String
& Exp String
";") Exp String -> Exp String -> Exp Bool
`strIsPrefixOf` Exp String
xs) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String
xs Exp String -> Exp String -> Action ()
forall t. Exp t -> Exp t -> Action ()
@= Exp Int -> Exp String -> Exp String
strDrop (Exp String -> Exp Int
strLength Exp String
x Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
1) Exp String
xs
    Exp Bool -> Action () -> Action ()
while ((Exp String
";" Exp String -> Exp String -> Exp String
& Exp String
x) Exp String -> Exp String -> Exp Bool
`strIsSuffixOf` Exp String
xs) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String
xs Exp String -> Exp String -> Action ()
forall t. Exp t -> Exp t -> Action ()
@= Exp Int -> Exp String -> Exp String
strTake (Exp String -> Exp Int
strLength Exp String
xs Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
1 Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp String -> Exp Int
strLength Exp String
x) Exp String
xs
    Exp Bool -> Action () -> Action ()
iff_ (Exp String
x Exp String -> Exp String -> Exp Bool
forall a. Exp a -> Exp a -> Exp Bool
%== Exp String
xs) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String
xs Exp String -> Exp String -> Action ()
forall t. Exp t -> Exp t -> Action ()
@= Exp String
""
    Exp String
xs


-- | Set an environment variable by writing to the registry.
setEnvVar :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVar :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVar HKEY
h Exp String
key Exp String
val = do
    HKEY -> Exp String -> Exp String -> Exp String -> Action ()
writeRegExpandStr HKEY
h (String -> Exp String
forall a. IsString a => String -> a
fromString (String -> Exp String) -> String -> Exp String
forall a b. (a -> b) -> a -> b
$ HKEY -> String
resolve HKEY
h) Exp String
key (Exp String -> Exp String -> Exp String
strCheck (Exp String
"setting environment variable %" Exp String -> Exp String -> Exp String
& Exp String
key Exp String -> Exp String -> Exp String
& Exp String
"%") Exp String
val)
    Action (Exp Int) -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action (Exp Int) -> Action ()) -> Action (Exp Int) -> Action ()
forall a b. (a -> b) -> a -> b
$ [Attrib]
-> Exp Int -> Exp Int -> Exp Int -> Exp String -> Action (Exp Int)
forall a b.
[Attrib]
-> Exp Int -> Exp Int -> Exp a -> Exp b -> Action (Exp Int)
sendMessage [Int -> Attrib
Timeout Int
5000] Exp Int
forall {a}. Num a => a
hwnd_BROADCAST Exp Int
forall {a}. Num a => a
wm_WININICHANGE (Exp Int
0 :: Exp Int) (Exp String
"STR:Environment" :: Exp String)


-- | Read a variable from the registry. If you are not modifying the variable
--   you should use 'envVar' instead.
getEnvVar :: HKEY -> Exp String -> Exp String
getEnvVar :: HKEY -> Exp String -> Exp String
getEnvVar HKEY
h Exp String
key = Exp String -> Exp String -> Exp String
strCheck (Exp String
"reading environment variable %" Exp String -> Exp String -> Exp String
& Exp String
key Exp String -> Exp String -> Exp String
& Exp String
"%") (Exp String -> Exp String) -> Exp String -> Exp String
forall a b. (a -> b) -> a -> b
$ HKEY -> Exp String -> Exp String -> Exp String
readRegStr HKEY
h (String -> Exp String
forall a. IsString a => String -> a
fromString (String -> Exp String) -> String -> Exp String
forall a b. (a -> b) -> a -> b
$ HKEY -> String
resolve HKEY
h) Exp String
key


-- | Delete the environment variable in the registry.
deleteEnvVar :: HKEY -> Exp String -> Action ()
deleteEnvVar :: HKEY -> Exp String -> Action ()
deleteEnvVar HKEY
h Exp String
key = do
    HKEY -> Exp String -> Exp String -> Action ()
deleteRegValue HKEY
h (String -> Exp String
forall a. IsString a => String -> a
fromString (String -> Exp String) -> String -> Exp String
forall a b. (a -> b) -> a -> b
$ HKEY -> String
resolve HKEY
h) Exp String
key
    Action (Exp Int) -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action (Exp Int) -> Action ()) -> Action (Exp Int) -> Action ()
forall a b. (a -> b) -> a -> b
$ [Attrib]
-> Exp Int -> Exp Int -> Exp Int -> Exp String -> Action (Exp Int)
forall a b.
[Attrib]
-> Exp Int -> Exp Int -> Exp a -> Exp b -> Action (Exp Int)
sendMessage [Int -> Attrib
Timeout Int
5000] Exp Int
forall {a}. Num a => a
hwnd_BROADCAST Exp Int
forall {a}. Num a => a
wm_WININICHANGE (Exp Int
0 :: Exp Int) (Exp String
"STR:Environment" :: Exp String)


setEnvVarAppend :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarAppend :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarAppend HKEY
h Exp String
key Exp String
val = Exp String -> (Exp String -> Action ()) -> Action ()
forall t a. Exp t -> (Exp t -> Action a) -> Action a
share Exp String
val ((Exp String -> Action ()) -> Action ())
-> (Exp String -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \Exp String
val -> HKEY -> Exp String -> Exp String -> Action ()
setEnvVar HKEY
h Exp String
key (Exp String -> Action ()) -> Exp String -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String -> Exp String -> Exp String
remove Exp String
val (HKEY -> Exp String -> Exp String
getEnvVar HKEY
h Exp String
key) Exp String -> Exp String -> Exp String
& Exp String
";" Exp String -> Exp String -> Exp String
& Exp String
val

setEnvVarPrepend :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarPrepend :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarPrepend HKEY
h Exp String
key Exp String
val = Exp String -> (Exp String -> Action ()) -> Action ()
forall t a. Exp t -> (Exp t -> Action a) -> Action a
share Exp String
val ((Exp String -> Action ()) -> Action ())
-> (Exp String -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \Exp String
val -> HKEY -> Exp String -> Exp String -> Action ()
setEnvVar HKEY
h Exp String
key (Exp String -> Action ()) -> Exp String -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String
val Exp String -> Exp String -> Exp String
& Exp String
";" Exp String -> Exp String -> Exp String
& Exp String -> Exp String -> Exp String
remove Exp String
val (HKEY -> Exp String -> Exp String
getEnvVar HKEY
h Exp String
key)

setEnvVarRemove :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarRemove :: HKEY -> Exp String -> Exp String -> Action ()
setEnvVarRemove HKEY
h Exp String
key Exp String
val = HKEY -> Exp String -> Exp String -> Action ()
setEnvVar HKEY
h Exp String
key (Exp String -> Action ()) -> Exp String -> Action ()
forall a b. (a -> b) -> a -> b
$ Exp String -> Exp String -> Exp String
remove Exp String
val (Exp String -> Exp String) -> Exp String -> Exp String
forall a b. (a -> b) -> a -> b
$ HKEY -> Exp String -> Exp String
getEnvVar HKEY
h Exp String
key