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