diff --git a/Mueval/ArgsParse.hs b/Mueval/ArgsParse.hs --- a/Mueval/ArgsParse.hs +++ b/Mueval/ArgsParse.hs @@ -1,10 +1,9 @@ +{-# LANGUAGE CPP #-} module Mueval.ArgsParse (Options(..), interpreterOpts, getOptions) where import Control.Monad (liftM) import System.Console.GetOpt -import qualified Codec.Binary.UTF8.String as Codec (decodeString) - import Mueval.Context (defaultModules, defaultPackages) -- | See the results of --help for information on what each option means. @@ -15,6 +14,7 @@ , loadFile :: String , user :: String , printType :: Bool + , typeOnly :: Bool , extensions :: Bool , namedExtensions :: [String] , noImports :: Bool @@ -31,6 +31,7 @@ , user = "" , loadFile = "" , printType = False + , typeOnly = False , extensions = False , namedExtensions = [] , noImports = False @@ -69,6 +70,9 @@ Option "i" ["inferred-type"] (NoArg (\opts -> opts { printType = True})) "Whether to enable printing of inferred type and the expression (as Mueval sees it). Defaults to false.", + Option "T" ["type-only"] + (NoArg (\opts -> opts { typeOnly = True})) + "Only print the expression and type, don't evaluate the expression. Defaults to false.", Option "r" ["resource-limits"] (NoArg (\opts -> opts { rLimits = True})) "Enable resource limits (using POSIX rlimits). Mueval does not by default since rlimits are broken on many systems.", @@ -98,4 +102,11 @@ -- | Just give us the end result options; this parsing for -- us. Bonus points for handling UTF. getOptions :: [String] -> Either (Bool, String) Options -getOptions = interpreterOpts . map Codec.decodeString +getOptions = interpreterOpts . map decodeString + +decodeString :: String -> String +#if __GLASGOW_HASKELL__ >= 702 +decodeString = id +#else +decodeString = Codec.decodeString +#endif diff --git a/Mueval/Context.hs b/Mueval/Context.hs --- a/Mueval/Context.hs +++ b/Mueval/Context.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Mueval.Context ( cleanModules, defaultModules, @@ -29,10 +30,16 @@ "Control.Arrow", "Control.Monad", "Control.Monad.Cont", +#if __GLASGOW_HASKELL__ >= 710 + "Control.Monad.Except", +#else "Control.Monad.Error", +#endif "Control.Monad.Fix", "Control.Monad.Identity", +#if !MIN_VERSION_base(4,7,0) "Control.Monad.Instances", +#endif "Control.Monad.RWS", "Control.Monad.Reader", "Control.Monad.State", diff --git a/Mueval/Interpreter.hs b/Mueval/Interpreter.hs --- a/Mueval/Interpreter.hs +++ b/Mueval/Interpreter.hs @@ -1,30 +1,33 @@ {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE FlexibleContexts #-} -- TODO: suggest the convenience functions be put into Hint proper? module Mueval.Interpreter where -import Control.Monad (forM_,guard,mplus,unless,when) -import Control.Monad.Trans (MonadIO) -import Control.Monad.Writer (Any(..),runWriterT,tell) -import Data.Char (isDigit) -import Data.List (stripPrefix) -import System.Directory (copyFile, makeRelativeToCurrentDirectory, removeFile, setCurrentDirectory) -import System.Exit (exitFailure) -import System.FilePath.Posix (takeFileName) import qualified Control.Exception.Extensible as E (evaluate,catch,SomeException(..)) +import Control.Monad (forM_,guard,mplus,unless,when) +import Control.Monad.Trans (MonadIO) +import Control.Monad.Writer (Any(..),runWriterT,tell) +import Data.Char (isDigit) -import qualified System.IO.UTF8 as UTF (putStrLn) +import System.Directory -import Language.Haskell.Interpreter (eval, set, reset, setImportsQ, loadModules, liftIO, +import System.Exit (exitFailure) +import System.FilePath.Posix (takeBaseName) +import System.IO (openTempFile) + +import Data.List + +import Language.Haskell.Interpreter (eval, set, reset, setImportsQ, loadModules, liftIO, installedModulesInScope, languageExtensions, typeOf, setTopLevelModules, runInterpreter, glasgowExtensions, OptionVal(..), Interpreter, InterpreterError(..),GhcError(..), Extension(UnknownExtension)) -import Language.Haskell.Interpreter.Unsafe (unsafeSetGhcOption) +import Language.Haskell.Interpreter.Unsafe (unsafeSetGhcOption) -import Mueval.ArgsParse (Options(..)) +import Mueval.ArgsParse (Options(..)) import qualified Mueval.Resources as MR (limitResources) -import qualified Mueval.Context as MC (qualifiedModules) +import qualified Mueval.Context as MC (qualifiedModules) readExt :: String -> Extension readExt s = case reads s of @@ -39,6 +42,7 @@ interpreter :: Options -> Interpreter (String,String,String) interpreter Options { extensions = exts, namedExtensions = nexts, rLimits = rlimits, + typeOnly = noEval, loadFile = load, expression = expr, packageTrust = trust, trustedPackages = trustPkgs, @@ -54,13 +58,18 @@ reset -- Make sure nothing is available set [installedModulesInScope := False] - let lfl' = takeFileName load - when (load /= "") $ do liftIO (mvload load) - loadModules [lfl'] - -- We need to mangle the String to - -- turn a filename into a module. - setTopLevelModules [takeWhile (/='.') lfl'] + -- if we're given a file of definitions, we need to first copy it to a temporary file in /tmp (cpload), + -- then tell Hint to parse/read it, then extract the 'module name' of the file, + -- and tell Hint to expose the module into memory; then we need to store the temporary file's filepath + -- so we can try to clean up after ourselves later. + lfl' <- if (load /= "") then (do { lfl <- liftIO (cpload load); + loadModules [lfl]; + -- We need to mangle the String to + -- turn a filename into a module. + setTopLevelModules [takeBaseName load]; + return lfl }) else (return "") + liftIO $ MR.limitResources rlimits case m of @@ -68,13 +77,15 @@ Just ms -> do let unqualModules = zip ms (repeat Nothing) setImportsQ (unqualModules ++ MC.qualifiedModules) - -- clean up our tmp file here; must be after setImportsQ + -- clean up our tmp file here; must be *after* setImportsQ when (load /= "") $ liftIO (removeFile lfl') - -- we don't check if the expression typechecks + -- we don't deliberately don't check if the expression typechecks -- this way we get an "InterpreterError" we can display etype <- typeOf expr - result <- eval expr + result <- if noEval + then return "" + else eval expr return (expr, etype, result) @@ -84,12 +95,19 @@ interpreterSession opts = do r <- runInterpreter (interpreter opts) case r of Left err -> printInterpreterError err - Right (e,et,val) -> when (printType opts) (sayIO e >> sayIO et) >> sayIO val + Right (e,et,val) -> do when (printType opts) + (sayIO e >> sayIOOneLine et) + sayIO val + where sayIOOneLine = sayIO . unwords . words -mvload :: FilePath -> IO () -mvload lfl = do canonfile <- makeRelativeToCurrentDirectory lfl - liftIO $ copyFile canonfile $ "/tmp/" ++ takeFileName canonfile - setCurrentDirectory "/tmp" -- will at least mess up relative links +-- | Given a filepath (containing function definitions), copy it to a temporary file and change directory to it, returning the new filepath. +cpload :: FilePath -> IO FilePath +cpload definitions = do + tmpdir <- getTemporaryDirectory + (tempfile,_) <- System.IO.openTempFile tmpdir "mueval.hs" + liftIO $ copyFile definitions tempfile + setCurrentDirectory tmpdir -- will at least mess up relative links + return tempfile --------------------------------- -- Handling and outputting results @@ -100,7 +118,7 @@ -- flooding. Lambdabot has a similar limit. sayIO :: String -> IO () sayIO str = do (out,b) <- render 1024 str - UTF.putStrLn out + putStrLn out when b exitFailure -- | Oh no, something has gone wrong. If it's a compilation error pretty print diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -60,7 +60,7 @@ # See also -- Chris Done's [`mueval-interactive`](https://github.com/chrisdone/mueval-interactive) fork: a persistent `mueval` (startup is slow) for use in his [Try Haskell.org](http://tryhaskell.org/) +- Chris Done's interactive Haskell REPL website, [Try Haskell!](http://tryhaskell.org/) # Bugs diff --git a/mueval.cabal b/mueval.cabal --- a/mueval.cabal +++ b/mueval.cabal @@ -1,5 +1,5 @@ name: mueval -version: 0.9.1.1 +version: 0.9.1.1.2 license: BSD3 license-file: LICENSE @@ -32,7 +32,8 @@ exposed-modules: Mueval.Parallel, Mueval.Context, Mueval.Interpreter, Mueval.ArgsParse, Mueval.Resources build-depends: base>=4 && < 5, containers, directory, mtl>2, filepath, unix, process, - hint>=0.3.1, show>=0.3, utf8-string, Cabal, extensible-exceptions, simple-reflect + hint>=0.3.1, show>=0.3, Cabal, extensible-exceptions, simple-reflect, + QuickCheck ghc-options: -Wall -static executable mueval-core diff --git a/tests.sh b/tests.sh --- a/tests.sh +++ b/tests.sh @@ -63,7 +63,6 @@ m "sum [1..5] :: Expr" m "foldr f x [1..5]" ## Test defaulting of expressions -m 'show []' -E m '(+1) <$> [1..3]' ## Now let's do file loading echo "module TmpModule (foo, bar) where { foo x = x + 1; bar x = x + 2 }" > "TmpModule.hs"