Support multi line interpreter directive comments

doc/GUIDE.md

@@ -1356,6 +1356,8 @@ instead of creating an entire Cabal package for it. You can use `stack exec
 ghc` or `stack exec runghc` for that. As simple helpers, we also provide the
 `stack ghc` and `stack runghc` commands, for these common cases.
 
+## script interpreter
+
 stack also offers a very useful feature for running files: a script
 interpreter. For too long have Haskellers felt shackled to bash or Python
 because it's just too hard to create reusable source-only Haskell scripts.
@@ -1382,19 +1384,43 @@ Using resolver: lts-3.2 specified on command line
 Hello World!
 ```
 
-If you're on Windows: you can run `stack turtle.hs` instead of `./turtle.hs`.
-
-The first line is the usual "shebang" to use stack as a script interpreter. The
-second line, which is required, provides additional options to stack (due to
-the common limitation of the "shebang" line only being allowed a single
-argument). In this case, the options tell stack to use the lts-3.2 resolver,
-automatically install GHC if it is not already installed, and ensure the turtle
-package is available.
-
 The first run can take a while (as it has to download GHC if necessary and build
 dependencies), but subsequent runs are able to reuse everything already built,
 and are therefore quite fast.
 
+The first line in the source file is the usual "shebang" to use stack as a
+script interpreter. The second line, which is required, is a Haskell comment
+providing additional options to stack (due to the common limitation of the
+"shebang" line only being allowed a single argument). In this case, the options
+tell stack to use the lts-3.2 resolver, automatically install GHC if it is not
+already installed, and ensure the turtle package is available.
+
+If you're on Windows: you can run `stack turtle.hs` instead of `./turtle.hs`.
+The shebang line is not required in that case.
+
+The stack comment must specify a single valid stack command line, starting with
+`stack` as the command followed by the stack options to use for executing
+this file. The comment must always be on the line immediately following the
+shebang line when the shebang line is present otherwise it must be the first
+line in the file. The comment must always start in the first column of the line.
+
+When many options are needed a block style comment may be more convenient to
+split the command on multiple lines for better readability. Here is an example
+of a multi line block comment:
+
+```
+  #!/usr/bin/env stack
+  {- stack
+    --verbosity silent
+    --resolver lts-3.2
+    --install-ghc
+    runghc
+    --package turtle
+  -}
+```
+You can use the `--verbosity silent` option to suppress the informational
+output generated by stack which may be undesirable in a script context.
+
 ## Finding project configs, and the implicit global
 
 Whenever you run something with stack, it needs a stack.yaml project file. The

src/Data/Attoparsec/Args.hs

@@ -1,5 +1,56 @@
 {-# LANGUAGE OverloadedStrings #-}
--- | Parsing argument-like things.
+{- |  This module implements the following:
+
+    * Parsing of command line arguments for the stack command
+    * Parsing of additional arguments embedded in a comment when stack is
+      invoked as a script interpreter
+
+  ===Specifying arguments in script interpreter mode
+  @/stack/@ can execute a Haskell source file using @/runghc/@ and if required
+  it can also install and setup the compiler and any package dependencies
+  automatically.
+
+  For using a Haskell source file as an executable script on a Unix like OS,
+  the first line of the file must specify @stack@ as the interpreter using a
+  shebang directive e.g.
+
+  > #!/usr/bin/env stack
+
+  Additional arguments can be specified in a haskell comment following the
+  @#!@ line. The contents inside the comment must be a single valid stack
+  command line, starting with @stack@ as the command and followed by the
+  options to use for executing this file.
+
+  The comment must be on the line immediately following the @#!@ line. The
+  comment must start in the first column of the line. When using a block style
+  comment the command can be split on multiple lines.
+
+  Here is an example of a single line comment:
+
+  > #!/usr/bin/env stack
+  > -- stack --resolver lts-3.14 --install-ghc runghc --package random
+
+  Here is an example of a multi line block comment:
+
+@
+  #!\/usr\/bin\/env stack
+  {\- stack
+    --verbosity silent
+    --resolver lts-3.14
+    --install-ghc
+    runghc
+    --package random
+    --package system-argv0
+  -\}
+@
+
+  When the @#!@ line is not present, the file can still be executed
+  using @stack \<file name\>@ command if the file starts with a valid stack
+  interpreter comment. This can be used to execute the file on Windows for
+  example.
+
+  Nested block comments are not supported.
+-}
 
 module Data.Attoparsec.Args
     ( EscapingMode(..)
@@ -11,14 +62,12 @@ module Data.Attoparsec.Args
 import           Control.Applicative
 import           Data.Attoparsec.Text ((<?>))
 import qualified Data.Attoparsec.Text as P
-import           Data.Attoparsec.Types (Parser)
-import           Data.ByteString (ByteString)
-import qualified Data.ByteString as S
+import           Data.Attoparsec.Types (Parser, IResult(..))
 import           Data.Conduit
 import qualified Data.Conduit.Binary as CB
-import qualified Data.Conduit.List as CL
-import           Data.Text (Text)
-import           Data.Text.Encoding (decodeUtf8')
+import           Data.Conduit.Text(decodeUtf8)
+import           Data.Char (isSpace)
+import           Data.Text (Text, pack)
 import           System.Directory (doesFileExist)
 import           System.Environment (getArgs, withArgs)
 import           System.IO (IOMode (ReadMode), withBinaryFile)
@@ -48,15 +97,41 @@ argsParser mode = many (P.skipSpace *> (quoted <|> unquoted)) <*
     nonquote = P.satisfy (not . (=='"'))
     naked = P.satisfy (not . flip elem ("\" " :: String))
 
+-- | Parser to extract the stack command line embedded inside a comment
+-- after validating the placement and formatting rules for a valid
+-- interpreter specification.
+
+interpParser :: String -> Parser Text String
+interpParser progName = P.option "" sheBangLine *> interpComment
+  where
+    sheBangLine =   P.string "#!"
+                 *> P.manyTill P.anyChar P.endOfLine
+
+    commentStart str =   P.string str
+                      *> P.skipSpace
+                      *> P.string (pack progName)
+                      *> P.space
+
+    -- Treat newlines as spaces inside the block comment
+    anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c
+                            in P.satisfyWith normalizeSpace $ const True
+
+    comment start end =   commentStart start
+                       *> P.manyTill anyCharNormalizeSpace end
+
+    lineComment =  comment "--" P.endOfLine
+    blockComment = comment "{-" (P.string "-}" <?> "unterminated block comment")
+    interpComment = lineComment <|> blockComment
+
 -- | Use 'withArgs' on result of 'getInterpreterArgs'.
 withInterpreterArgs :: String -> ([String] -> Bool -> IO a) -> IO a
 withInterpreterArgs progName inner = do
     (args, isInterpreter) <- getInterpreterArgs progName
     withArgs args $ inner args isInterpreter
 
--- | Check if command-line looks like it's being used as a script interpreter,
--- and if so look for a @-- progName ...@ comment that contains additional
--- arguments.
+-- | Extract stack arguments from a correctly placed and correctly formatted
+-- comment when it is being used as an interpreter
+
 getInterpreterArgs :: String -> IO ([String], Bool)
 getInterpreterArgs progName = do
     args0 <- getArgs
@@ -68,31 +143,27 @@ getInterpreterArgs progName = do
                     margs <-
                         withBinaryFile x ReadMode $ \h ->
                         CB.sourceHandle h
-                            $= CB.lines
-                            $= CL.map killCR
+                            =$= decodeUtf8
                             $$ sinkInterpreterArgs progName
                     return $ case margs of
                         Nothing -> (args0, True)
                         Just args -> (args ++ "--" : args0, True)
                 else return (args0, False)
         _ -> return (args0, False)
-  where
-    killCR bs
-        | S.null bs || S.last bs /= 13 = bs
-        | otherwise = S.init bs
 
-sinkInterpreterArgs :: Monad m => String -> Sink ByteString m (Maybe [String])
+sinkInterpreterArgs :: Monad m => String -> Sink Text m (Maybe [String])
 sinkInterpreterArgs progName =
-    await >>= maybe (return Nothing) checkShebang
+        await
+      >>= maybe (return Nothing) parseCommand
+      >>= maybe (return Nothing) parseArgs'
   where
-    checkShebang bs
-        | "#!" `S.isPrefixOf` bs = fmap (maybe Nothing parseArgs') await
-        | otherwise = return (parseArgs' bs)
-
-    parseArgs' bs =
-        case decodeUtf8' bs of
-            Left _ -> Nothing
-            Right t ->
-                case P.parseOnly (argsParser Escaping) t of
-                    Right ("--":progName':rest) | progName' == progName -> Just rest
-                    _ -> Nothing
+    parseCommand = continueParse . (P.parse $ interpParser progName)
+
+    continueParse (Done _ r)   = return (Just (pack r))
+    continueParse (Fail _ _ _) = return Nothing
+    continueParse (Partial k)  =   await
+                                 >>= maybe (return Nothing) (continueParse . k)
+
+    parseArgs' txt = case P.parseOnly (argsParser Escaping) txt of
+                        Right args -> return $ Just args
+                        _ -> return Nothing