From b20d44c618f370a1998c70dd5708d9bbe4ed1c80 Mon Sep 17 00:00:00 2001
From: Egor Tensin <Egor.Tensin@gmail.com>
Date: Sun, 26 Mar 2017 19:03:03 +0300
Subject: rename directories

---
 src/WindowsEnv/Environment.hs | 79 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 src/WindowsEnv/Environment.hs

(limited to 'src/WindowsEnv/Environment.hs')

diff --git a/src/WindowsEnv/Environment.hs b/src/WindowsEnv/Environment.hs
new file mode 100644
index 0000000..8bfb449
--- /dev/null
+++ b/src/WindowsEnv/Environment.hs
@@ -0,0 +1,79 @@
+-- |
+-- Description : High-level environment variables management functions
+-- Copyright   : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com>
+-- License     : MIT
+-- Maintainer  : Egor.Tensin@gmail.com
+-- Stability   : experimental
+-- Portability : Windows-only
+--
+-- High-level functions for reading and writing Windows environment variables.
+
+module WindowsEnv.Environment
+    ( Profile(..)
+    , profileKeyPath
+
+    , VarName
+    , VarValue
+    , query
+    , engrave
+    , engraveForce
+    , wipe
+
+    , pathJoin
+    , pathSplit
+    ) where
+
+import Control.Monad.Trans.Class  (lift)
+import Control.Monad.Trans.Except (ExceptT(..))
+import Data.List       (intercalate)
+import Data.List.Split (splitOn)
+
+import qualified WindowsEnv.Registry as Registry
+import           WindowsEnv.Utils    (notifyEnvironmentUpdate)
+
+data Profile = CurrentUser
+             | AllUsers
+             deriving (Eq, Show)
+
+profileKeyPath :: Profile -> Registry.KeyPath
+profileKeyPath CurrentUser = Registry.KeyPath Registry.CurrentUser ["Environment"]
+profileKeyPath AllUsers    = Registry.KeyPath Registry.LocalMachine
+    [ "SYSTEM"
+    , "CurrentControlSet"
+    , "Control"
+    , "Session Manager"
+    , "Environment"
+    ]
+
+type VarName  = String
+type VarValue = String
+
+query :: Profile -> VarName -> ExceptT IOError IO VarValue
+query profile name = Registry.getExpandedString (profileKeyPath profile) name
+
+engrave :: Profile -> VarName -> VarValue -> ExceptT IOError IO ()
+engrave profile name value = do
+    ret <- Registry.setStringPreserveType (profileKeyPath profile) name value
+    lift notifyEnvironmentUpdate
+    return ret
+
+engraveForce :: Profile -> VarName -> VarValue -> ExceptT IOError IO ()
+engraveForce profile name value = do
+    ret <- Registry.setString (profileKeyPath profile) name value
+    lift notifyEnvironmentUpdate
+    return ret
+
+wipe :: Profile -> VarName -> ExceptT IOError IO ()
+wipe profile name = do
+    ret <- Registry.deleteValue (profileKeyPath profile) name
+    lift notifyEnvironmentUpdate
+    return ret
+
+pathSep :: VarValue
+pathSep = ";"
+
+pathSplit :: VarValue -> [VarValue]
+pathSplit = filter (not . null) . splitOn pathSep
+
+pathJoin :: [VarValue] -> VarValue
+pathJoin = intercalate pathSep . filter (not . null)
-- 
cgit v1.2.3