aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/WindowsEnv/Environment.hs63
-rw-r--r--src/WindowsEnv/Registry.hs8
2 files changed, 46 insertions, 25 deletions
diff --git a/src/WindowsEnv/Environment.hs b/src/WindowsEnv/Environment.hs
index 4713df3..8060b14 100644
--- a/src/WindowsEnv/Environment.hs
+++ b/src/WindowsEnv/Environment.hs
@@ -16,7 +16,7 @@ module WindowsEnv.Environment
, VarName
, VarValue
- , expand
+
, query
, engrave
, engraveForce
@@ -24,6 +24,10 @@ module WindowsEnv.Environment
, pathJoin
, pathSplit
+
+ , expand
+ , ExpandedPath(..)
+ , pathSplitAndExpand
) where
import Control.Monad.Trans.Class (lift)
@@ -55,27 +59,8 @@ profileKeyPath AllUsers = Registry.KeyPath Registry.LocalMachine
type VarName = String
type VarValue = String
-#include "ccall.h"
-
--- ExpandEnvironmentStrings isn't provided by Win32 (as of version 2.4.0.0).
-
-foreign import WINDOWS_ENV_CCALL unsafe "Windows.h ExpandEnvironmentStringsW"
- c_ExpandEnvironmentStrings :: WinAPI.LPCTSTR -> WinAPI.LPTSTR -> WinAPI.DWORD -> IO WinAPI.ErrCode
-
-expand :: VarValue -> ExceptT IOError IO VarValue
-expand value = ExceptT $ catchIOError (Right <$> doExpand) (return . Left)
- where
- doExpandIn valuePtr bufferPtr bufferLength = do
- newBufferLength <- WinAPI.failIfZero "ExpandEnvironmentStringsW" $
- c_ExpandEnvironmentStrings valuePtr bufferPtr bufferLength
- let newBufferSize = (fromIntegral newBufferLength) * sizeOf (undefined :: WinAPI.TCHAR)
- if newBufferLength > bufferLength
- then allocaBytes newBufferSize $ \newBufferPtr -> doExpandIn valuePtr newBufferPtr newBufferLength
- else WinAPI.peekTString bufferPtr
- doExpand = WinAPI.withTString value $ \valuePtr -> doExpandIn valuePtr WinAPI.nullPtr 0
-
query :: Profile -> VarName -> ExceptT IOError IO VarValue
-query profile name = Registry.getString (profileKeyPath profile) name
+query profile name = Registry.getStringDoNotExpand (profileKeyPath profile) name
engrave :: Profile -> VarName -> VarValue -> ExceptT IOError IO ()
engrave profile name value = do
@@ -103,3 +88,39 @@ pathSplit = filter (not . null) . splitOn pathSep
pathJoin :: [VarValue] -> VarValue
pathJoin = intercalate pathSep . filter (not . null)
+
+#include "ccall.h"
+
+-- ExpandEnvironmentStrings isn't provided by Win32 (as of version 2.4.0.0).
+
+foreign import WINDOWS_ENV_CCALL unsafe "Windows.h ExpandEnvironmentStringsW"
+ c_ExpandEnvironmentStrings :: WinAPI.LPCTSTR -> WinAPI.LPTSTR -> WinAPI.DWORD -> IO WinAPI.ErrCode
+
+expand :: VarValue -> ExceptT IOError IO VarValue
+expand value = ExceptT $ catchIOError (Right <$> doExpand) (return . Left)
+ where
+ doExpandIn valuePtr bufferPtr bufferLength = do
+ newBufferLength <- WinAPI.failIfZero "ExpandEnvironmentStringsW" $
+ c_ExpandEnvironmentStrings valuePtr bufferPtr bufferLength
+ let newBufferSize = (fromIntegral newBufferLength) * sizeOf (undefined :: WinAPI.TCHAR)
+ if newBufferLength > bufferLength
+ then allocaBytes newBufferSize $ \newBufferPtr -> doExpandIn valuePtr newBufferPtr newBufferLength
+ else WinAPI.peekTString bufferPtr
+ doExpand = WinAPI.withTString value $ \valuePtr -> doExpandIn valuePtr WinAPI.nullPtr 0
+
+data ExpandedPath = ExpandedPath
+ { pathOriginal :: VarValue
+ , pathExpanded :: VarValue
+ } deriving (Eq, Show)
+
+pathSplitAndExpand :: VarValue -> ExceptT IOError IO [ExpandedPath]
+pathSplitAndExpand pathValue = do
+ expandedOnce <- expandOnce
+ zipWith ExpandedPath originalPaths <$>
+ if length expandedOnce == length originalPaths
+ then return expandedOnce
+ else expandEach
+ where
+ originalPaths = pathSplit pathValue
+ expandOnce = pathSplit <$> expand pathValue
+ expandEach = mapM expand originalPaths
diff --git a/src/WindowsEnv/Registry.hs b/src/WindowsEnv/Registry.hs
index 96a7627..f9e3cc7 100644
--- a/src/WindowsEnv/Registry.hs
+++ b/src/WindowsEnv/Registry.hs
@@ -30,7 +30,7 @@ module WindowsEnv.Registry
, getValue
, GetValueFlag(..)
, getType
- , getString
+ , getStringDoNotExpand
, setValue
, setString
@@ -252,10 +252,10 @@ getType keyPath valueName flags =
c_RegGetValue keyHandlePtr WinAPI.nullPtr valueNamePtr collapsedFlags valueTypePtr WinAPI.nullPtr WinAPI.nullPtr
toEnum . fromIntegral <$> peek valueTypePtr
where
- collapsedFlags = collapseGetValueFlags flags
+ collapsedFlags = collapseGetValueFlags $ DoNotExpand : flags
-getString :: IsKeyPath a => a -> ValueName -> ExceptT IOError IO String
-getString keyPath valueName = do
+getStringDoNotExpand :: IsKeyPath a => a -> ValueName -> ExceptT IOError IO String
+getStringDoNotExpand keyPath valueName = do
valueData <- getValue keyPath valueName [RestrictExpandableString, RestrictString]
return $ decodeString valueData