Merge pull request #4257 from gallais/opts-ipkg

Not silently accepting invalid options in package files

Author: Ahmad Salim Al-Sibahi

src/Idris/CmdOptions.hs

@@ -10,7 +10,8 @@ Maintainer  : The Idris Community.
 
 module Idris.CmdOptions
   ( opt, getClient, getPkg, getPkgCheck, getPkgClean, getPkgMkDoc,
-    getPkgREPL, getPkgTest, getPort, getIBCSubDir, pureArgParser, runArgParser
+    getPkgREPL, getPkgTest, getPort, getIBCSubDir,
+    pureArgParser, execArgParserPure, runArgParser
   ) where
 
 import Idris.Info (getIdrisVersion)
@@ -72,10 +73,13 @@ runArgParser = do opts <- execParser $ info parser
                                         PP.empty,
                                         PP.indent 4 (PP.text "http://www.idris-lang.org/")]
 
+execArgParserPure :: [String] -> ParserResult [Opt]
+execArgParserPure args = preProcOpts <$> execParserPure (prefs idm) (info parser idm) args
+
 pureArgParser :: [String] -> [Opt]
-pureArgParser args = case getParseResult $ execParserPure (prefs idm) (info parser idm) args of
+pureArgParser args = case getParseResult (execArgParserPure args) of
   Just opts -> preProcOpts opts
-  Nothing -> []
+  Nothing   -> []
 
 parser :: Parser [Opt]
 parser = runA $ proc () -> do

src/Idris/Package/Parser.hs

@@ -10,6 +10,7 @@ module Idris.Package.Parser where
 
 import Idris.CmdOptions
 import Idris.Imports
+import Idris.Options (Opt)
 import Idris.Package.Common
 import Idris.Parser (moduleName)
 import Idris.Parser.Helpers (Parser, Parsing, eol, iName, identifier, isEol,
@@ -19,6 +20,7 @@ import Idris.Parser.Helpers (Parser, Parsing, eol, iName, identifier, isEol,
 import Control.Applicative
 import Control.Monad.State.Strict
 import Data.List (union)
+import qualified Options.Applicative as Opts
 import System.Directory (doesFileExist)
 import System.Exit
 import System.FilePath (isValid, takeExtension, takeFileName)
@@ -109,11 +111,19 @@ clause name p f = do value <- reserved name *> lchar '=' *> p <* someSpace
 commaSep   :: Parsing m => m a -> m [a]
 commaSep p = P.sepBy1 p (lchar ',')
 
+pOptions :: PParser [Opt]
+pOptions = do
+  str <- stringLiteral
+  case execArgParserPure (words str) of
+    Opts.Success a -> return a
+    Opts.Failure e -> fail $ fst $ Opts.renderFailure e ""
+    _              -> fail "Unexpected error"
+
 pClause :: PParser ()
 pClause = clause "executable" filename (\st v -> st { execout = Just v })
       <|> clause "main" (iName []) (\st v -> st { idris_main = Just v })
       <|> clause "sourcedir" identifier (\st v -> st { sourcedir = v })
-      <|> clause "opts" (pureArgParser . words <$> stringLiteral) (\st v -> st { idris_opts = v ++ idris_opts st })
+      <|> clause "opts" pOptions (\st v -> st { idris_opts = v ++ idris_opts st })
       <|> clause "pkgs" (commaSep (pPkgName <* someSpace)) (\st ps ->
              let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps
              in st { pkgdeps    = ps `union` pkgdeps st

test/TestData.hs

@@ -205,7 +205,8 @@ testFamiliesData = [
       (  5, ANY  ),
       (  6, ANY  ),
       (  7, ANY  ),
-      (  8, ANY  )]),
+      (  8, ANY  ),
+      ( 10, ANY  )]),
   ("prelude",         "Prelude",
     [ (  1, ANY  )]),
   ("primitives",      "Primitive types",

test/pkg010/expected

@@ -0,0 +1,28 @@
+Uncaught error: user error (wrongopts.ipkg:4:1:
+  |
+4 | <empty line>
+  | ^
+Invalid option `-total'
+
+Usage:  ([--nobanner] | [-q|--quiet] | [--ide-mode] | [--ide-mode-socket] |
+        [--client ARG] | [--log LEVEL] | [--logging-categories CATS] |
+        [--nobasepkgs] | [--noprelude] | [--nobuiltins] | [--check] |
+        [-o|--output FILE] | [--interface] | [--typeintype] | [--total] |
+        [--partial] | [--warnpartial] | [--warnreach] | [--warnipkg] |
+        [--nocoverage] | [--errorcontext] | [--info] | [--listlogcats] |
+        [--link] | [--listlibs] | [--libdir] | [--docdir] | [--include] | [--V2]
+        | [--V1] | [-V|--V0|--verbose] | [--ibcsubdir FILE] |
+        [-i|--idrispath ARG] | [--sourcepath ARG] | [--warn] |
+        [-p|--package ARG] | [--port PORT] | [--build IPKG] | [--install IPKG] |
+        [--repl IPKG] | [--clean IPKG] | [--mkdoc IPKG] | [--installdoc IPKG] |
+        [--checkpkg IPKG] | [--testpkg IPKG] | [--indent-with INDENT] |
+        [--indent-clause INDENT] | [--bytecode ARG] | [-S|--codegenonly] |
+        [-c|--compileonly] | [--dumpdefuns ARG] | [--dumpcases ARG] |
+        [--codegen TARGET] | [--portable-codegen TARGET] | [--cg-opt ARG] |
+        [-e|--eval EXPR] | [--execute] | [--exec EXPR] | [-X|--extension EXT] |
+        [--O3] | [--O2] | [--O1] | [--O0] | [--partial-eval] |
+        [--no-partial-eval] | [-O|--level ARG] | [--target TRIPLE] | [--cpu CPU]
+        | [--color|--colour] | [--nocolor|--nocolour] | [--consolewidth WIDTH] |
+        [--highlight] | [--no-elim-deprecation-warnings] |
+        [--no-tactic-deprecation-warnings]) [FILES] [-v|--version]
+)

test/pkg010/run

@@ -0,0 +1,2 @@
+#!/usr/bin/env bash
+${IDRIS:-idris} $@ --build wrongopts.ipkg

test/pkg010/wrongopts.ipkg

@@ -0,0 +1,3 @@
+package wrongopts
+
+opts = "-total"