mueval 0.6.2 → 0.6.3
raw patch · 5 files changed
+56/−32 lines, 5 files
Files
- Mueval/Concurrent.hs +8/−5
- Mueval/Context.hs +2/−1
- Mueval/Interpreter.hs +40/−25
- mueval.cabal +1/−1
- tests.sh +5/−0
Mueval/Concurrent.hs view
@@ -1,8 +1,9 @@ module Mueval.Concurrent where +import Prelude hiding (catch) import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo, yield, ThreadId) import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce))-import Control.Exception (catchDyn, Exception(ErrorCall))+import Control.Exception (Exception(ErrorCall),catch) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar) import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering)) @@ -35,13 +36,15 @@ -- | Set a 'watchDog' on this thread, and then continue on with whatever. forkedMain' :: Options -> MVar [Char] -> IO ThreadId-forkedMain' opts mvar = do myThreadId >>= watchDog tout+forkedMain' opts mvar = do mainId <- myThreadId + watchDog tout mainId hSetBuffering stdout NoBuffering -- Our modules and expression are set up. Let's do stuff.- forkIO (interpreterSession typeprint extend mdls fls expr- `catchDyn` (printInterpreterError)- >> putMVar mvar "Done.")+ forkIO $ (interpreterSession typeprint extend mdls fls expr + >> putMVar mvar "Done.") + `catch` throwTo mainId -- bounce exceptions to the main thread, + -- so they are reliably printed out where mdls = if impq then Nothing else Just (modules opts) expr = expression opts tout = timeLimit opts
Mueval/Context.hs view
@@ -29,6 +29,7 @@ sources. -} defaultModules :: [String] defaultModules = ["Prelude", "ShowQ", "ShowFun", "SimpleReflect", "Data.Function",+ "Control.Applicative", "Control.Monad", "Control.Monad.Cont", "Control.Monad.Error",@@ -88,7 +89,7 @@ > mueval --module Data.Map -e "Prelude.map (+1) [1..100]" -} safeModules :: [String]-safeModules = defaultModules ++ ["Control.Applicative",+safeModules = defaultModules ++ [ "Control.Arrow", "Control.Arrow.Operations", "Control.Arrow.Transformer",
Mueval/Interpreter.hs view
@@ -2,33 +2,49 @@ module Mueval.Interpreter where import Control.Monad (when)-import qualified Control.Exception (catch)+import qualified Control.Exception as E (bracket,catchDyn) import Control.Monad.Trans (liftIO) import System.Directory (copyFile, makeRelativeToCurrentDirectory, removeFile) import System.FilePath.Posix (takeFileName)-+import System.Exit (exitFailure) import Language.Haskell.Interpreter.GHC (eval, newSession, reset, setImports, loadModules, setOptimizations, setUseLanguageExtensions, setInstalledModsAreInScopeQualified,- typeChecks, typeOf, withSession, setTopLevelModules,- Interpreter, InterpreterError, ModuleName, Optimizations(All))+ typeOf, withSession, setTopLevelModules,+ Interpreter, InterpreterError(..),GhcError(..), ModuleName, Optimizations(All)) import qualified Codec.Binary.UTF8.String as Codec (decodeString)-import qualified System.IO.UTF8 as UTF (putStr)+import qualified System.IO.UTF8 as UTF (putStrLn) + 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 . UTF.putStr . Codec.decodeString . take 1024+say = liftIO . sayIO --- | Oh no, something has gone wrong. Call 'error' and then, as with 'say',--- print out a maximum of 1024 characters.+sayIO :: String -> IO ()+sayIO = UTF.putStrLn . Codec.decodeString . take 1024++-- | Oh no, something has gone wrong. If it's a compilation error prettyprint +-- the first 1024 chars of it and throw an ExitExcetion+-- otherwise rethrow the exception in String form. printInterpreterError :: InterpreterError -> IO ()-printInterpreterError = error . take 1024 . ("Oops... " ++) . show+printInterpreterError (WontCompile errors) = + -- if we get a compilation error we print it directly to avoid "mueval: .."+ -- maybe it should go to stderr?+ do sayIO $ concatMap (dropLinePosition . errMsg) errors+ exitFailure+ where + -- each error starts with the line position, which is uninteresting+ dropLinePosition = unlines . tail . lines+-- other exceptions indicate some problem in mueval or the environment,+-- so we rethrow them for debugging purpouses+printInterpreterError other = error (show other) + {- | The actual calling of Hint functionality. The heart of this just calls 'eval', but we do so much more - we disable Haskell extensions, turn on optimizations, hide all packages, make sure one cannot call unimported@@ -64,17 +80,14 @@ Nothing -> return () Just ms -> setImports ms - when prt (say $ expr ++ "\n")+ when prt $ say expr+ -- we don't check if the expression typechecks + -- this way we get an InterpreterError we can display+ when prt $ say =<< typeOf expr - checks <- typeChecks expr+ result <- eval expr - if checks then do- if prt then do say =<< typeOf expr- say "\n"- else return ()- result <- eval expr- say $ result ++ "\n"- else error "Expression did not type check."+ say $ result -- | Wrapper around 'interpreter'; supplies a fresh GHC API session and -- error-handling. The arguments are simply passed on.@@ -86,13 +99,15 @@ -> String -- ^ The string to be interpreted as a Haskell expression -> IO () -- ^ No real result, since printing is done deeper in -- the stack.-interpreterSession prt exts mds lfl expr = Control.Exception.catch- (newSession >>= (flip withSession) (interpreter prt exts mds lfl expr))- (\_ -> do case lfl of- "" -> return ()- l -> do canonfile <- (makeRelativeToCurrentDirectory l)- removeFile ("/tmp/" ++ takeFileName canonfile)- error "Expression did not compile.")+interpreterSession prt exts mds lfl expr = E.bracket newSession cleanTmpFile $ \session ->+ withSession session (interpreter prt exts mds lfl expr)+ `E.catchDyn` printInterpreterError+ where + cleanTmpFile _ = case lfl of+ "" -> return ()+ l -> do canonfile <- makeRelativeToCurrentDirectory l+ removeFile $ "/tmp/" ++ takeFileName canonfile+ mvload :: FilePath -> IO () mvload lfl = do canonfile <- (makeRelativeToCurrentDirectory lfl)
mueval.cabal view
@@ -1,5 +1,5 @@ name: mueval-version: 0.6.2+version: 0.6.3 license: BSD3 license-file: LICENSE
tests.sh view
@@ -10,6 +10,9 @@ echo "Test some valid expressions \n" ## Does anything work? m 'True'+## TODO: Test comments+# m 'True -- testing'+m 'True {- Testing -}' ## OK, let's try some simple math. m '1*100+1' m '(1*100) +1+1' --module Control.Monad@@ -49,8 +52,10 @@ m 'runIdentity $ mfix (return . (0:) . scanl (+) 1)' m 'fix ((1:).(1:).(zipWith (+) `ap` tail))' m 'runST (return 0)'+m 'map return [1,2] :: [Either String Int]' ## Test defaulting of expressions m 'show []' -E+m '(+1) <$> [1..3]' ## Now let's do file loading echo "module TmpModule (foo, bar) where\nfoo x = x + 1 \nbar x = x + 2" > "TmpModule.hs" m '1+1' --loadfile="TmpModule.hs"