From 82e68beceb15e4cdd4679f0e0514148719952075 Mon Sep 17 00:00:00 2001
From: Steve Baker <scsavtnk@gmail.com>
Date: Wed, 3 Feb 2021 17:28:26 +0100
Subject: [PATCH] Fix finding psa on Windows (#693)

In `getPurs` we were just using the standard `Directory.findExecutable`
to look for `psa`, forgetting to check for `psa.cmd` too. In windows
this was looking for `psa.exe`, which doesn't exist.

To help prevent this happening again, a self-written `findExecutable`
function in `Prelude` is added, instead of just exporting
`Directory.findExecutable`. This new version will always first check
for a `.cmd` version of the executable name on Windows.
---
 CHANGELOG.md         |  1 +
 src/Spago/Prelude.hs | 18 +++++++++++++++---
 src/Spago/RunEnv.hs  |  9 +--------
 3 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index d7807e458..651a76532 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 Other improvements:
 - Bump `dhall` dependency from 1.37.1 to 1.38.0 (#739)
+- Fix `psa` not being found on Windows (#740, #693)
 
 ## [0.19.0] - 2021-01-02
 
diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs
index 59f0c54b2..f4fe845d3 100644
--- a/src/Spago/Prelude.hs
+++ b/src/Spago/Prelude.hs
@@ -63,7 +63,7 @@ module Spago.Prelude
   , systemStrictWithErr
   , viewShell
   , findExecutableOrDie
-  , Directory.findExecutable
+  , findExecutable
 
   -- * Other
   , Dhall.Core.throws
@@ -81,6 +81,7 @@ import qualified Data.Text.Prettyprint.Doc.Render.Text as PrettyText
 import qualified Data.Time                             as Time
 import           Dhall                                 (Text)
 import qualified Dhall.Core
+import qualified Distribution.System                   as OS
 import qualified RIO
 import qualified System.FilePath                       as FilePath
 import qualified System.IO
@@ -246,11 +247,22 @@ pretty = PrettyText.renderStrict
   . Pretty.layoutPretty Pretty.defaultLayoutOptions
   . Pretty.pretty
 
+-- | Return the full path of the executable we're trying to call. On Windows we
+--   first try the `.cmd` version.
+findExecutable :: MonadIO m => String -> m (Maybe String)
+findExecutable x =
+  case OS.buildOS of
+    OS.Windows -> Directory.findExecutable (x <> ".cmd") >>= \case
+      Nothing -> Directory.findExecutable x
+      success -> pure success
+    _ -> Directory.findExecutable x
+
+
 -- | Return the full path of the executable we're trying to call,
 --   or die trying
 findExecutableOrDie :: HasLogFunc env => String -> RIO env Text
 findExecutableOrDie cmd = do
-  Directory.findExecutable cmd >>= \case
+  findExecutable cmd >>= \case
     Nothing -> die [ "Executable was not found in path: " <> displayShow cmd ]
     -- Note: we ignore the path and just return the input because the one we get
     -- here is absolute, and Windows doesn't seem to be able to deal with that.
@@ -276,4 +288,4 @@ logDebug, logInfo, logWarn, logError
 logDebug = liftLog RIO.logDebug
 logInfo = liftLog RIO.logInfo
 logWarn = liftLog RIO.logWarn
-logError = liftLog RIO.logError
\ No newline at end of file
+logError = liftLog RIO.logError
diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs
index 6a2d11c94..886b9ca66 100644
--- a/src/Spago/RunEnv.hs
+++ b/src/Spago/RunEnv.hs
@@ -3,7 +3,6 @@ module Spago.RunEnv where
 import Spago.Prelude
 import Spago.Env
 
-import qualified Data.Text as Text
 import qualified System.Environment  as Env
 import qualified Distribution.System as OS
 import qualified RIO
@@ -161,13 +160,7 @@ getPurs usePsa = do
     UsePsa -> findExecutable "psa" >>= \case
       Just _  -> pure "psa"
       Nothing -> pure "purs"
-  -- We first try this for Windows
-  PursCmd <$> case OS.buildOS of
-    OS.Windows -> do
-      findExecutable (pursCandidate <> ".cmd") >>= \case
-        Just _ -> pure (Text.pack pursCandidate <> ".cmd")
-        Nothing -> findExecutableOrDie pursCandidate
-    _ -> findExecutableOrDie pursCandidate
+  PursCmd <$> findExecutableOrDie pursCandidate
 
 getGit :: HasLogFunc env => RIO env GitCmd
 getGit = GitCmd <$> findExecutableOrDie "git"