aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
-rw-r--r--app/ListPaths.hs25
-rw-r--r--src/WindowsEnv/Environment.hs63
-rw-r--r--src/WindowsEnv/Registry.hs8
3 files changed, 50 insertions, 46 deletions
diff --git a/app/ListPaths.hs b/app/ListPaths.hs
index 5834f11..4193ad6 100644
--- a/app/ListPaths.hs
+++ b/app/ListPaths.hs
@@ -9,7 +9,7 @@ module Main (main) where
import Control.Monad (filterM)
import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Control.Monad.Trans.Except (runExceptT)
import Data.Maybe (fromMaybe)
import System.Directory (doesDirectoryExist)
import System.Environment (lookupEnv)
@@ -63,23 +63,6 @@ main = execParser parser >>= listPaths
parser = info (helper <*> optionParser) $
fullDesc <> progDesc "List directories in your PATH"
-data ExpandedPath = ExpandedPath
- { pathOriginal :: WindowsEnv.VarValue
- , pathExpanded :: WindowsEnv.VarValue
- } deriving (Eq, Show)
-
-splitAndExpand :: WindowsEnv.VarValue -> ExceptT IOError IO [ExpandedPath]
-splitAndExpand pathValue = do
- expandedOnce <- expandOnce
- zipWith ExpandedPath originalPaths <$>
- if length expandedOnce == length originalPaths
- then return expandedOnce
- else expandEach
- where
- originalPaths = WindowsEnv.pathSplit pathValue
- expandOnce = WindowsEnv.pathSplit <$> WindowsEnv.expand pathValue
- expandEach = mapM WindowsEnv.expand originalPaths
-
listPaths :: Options -> IO ()
listPaths options = runExceptT doListPaths >>= either ioError return
where
@@ -91,10 +74,10 @@ listPaths options = runExceptT doListPaths >>= either ioError return
queryFrom Environment = lift $ fromMaybe "" <$> lookupEnv varName
queryFrom (Registry profile) = WindowsEnv.query profile varName
- filterPaths = filterM (shouldListPath whichPaths . pathExpanded)
+ filterPaths = filterM (shouldListPath whichPaths . WindowsEnv.pathExpanded)
doListPaths = do
- paths <- query >>= splitAndExpand
+ paths <- query >>= WindowsEnv.pathSplitAndExpand
lift $ do
pathsToPrint <- filterPaths paths
- mapM_ (putStrLn . pathOriginal) pathsToPrint
+ mapM_ (putStrLn . WindowsEnv.pathOriginal) pathsToPrint
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