Make sure augmentPathMap on windows is case insensitive

On windows, env vars are generally case-insensitive.
Due to 'type EnvVars = Map Text Text' augmentPathMap
assumes full uppercase "PATH" variable, which may lead
to surprising behavior if the current map
has a variable such as "Path".

This patch folds over the map and inserts any path
key as "PATH" on windows. That also means: if there
are multiple, the "last" one wins. There generally
isn't a sane solution if the input map already
has multiple path keys (how should they be merged,
which order?).

Fixes #234

rio/src/RIO/Process.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Interacting with external processes.
 --
@@ -190,7 +191,7 @@ data ProcessException
     | ExecutableNotFound String [FilePath]
     | ExecutableNotFoundAt FilePath
     | PathsInvalidInPath [FilePath]
-    deriving Typeable
+    deriving (Typeable, Eq)
 instance Show ProcessException where
     show NoPathFound = "PATH not found in ProcessContext"
     show (ExecutableNotFound name path) = concat
@@ -269,7 +270,7 @@ exeSearchPathL = processContextL.to pcPath
 --
 -- @since 0.0.3.0
 mkProcessContext :: MonadIO m => EnvVars -> m ProcessContext
-mkProcessContext tm' = do
+mkProcessContext (normalizePathEnv -> tm) = do
     ref <- newIORef Map.empty
     return ProcessContext
         { pcTextMap = tm
@@ -287,17 +288,21 @@ mkProcessContext tm' = do
         , pcWorkingDir = Nothing
         }
   where
-    -- Fix case insensitivity of the PATH environment variable on Windows.
-    tm
-        | isWindows = Map.fromList $ map (first T.toUpper) $ Map.toList tm'
-        | otherwise = tm'
     -- Default value for PATHTEXT on Windows versions after Windows XP. (The
     -- documentation of the default at
     -- https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/start
     -- is incomplete.)
     defaultPATHEXT = ".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC"
 
 
+-- Fix case insensitivity of the PATH environment variable on Windows,
+-- by forcing all keys full uppercase.
+normalizePathEnv :: EnvVars -> EnvVars
+normalizePathEnv env
+  | isWindows = Map.fromList $ map (first T.toUpper) $ Map.toList env
+  | otherwise = env
+
+
 -- | Reset the executable cache.
 --
 -- @since 0.0.3.0
@@ -654,7 +659,8 @@ exeExtensions = do
   pc <- view processContextL
   return $ pcExeExtensions pc
 
--- | Augment the PATH environment variable with the given extra paths.
+-- | Augment the PATH environment variable with the given extra paths,
+-- which are prepended (as in: they take precedence).
 --
 -- @since 0.0.3.0
 augmentPath :: [FilePath] -> Maybe Text -> Either ProcessException Text
@@ -670,7 +676,7 @@ augmentPath dirs mpath =
 --
 -- @since 0.0.3.0
 augmentPathMap :: [FilePath] -> EnvVars -> Either ProcessException EnvVars
-augmentPathMap dirs origEnv =
+augmentPathMap dirs (normalizePathEnv -> origEnv) =
   do path <- augmentPath dirs mpath
      return $ Map.insert "PATH" path origEnv
   where

rio/test/RIO/Prelude/ExtraSpec.hs

@@ -1,8 +1,16 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module RIO.Prelude.ExtraSpec (spec) where
 
 import RIO
+import RIO.Process
 import Test.Hspec
 
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import qualified System.FilePath as FP
+
 spec :: Spec
 spec = do
   describe "foldMapM" $ do
@@ -11,3 +19,25 @@ spec = do
           helper = pure . pure
       res <- foldMapM helper [1..10]
       res `shouldBe` [1..10]
+  describe "augmentPathMap" $ do
+    -- https://github.com/commercialhaskell/rio/issues/234
+    it "Doesn't duplicate PATH keys on windows" $ do
+      let pathKey :: T.Text
+#if WINDOWS
+          pathKey = "Path"
+#else
+          pathKey = "PATH"
+#endif
+          origEnv :: EnvVars
+          origEnv = Map.fromList [ ("foo", "3")
+                                 , ("bar", "baz")
+                                 , (pathKey, makePath ["/local/bin", "/usr/bin"])
+                                 ]
+      let res = second (fmap getPaths . Map.lookup "PATH") $ augmentPathMap ["/bin"] origEnv
+      res `shouldBe` Right (Just ["/bin", "/local/bin", "/usr/bin"])
+  where
+    makePath :: [T.Text] -> T.Text
+    makePath = T.intercalate (T.singleton FP.searchPathSeparator)
+
+    getPaths :: T.Text -> [T.Text]
+    getPaths = fmap T.pack . FP.splitSearchPath . T.unpack