1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE OverloadedStrings #-} 3{- | This module implements parsing of additional arguments embedded in a 4 comment when stack is invoked as a script interpreter 5 6 ===Specifying arguments in script interpreter mode 7 @/stack/@ can execute a Haskell source file using @/runghc/@ and if required 8 it can also install and setup the compiler and any package dependencies 9 automatically. 10 11 For using a Haskell source file as an executable script on a Unix like OS, 12 the first line of the file must specify @stack@ as the interpreter using a 13 shebang directive e.g. 14 15 > #!/usr/bin/env stack 16 17 Additional arguments can be specified in a haskell comment following the 18 @#!@ line. The contents inside the comment must be a single valid stack 19 command line, starting with @stack@ as the command and followed by the 20 options to use for executing this file. 21 22 The comment must be on the line immediately following the @#!@ line. The 23 comment must start in the first column of the line. When using a block style 24 comment the command can be split on multiple lines. 25 26 Here is an example of a single line comment: 27 28 > #!/usr/bin/env stack 29 > -- stack --resolver lts-3.14 --install-ghc runghc --package random 30 31 Here is an example of a multi line block comment: 32 33@ 34 #!\/usr\/bin\/env stack 35 {\- stack 36 --resolver lts-3.14 37 --install-ghc 38 runghc 39 --package random 40 -\} 41@ 42 43 When the @#!@ line is not present, the file can still be executed 44 using @stack \<file name\>@ command if the file starts with a valid stack 45 interpreter comment. This can be used to execute the file on Windows for 46 example. 47 48 Nested block comments are not supported. 49-} 50 51module Data.Attoparsec.Interpreter 52 ( interpreterArgsParser -- for unit tests 53 , getInterpreterArgs 54 ) where 55 56import Data.Attoparsec.Args 57import Data.Attoparsec.Text ((<?>)) 58import qualified Data.Attoparsec.Text as P 59import Data.Char (isSpace) 60import Conduit 61import Data.Conduit.Attoparsec 62import Data.List (intercalate) 63import Data.Text (pack) 64import Stack.Prelude 65import System.FilePath (takeExtension) 66import System.IO (hPutStrLn) 67 68-- | Parser to extract the stack command line embedded inside a comment 69-- after validating the placement and formatting rules for a valid 70-- interpreter specification. 71interpreterArgsParser :: Bool -> String -> P.Parser String 72interpreterArgsParser isLiterate progName = P.option "" sheBangLine *> interpreterComment 73 where 74 sheBangLine = P.string "#!" 75 *> P.manyTill P.anyChar P.endOfLine 76 77 commentStart psr = (psr <?> (progName ++ " options comment")) 78 *> P.skipSpace 79 *> (P.string (pack progName) <?> show progName) 80 81 -- Treat newlines as spaces inside the block comment 82 anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c 83 in P.satisfyWith normalizeSpace $ const True 84 85 comment start end = commentStart start 86 *> ((end >> return "") 87 <|> (P.space *> (P.manyTill anyCharNormalizeSpace end <?> "-}"))) 88 89 horizontalSpace = P.satisfy P.isHorizontalSpace 90 91 lineComment = comment "--" (P.endOfLine <|> P.endOfInput) 92 literateLineComment = comment 93 (">" *> horizontalSpace *> "--") 94 (P.endOfLine <|> P.endOfInput) 95 blockComment = comment "{-" (P.string "-}") 96 97 literateBlockComment = 98 (">" *> horizontalSpace *> "{-") 99 *> P.skipMany (("" <$ horizontalSpace) <|> (P.endOfLine *> ">")) 100 *> (P.string (pack progName) <?> progName) 101 *> P.manyTill' (P.satisfy (not . P.isEndOfLine) 102 <|> (' ' <$ (P.endOfLine *> ">" <?> ">"))) "-}" 103 104 interpreterComment = if isLiterate 105 then literateLineComment <|> literateBlockComment 106 else lineComment <|> blockComment 107 108-- | Extract stack arguments from a correctly placed and correctly formatted 109-- comment when it is being used as an interpreter 110getInterpreterArgs :: String -> IO [String] 111getInterpreterArgs file = do 112 eArgStr <- withSourceFile file parseFile 113 case eArgStr of 114 Left err -> handleFailure $ decodeError err 115 Right str -> parseArgStr str 116 where 117 parseFile src = 118 runConduit 119 $ src 120 .| decodeUtf8C 121 .| sinkParserEither (interpreterArgsParser isLiterate stackProgName) 122 123 isLiterate = takeExtension file == ".lhs" 124 125 -- FIXME We should print anything only when explicit verbose mode is 126 -- specified by the user on command line. But currently the 127 -- implementation does not accept or parse any command line flags in 128 -- interpreter mode. We can only invoke the interpreter as 129 -- "stack <file name>" strictly without any options. 130 stackWarn s = hPutStrLn stderr $ stackProgName ++ ": WARNING! " ++ s 131 132 handleFailure err = do 133 mapM_ stackWarn (lines err) 134 stackWarn "Missing or unusable stack options specification" 135 stackWarn "Using runghc without any additional stack options" 136 return ["runghc"] 137 138 parseArgStr str = 139 case P.parseOnly (argsParser Escaping) (pack str) of 140 Left err -> handleFailure ("Error parsing command specified in the " 141 ++ "stack options comment: " ++ err) 142 Right [] -> handleFailure "Empty argument list in stack options comment" 143 Right args -> return args 144 145 decodeError e = 146 case e of 147 ParseError ctxs _ (Position line col _) -> 148 if null ctxs 149 then "Parse error" 150 else ("Expecting " ++ intercalate " or " ctxs) 151 ++ " at line " ++ show line ++ ", column " ++ show col 152 DivergentParser -> "Divergent parser" 153