@@ -22,8 +22,6 @@ import Text.ParserCombinators.ReadP hiding (many, option)
23import Safe (lastMay)
23import Safe (lastMay)
27import qualified Text.PrettyPrint.ANSI.Leijen as PP
25import qualified Text.PrettyPrint.ANSI.Leijen as PP
29runArgParser :: IO [Opt]
27runArgParser :: IO [Opt]
@@ -33,7 +31,7 @@ runArgParser = do opts <- execParser $ info parser
33 <> progDescDoc (Just idrisProgDesc)
31 <> progDescDoc (Just idrisProgDesc)
34 <> footerDoc (Just idrisFooter)
32 <> footerDoc (Just idrisFooter)
36− return $ preProcOpts opts []
34+ return $ preProcOpts opts
38 idrisHeader = PP.hsep [PP.text "Idris version", PP.text ver, PP.text ", (C) The Idris Community 2016"]
36 idrisHeader = PP.hsep [PP.text "Idris version", PP.text ver, PP.text ", (C) The Idris Community 2016"]
39 idrisProgDesc = PP.vsep [PP.empty,
37 idrisProgDesc = PP.vsep [PP.empty,
@@ -43,7 +41,7 @@ runArgParser = do opts <- execParser $ info parser
43 PP.text "It is compiled, with eager evaluation. Its features are influenced by Haskell",
41 PP.text "It is compiled, with eager evaluation. Its features are influenced by Haskell",
44 PP.text "and ML.",
42 PP.text "and ML.",
46− PP.vsep $ map (\x -> PP.indent 4 (PP.text x)) [
44+ PP.vsep $ map (PP.indent 4 . PP.text) [
47 "+ Full dependent types with dependent pattern matching",
45 "+ Full dependent types with dependent pattern matching",
48 "+ Simple case expressions, where-clauses, with-rule",
46 "+ Simple case expressions, where-clauses, with-rule",
49 "+ Pattern matching let- and lambda-bindings",
47 "+ Pattern matching let- and lambda-bindings",
@@ -66,12 +64,9 @@ runArgParser = do opts <- execParser $ info parser
67 PP.indent 4 (PP.text "http://www.idris-lang.org/")]
65 PP.indent 4 (PP.text "http://www.idris-lang.org/")]
72pureArgParser :: [String] -> [Opt]
67pureArgParser :: [String] -> [Opt]
73pureArgParser args = case getParseResult $ execParserPure (prefs idm) (info parser idm) args of
68pureArgParser args = case getParseResult $ execParserPure (prefs idm) (info parser idm) args of
74− Just opts -> preProcOpts opts []
69+ Just opts -> preProcOpts opts
75 Nothing -> []
70 Nothing -> []
77parser :: Parser [Opt]
72parser :: Parser [Opt]
@@ -80,7 +75,6 @@ parser = runA $ proc () -> do
80 files <- asA (many $ argument (fmap Filename str) (metavar "FILES")) -< ()
75 files <- asA (many $ argument (fmap Filename str) (metavar "FILES")) -< ()
81 A parseVersion >>> A helper -< (flags ++ files)
76 A parseVersion >>> A helper -< (flags ++ files)
84parseFlags :: Parser [Opt]
78parseFlags :: Parser [Opt]
85parseFlags = many $
79parseFlags = many $
86 flag' NoBanner (long "nobanner" <> help "Suppress the banner")
80 flag' NoBanner (long "nobanner" <> help "Suppress the banner")
@@ -153,14 +147,13 @@ parseFlags = many $
153 <|> (DumpDefun <$> strOption (long "dumpdefuns"))
147 <|> (DumpDefun <$> strOption (long "dumpdefuns"))
154 <|> (DumpCases <$> strOption (long "dumpcases"))
148 <|> (DumpCases <$> strOption (long "dumpcases"))
156− <|> ((\s -> UseCodegen $ parseCodegen s) <$> strOption (long "codegen"
150+ <|> (UseCodegen . parseCodegen) <$> strOption (long "codegen"
157− <> metavar "TARGET"
151+ <> metavar "TARGET"
158− <> help "Select code generator: C, Javascript, Node and bytecode are bundled with Idris"))
152+ <> help "Select code generator: C, Javascript, Node and bytecode are bundled with Idris")
161− <|> ((\s -> UseCodegen $ Via JSONFormat s) <$> strOption (long "portable-codegen"
154+ <|> ((UseCodegen . Via JSONFormat) <$> strOption (long "portable-codegen"
162− <> metavar "TARGET"
155+ <> metavar "TARGET"
163− <> help "Pass the name of the code generator. This option is for codegens that take JSON formatted IR."))
156+ <> help "Pass the name of the code generator. This option is for codegens that take JSON formatted IR."))
165 <|> (CodegenArgs <$> strOption (long "cg-opt"
158 <|> (CodegenArgs <$> strOption (long "cg-opt"
166 <> metavar "ARG"
159 <> metavar "ARG"
@@ -171,10 +164,10 @@ parseFlags = many $
171 <|> flag' (InterpretScript "Main.main") (long "execute" <> help "Execute as idris")
164 <|> flag' (InterpretScript "Main.main") (long "execute" <> help "Execute as idris")
172 <|> (InterpretScript <$> strOption (long "exec" <> metavar "EXPR" <> help "Execute as idris"))
165 <|> (InterpretScript <$> strOption (long "exec" <> metavar "EXPR" <> help "Execute as idris"))
174− <|> ((\s -> Extension $ getExt s) <$> strOption (long "extension"
167+ <|> ((Extension . getExt) <$> strOption (long "extension"
175− <> short 'X'
168+ <> short 'X'
176− <> metavar "EXT"
169+ <> metavar "EXT"
177− <> help "Turn on language extension (TypeProviders or ErrorReflection)"))
170+ <> help "Turn on language extension (TypeProviders or ErrorReflection)"))
179 -- Optimisation Levels
172 -- Optimisation Levels
180 <|> flag' (OptLevel 3) (long "O3")
173 <|> flag' (OptLevel 3) (long "O3")
@@ -201,30 +194,29 @@ parseFlags = many $
201 <|> flag' NoElimDeprecationWarnings (long "no-elim-deprecation-warnings" <> help "Disable deprecation warnings for %elim")
194 <|> flag' NoElimDeprecationWarnings (long "no-elim-deprecation-warnings" <> help "Disable deprecation warnings for %elim")
202 <|> flag' NoOldTacticDeprecationWarnings (long "no-tactic-deprecation-warnings" <> help "Disable deprecation warnings for the old tactic sublanguage")
195 <|> flag' NoOldTacticDeprecationWarnings (long "no-tactic-deprecation-warnings" <> help "Disable deprecation warnings for the old tactic sublanguage")
205− getExt s = case maybeRead s of
198+ getExt :: String -> LanguageExt
207− Nothing -> error ("Unknown extension " ++ s)
199+ getExt s = fromMaybe (error ("Unknown extension " ++ s)) (maybeRead s)
200+ maybeRead :: String -> Maybe LanguageExt
208− maybeRead = fmap fst . listToMaybe . reads
201+ maybeRead = fmap fst . listToMaybe . reads
210parseVersion :: Parser (a -> a)
203parseVersion :: Parser (a -> a)
211parseVersion = infoOption ver (short 'v' <> long "version" <> help "Print version information")
204parseVersion = infoOption ver (short 'v' <> long "version" <> help "Print version information")
213−preProcOpts :: [Opt] -> [Opt] -> [Opt]
206+preProcOpts :: [Opt] -> [Opt]
214−preProcOpts [] ys = ys
215−preProcOpts (NoBuiltins:xs) ys = NoBuiltins : NoPrelude : preProcOpts xs ys
207+preProcOpts (NoBuiltins : xs) = NoBuiltins : NoPrelude : preProcOpts xs
216−preProcOpts (Output s:xs) ys = Output s : NoREPL : preProcOpts xs ys
208+preProcOpts (Output s : xs) = Output s : NoREPL : preProcOpts xs
217−preProcOpts (BCAsm s:xs) ys = BCAsm s : NoREPL : preProcOpts xs ys
209+preProcOpts (BCAsm s : xs) = BCAsm s : NoREPL : preProcOpts xs
218−preProcOpts (x:xs) ys = preProcOpts xs (x:ys)
210+preProcOpts (x:xs) = x : preProcOpts xs
220parseCodegen :: String -> Codegen
213parseCodegen :: String -> Codegen
221parseCodegen "bytecode" = Bytecode
214parseCodegen "bytecode" = Bytecode
222parseCodegen cg = Via IBCFormat (map toLower cg)
215parseCodegen cg = Via IBCFormat (map toLower cg)
225parseLogCats :: Monad m => String -> m [LogCat]
217parseLogCats :: Monad m => String -> m [LogCat]
226parseLogCats s =
218parseLogCats s =
227− case lastMay (readP_to_S (doParse) s) of
219+ case lastMay (readP_to_S doParse s) of
228 Just (xs, _) -> return xs
220 Just (xs, _) -> return xs
229 _ -> fail "Incorrect categories specified"
221 _ -> fail "Incorrect categories specified"
@@ -252,12 +244,10 @@ parseConsoleWidth :: Monad m => String -> m ConsoleWidth
252parseConsoleWidth "auto" = return AutomaticWidth
244parseConsoleWidth "auto" = return AutomaticWidth
253parseConsoleWidth "infinite" = return InfinitelyWide
245parseConsoleWidth "infinite" = return InfinitelyWide
254parseConsoleWidth s =
246parseConsoleWidth s =
255− case lastMay (readP_to_S (integerReader) s) of
247+ case lastMay (readP_to_S integerReader s) of
256 Just (r, _) -> return $ ColsWide r
248 Just (r, _) -> return $ ColsWide r
257 _ -> fail $ "Cannot parse: " ++ s
249 _ -> fail $ "Cannot parse: " ++ s
261integerReader :: ReadP Int
251integerReader :: ReadP Int
262integerReader = do
252integerReader = do
263 digits <- many1 $ satisfy isDigit
253 digits <- many1 $ satisfy isDigit