[Xmonad] a safer ghci prompt

[Andrea Rossato]

On Thu, Aug 30, 2007 at 08:21:41PM +0200, Andrea Rossato wrote:
> Hi,

Hi,

for the time being I'm working on the evaluation server. I thought to
go with socket so this is the first attempt.

Attached you'll find a new Heval. To compile:
ghc --make Heval.hs -o heval -package ghc
(requires the network package).

This one will work with telnet (I didn't write the XPrompt side yet).
To try it out:

1. run: 
./heval &

2. connect with telnet:
telnet localhost 10490

3. start interacting with your Haskell evaluator.

To quit:
:quit

To stop the server:
:stop

The server will remember bound names between sessions. So:
let f n = n ^ n
will work after :quit (but not after :stop...;-).

The server is quite basic so far: if you run something like:
let x () = x () in x ()
it will get killed after 3 seconds.

[1..] will work though.

I'm using ghciu and hs-plugins code as examples.

Please let me know what you think. Is it useful something like this
(to be run from XMonad, I mean).

Thanks for your kind attention.

Andrea

-------------- next part --------------
module Main where

import GHC
import DynFlags
import PackageConfig
import System.Environment

import Data.Char
import Data.Dynamic
import Data.List
import Data.Maybe
import Network
import System.Exit
import System.IO
import System.Random
import System.Posix.Resource

ghcPath :: String
ghcPath = "/usr/lib/ghc-6.6.1"

rlimit :: ResourceLimit
rlimit = ResourceLimit 3

main :: IO ()
main = do
  setResourceLimit ResourceCPUTime (ResourceLimits rlimit rlimit)
  defaultErrorHandler defaultDynFlags $ do
         ses <- initSession
         serverLoop ses

initSession :: IO Session
initSession = do
  ses <- newSession Interactive (Just ghcPath)
  setSessionDynFlags ses =<< getSessionDynFlags ses
  setContext ses [] [mkModule (stringToPackageId "base") (mkModuleName "Prelude")]
  return ses

serverLoop :: Session -> IO ()
serverLoop ses = do
  s <- listenOn (PortNumber 10490)
  (h, hn, pn) <- accept s
  hSetBuffering h LineBuffering
  connectionLoop ses h
  hClose h
  sClose s
  serverLoop ses

connectionLoop :: Session -> Handle -> IO ()
connectionLoop ses h = do
  exp <- hGetLine h
  runExp ses exp h

updateSession :: Session ->  [String] ->  IO ()
updateSession ses l =
    mapM_ (runStmt ses) l

exprToRun :: String -> IO String
exprToRun exp = do
  x <- sequence (take 3 (repeat $ getStdRandom (randomR (97,122)) >>= return . chr))
  return ("let { "++ x ++
          " = " ++ exp ++
          "\n} in take 2048 (show " ++ x ++
          ")")

runExp :: Session -> String -> Handle -> IO ()
runExp ses s h
    -- "let: " update session
    | "let " `isPrefixOf` s = do
  runStmt ses s
  connectionLoop ses h
    -- exit
    | ":quit" `isPrefixOf` s = return ()
    -- stop server
    | ":stop" `isPrefixOf` s = exitWith ExitSuccess
    -- something to eval
    | otherwise = do
  exp <- exprToRun s
  res <- dynCompileExpr ses exp
  case res of
    Just x -> do
        let res' = fromDynamic x :: Maybe String
        hPutStrLn h $ fromMaybe "" res'
        connectionLoop ses h
    _ -> do
        hPutStrLn h "Failed!"
        connectionLoop ses h