mueval 0.4.6 → 0.5
raw patch · 5 files changed
+63/−37 lines, 5 filesdep +utf8-stringdep ~hintdep ~show
Dependencies added: utf8-string
Dependency ranges changed: hint, show
Files
- Mueval/Concurrent.hs +2/−1
- Mueval/Interpreter.hs +20/−10
- Mueval/ParseArgs.hs +14/−4
- mueval.cabal +4/−4
- tests.sh +23/−18
Mueval/Concurrent.hs view
@@ -39,10 +39,11 @@ hSetBuffering stdout NoBuffering -- Our modules and expression are set up. Let's do stuff.- forkIO (interpreterSession typeprint mdls expr+ forkIO (interpreterSession typeprint extend mdls expr `catchDyn` (printInterpreterError) >> putMVar mvar "Done.") where mdls = modules opts expr = expression opts tout = timeLimit opts typeprint = printType opts+ extend = extensions opts
Mueval/Interpreter.hs view
@@ -6,16 +6,19 @@ import Language.Haskell.Interpreter.GHC (eval, newSession, reset, setImports, setOptimizations, setUseLanguageExtensions, setInstalledModsAreInScopeQualified,- typeChecks, typeOf, withSession,+ typeChecks, typeOf, withSession, Interpreter, InterpreterError, ModuleName, Optimizations(All)) +import qualified Codec.Binary.UTF8.String as Codec (decodeString)+import qualified System.IO.UTF8 as UTF (putStr)+ import qualified Mueval.Resources (limitResources) -- | From inside the Interpreter monad, print the String (presumably the result -- of interpreting something), but only print the first 1024 characters to avoid -- flooding. Lambdabot has a similar limit. say :: String -> Interpreter ()-say = liftIO . putStr . take 1024+say = liftIO . UTF.putStr . Codec.decodeString . take 1024 -- | Oh no, something has gone wrong. Call 'error' and then, as with 'say', -- print out a maximum of 1024 characters.@@ -27,18 +30,24 @@ optimizations, hide all packages, make sure one cannot call unimported functions, typecheck (and optionally print it), set resource limits for this thread, and do some error handling. -}-interpreter :: Bool -> [ModuleName] -> String -> Interpreter ()-interpreter prt modules expr = do- setUseLanguageExtensions True -- Don't trust the- -- extensions+interpreter :: Bool -> Bool -> [ModuleName] -> String -> Interpreter ()+interpreter prt exts modules expr = do+ setUseLanguageExtensions exts -- False by default+ setOptimizations All -- Maybe optimization will make- -- more programs terminate.+ -- more programs+ -- terminate.+ reset -- Make sure nothing is available setInstalledModsAreInScopeQualified False+ setImports modules+ if prt then say $ expr ++ "\n" else return () - checks <- typeChecks expr liftIO Mueval.Resources.limitResources++ checks <- typeChecks expr+ if checks then do if prt then do say =<< typeOf expr say "\n"@@ -50,10 +59,11 @@ -- | Wrapper around 'interpreter'; supplies a fresh GHC API session and -- error-handling. The arguments are simply passed on. interpreterSession :: Bool -- ^ Whether to print inferred type+ -> Bool -- ^ Whether to use GHC extensions -> [ModuleName] -- ^ A list of modules we wish to be visible -> String -- ^ The string to be interpreted as a Haskell expression -> IO () -- ^ No real result, since printing is done deeper in -- the stack.-interpreterSession prt mds expr = Control.Exception.catch- (newSession >>= (flip withSession) (interpreter prt mds expr))+interpreterSession prt exts mds expr = Control.Exception.catch+ (newSession >>= (flip withSession) (interpreter prt exts mds expr)) (\_ -> error "Expression did not compile.")
Mueval/ParseArgs.hs view
@@ -1,8 +1,12 @@ module Mueval.ParseArgs (Options(..), interpreterOpts, getOptions) where +import Control.Monad (liftM) import System.Console.GetOpt import System.Environment (getArgs) +import qualified System.IO.UTF8 as UTF (putStr)+import qualified Codec.Binary.UTF8.String as Codec (decodeString)+ import Mueval.Context (defaultModules) -- | See the results of --help for information on what each option means.@@ -12,6 +16,7 @@ , expression :: String , user :: String , printType :: Bool+ , extensions :: Bool } deriving Show defaultOptions :: Options@@ -19,7 +24,8 @@ , modules = defaultModules , timeLimit = 5 , user = ""- , printType = False }+ , printType = False+ , extensions = False } options :: [OptDescr (Options -> Options)] options = [Option ['p'] ["password"]@@ -31,12 +37,15 @@ Option ['m'] ["module"] (ReqArg (\m opts -> opts { modules = m:(modules opts) }) "MODULE") "A module we should import functions from for evaluation. (Can be given multiple times.)",+ Option ['E'] ["Extensions"]+ (NoArg (\opts -> opts { extensions = True}))+ "Whether to enable the Glasgow extensions to Haskell '98. Defaults to false, but enabling is useful for QuickCheck.", Option ['e'] ["expression"] (ReqArg (\e opts -> opts { expression = e}) "EXPRESSION") "The expression to be evaluated.", Option ['i'] ["inferred-type"] (NoArg (\opts -> opts { printType = True}))- "Whether to enable printing of inferred type. Defaults to false." ]+ "Whether to enable printing of inferred type and the expression (as Mueval sees it). Defaults to false." ] interpreterOpts :: [String] -> IO (Options, [String]) interpreterOpts argv =@@ -45,8 +54,9 @@ (_,_,er) -> ioError $ userError (concat er ++ usageInfo header options) where header = "Usage: mueval [OPTION...] --expression EXPRESSION..." --- | Just give us the end result options; this handles I/O and parsing for us.+-- | Just give us the end result options; this handles I/O and parsing for+-- us. Bonus points for handling UTF. getOptions :: IO Options-getOptions = do input <- getArgs+getOptions = do input <- liftM (map Codec.decodeString) getArgs (opts,_) <- interpreterOpts $ input return opts
mueval.cabal view
@@ -1,5 +1,5 @@ name: mueval-version: 0.4.6+version: 0.5 license: BSD3 license-file: LICENSE@@ -28,13 +28,13 @@ data-files: README extra-source-files: build.sh, tests.sh -Library+library exposed-modules: Mueval.Concurrent, Mueval.Context, Mueval.Interpreter, Mueval.ParseArgs, Mueval.Resources- build-Depends: base, directory, mtl, unix, hint>=0.2.3, show+ build-depends: base, directory, mtl, unix, hint>=0.2.4, show>=0.2, utf8-string ghc-options: -Wall -static -Executable mueval+executable mueval main-is: main.hs build-depends: base ghc-options: -Wall -threaded -static
tests.sh view
@@ -2,9 +2,7 @@ # tests # Save typing-m () { mueval --expression "$@"; }-# Redefine a failed command to be successful-mf () { m "$@" || return 0; }+m () { mueval --inferred-type --expression "$@"; } # Abort if any commands aren't successful set -e@@ -26,29 +24,36 @@ m 'tail $ take 50 $ repeat "foo"' --module Data.List --timelimit 3 ## This tests whether the SimpleReflect stuff is working. Output should be: "(f 1 (f 2 (f 3 (f 4 (f 5 z)))))\" m 'foldr (\x y -> concat ["(f ",x," ",y,")"]) "z" (map show [1..5])'+## Test 1024-char limit+m 'repeat 1'+## Let's see whether the ShowQ instances for QuickCheck work+m 'myquickcheck (1+1 == 2)' -E+m 'myquickcheck (\x -> x == x)' -E+m 'let (ñ) = (+) in ñ 5 5'+echo "\nOK, all the valid expressions worked out well." && # Test on bad or outright evil expressions-echo "\n Now let's test various misbehaved expressions \n" &&+echo "Now let's test various misbehaved expressions \n" && ## test infinite loop-mf 'let x = x in x'-mf 'let x y = x 1 in x 1' --timelimit 3-mf 'let x = x + 1 in x'+m 'let x = x in x' ||+m 'let x y = x 1 in x 1' --timelimit 3 ||+m 'let x = x + 1 in x' || ## Similarly, but with a strict twist-mf 'let f :: Int -> Int; f x = f $! (x+1) in f 0'+m 'let f :: Int -> Int; f x = f $! (x+1) in f 0' || ## test stack limits-mf 'let x = 1 + x in x'+m 'let x = 1 + x in x' || ## Let's stress the time limits-mf 'let {p x y f = f x y; f x = p x x} in f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f f)))))))))))))))))) f'+m 'let {p x y f = f x y; f x = p x x} in f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f (f f)))))))))))))))))) f' || ## Now let's test the module whitelisting-mf 1+1 --module Data.List --module System.IO.Unsafe --module Control.Monad-mf "let foo = unsafePerformIO readFile \"/etc/passwd\" in foo" --module System.IO.Unsafe-mf "head [1..]" --module Data.List --module Text.HTML.Download+m 1+1 --module Data.List --module System.IO.Unsafe --module Control.Monad ||+m "let foo = unsafePerformIO readFile \"/etc/passwd\" in foo" --module System.IO.Unsafe ||+m "head [1..]" --module Data.List --module Text.HTML.Download || ### Can we bypass the whitelisting by fully qualified module names?-mf "Foreign.unsafePerformIO $ readFile \"/etc/passwd\""-mf "Data.ByteString.Internal.inlinePerformIO $ readFile \"/etc/passwd\""+m "Foreign.unsafePerformIO $ readFile \"/etc/passwd\"" ||+m "Data.ByteString.Internal.inlinePerformIO $ readFile \"/etc/passwd\"" || ## We need a bunch of IO tests, but I guess this will do for now.-mf "let foo = readFile \"/etc/passwd\" >>= print in foo"-mf "writeFile \"tmp.txt\" \"foo bar\""+m "let foo = readFile \"/etc/passwd\" >>= print in foo" ||+m "writeFile \"tmp.txt\" \"foo bar\"" || ## Evil array code, should fail (but not with a segfault!)-mf "array (0::Int, maxBound) [(1000000,'x')]" --module Data.Array+m "array (0::Int, maxBound) [(1000000,'x')]" --module Data.Array || echo "Done, apparently successfully"