refactoring

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