From fd16fa9570f8885b36cbabb07ee8b7f58f3dea85 Mon Sep 17 00:00:00 2001
From: Brian McKenna <brian@brianmckenna.org>
Date: Fri, 1 Jul 2016 22:10:29 +1000
Subject: [PATCH] Allow global Stack arguments with a script

Stack has support for running Haskell scripts directly, when you pass a
filename as an argument.

Previously this worked by having a fallback: if any argument couldn't be
parsed as a valid option, check if the first argument was a file.

Sadly this broke for cases such as:

    stack --nix example.hs

And this means something different:

    stack example.hs --nix

Now Stack will split the arguments into two:

1. All arguments until the first existing file
2. The first existing file and all arguments afterwards

So the above example gets parsed as:

1. `["--nix"]`
2. `["example.hs"]`

The first section will be reparsed as options. The second section will
be used like it was previously.

This fixes the specific case of running interpreter scripts when having
the Nix option enabled globally. Stack would correctly start a
nix-shell. A nix-shell respawns Stack with some extra global
arguments (extra-lib-dirs and extra-include-dirs) but Stack would treat
them as file arguments, because just one of the arguments (the script)
was a file.
---
 src/main/Main.hs | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/src/main/Main.hs b/src/main/Main.hs
index 8aba5e148d..a26ce648b9 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -498,18 +498,32 @@ interpreterHandler
   -> ParserFailure ParserHelp
   -> IO (GlobalOptsMonoid, (GlobalOpts -> IO (), t))
 interpreterHandler args f = do
-  isFile <- D.doesFileExist file
-  if isFile
-  then runInterpreterCommand file
-  else parseResultHandler (errorCombine (noSuchFile file))
+  -- args can include top-level config such as --extra-lib-dirs=... (set by
+  -- nix-shell) - we need to find the first argument which is a file, everything
+  -- afterwards is an argument to the script, everything before is an argument
+  -- to Stack
+  (stackArgs, fileArgs) <- spanM (fmap not . D.doesFileExist) args
+  case fileArgs of
+    (file:fileArgs') -> runInterpreterCommand file stackArgs fileArgs'
+    [] -> parseResultHandler (errorCombine (noSuchFile firstArg))
   where
-    file = head args
+    firstArg = head args
 
-    -- if the filename contains a path separator then we know that it is not a
-    -- command it is a file to be interpreted. In that case we only show the
+    spanM _ [] = return ([], [])
+    spanM p xs@(x:xs') = do
+      r <- p x
+      if r
+      then do
+        (ys, zs) <- spanM p xs'
+        return (x:ys, zs)
+      else
+        return ([], xs)
+
+    -- if the first argument contains a path separator then it might be a file,
+    -- or a Stack option referencing a file. In that case we only show the
     -- interpreter error message and exclude the command related error messages.
     errorCombine =
-      if elem pathSeparator file
+      if elem pathSeparator firstArg
       then overrideErrorHelp
       else vcatErrorHelp
 
@@ -520,11 +534,11 @@ interpreterHandler args f = do
     noSuchFile name = errorHelp $ stringChunk
       ("File does not exist or is not a regular file `" ++ name ++ "'")
 
-    runInterpreterCommand path = do
+    runInterpreterCommand path stackArgs fileArgs = do
       progName <- getProgName
       iargs <- getInterpreterArgs path
       let parseCmdLine = commandLineHandler progName True
-      let cmdArgs = iargs ++ "--" : args
+      let cmdArgs = stackArgs ++ iargs ++ "--" : path : fileArgs
        -- TODO show the command in verbose mode
        -- hPutStrLn stderr $ unwords $
        --   ["Running", "[" ++ progName, unwords cmdArgs ++ "]"]