diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,4 +1,4 @@ #!/usr/bin/env runhaskell > import Distribution.Simple -> main = defaultMainWithHooks defaultUserHooks +> main = defaultMainWithHooks simpleUserHooks diff --git a/src/Heval.hs b/src/Heval.hs deleted file mode 100644 --- a/src/Heval.hs +++ /dev/null @@ -1,134 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Heval --- Copyright : (c) Andrea Rossato --- License : BSD3 --- --- Maintainer : Andrea Rossato --- Stability : unstable --- Portability : unportable --- --- A simple evaluator used by a XMonad prompt --- ------------------------------------------------------------------------------ - -module Main where - -import GHC -import Panic -import DynFlags -import PackageConfig -import ErrUtils -import SrcLoc (SrcSpan) -import Outputable - -import Control.Concurrent -import Control.Exception -import Data.Char -import Data.Dynamic -import Data.List -import Data.Maybe -import Prelude hiding (catch) -import System.Exit -import System.IO -import System.Random -import System.Posix.Resource -import System.Posix.Signals - -ghcPath :: String -ghcPath = "/usr/lib/ghc-6.8.2" - -myLog :: Severity -> SrcSpan -> PprStyle -> Message -> IO () -myLog = \severity _ style msg -> - case severity of - SevInfo -> hPutStrLn stdout (show (msg style)) - SevFatal -> hPutStrLn stdout (show (msg style)) - _ -> hPutStrLn stdout (show (msg style)) - -rlimit :: ResourceLimit -rlimit = ResourceLimit 5 - -main :: IO () -main = do - setResourceLimit ResourceCPUTime (ResourceLimits rlimit rlimit) - defaultErrorHandler defaultDynFlags $ do - s <- getLine - let exps = read s :: [String] - ses <- initSession - case exps of - [] -> return () - (x:[]) -> runExp ses x - xs -> do updateSession ses (init xs) - runExp ses (last xs) - -initSession :: IO Session -initSession = do - ses <- newSession (Just ghcPath) - df <- getSessionDynFlags ses - setSessionDynFlags ses df {log_action = myLog } - setContext ses [] [mkModule (stringToPackageId "base") (mkModuleName "Prelude")] - return ses - -updateSession :: Session -> [String] -> IO () -updateSession ses l = - mapM_ (runWithTimeOut 3 . flip (runStmt ses) SingleStep) l - -exprToRun :: String -> IO String -exprToRun expr = do - x <- sequence (take 3 (repeat $ getStdRandom (randomR (97,122)) >>= return . chr)) - return ("let { "++ x ++ - " = " ++ expr ++ - "\n} in take 2048 (show " ++ x ++ - ")") - -runWithTimeOut :: Int -> IO a -> IO a -runWithTimeOut to action = do - t <- forkIO $ checkerThread - res <- action - killThread t - return res - where - -- if this thread is not killed within t seconds it will raise the - -- equivalent of a ^C - checkerThread = do - threadDelay (to * 1000000) - -- FIXME - hPutStrLn stdout "Interrupted." - raiseSignal sigQUIT - -runExp :: Session -> String -> IO () -runExp ses (':':com) = - specialCommand ses com -runExp ses s - -- nothing: restart - | s == "" || s == "\r" || s == "\n" = do - return () - -- let: bind and update session - | "let " `isPrefixOf` s = do - runWithTimeOut 3 $ runStmt ses s SingleStep - return () - -- something to eval - | otherwise = do - expr <- exprToRun s - catch (go expr) (\e -> hPutStrLn stdout $ showException e) - where - go e = do - str <- evalExpr ses e - putStrLn str - -evalExpr :: Session -> String -> IO String -evalExpr ses expr = do - maybe_dyn <- dynCompileExpr ses expr - case maybe_dyn of - Just dyn -> return $ (fromMaybe "" (fromDynamic dyn :: Maybe String)) - _ -> do return [] - --- special commands -specialCommand :: Session -> String -> IO () -specialCommand _ com - -- stop: stop server - | "stop" `isPrefixOf` com = exitWith ExitSuccess - -- quit: exit - | "quit" `isPrefixOf` com = return () - | otherwise = return () - diff --git a/src/Utils.hs b/src/Utils.hs deleted file mode 100644 --- a/src/Utils.hs +++ /dev/null @@ -1,51 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Utils --- Copyright : (c) Andrea Rossato --- License : BSD3 --- --- Maintainer : Andrea Rossato --- Stability : unstable --- Portability : unportable --- --- Utilities for xmonad-utils --- ------------------------------------------------------------------------------ - -module Utils where - -import Control.Concurrent -import Control.Monad -import Graphics.X11.Xlib -import System.Posix.Types (Fd(..)) - --- creates an invisible cursor -nullCursor :: Display -> Window -> IO Cursor -nullCursor d w = do - let c = Color 0 0 0 0 0 - p <- createPixmap d w 1 1 1 - cursor <- createPixmapCursor d p p c c 0 0 - freePixmap d p - return cursor - -initColor :: Display -> String -> IO Pixel -initColor dpy color = do - let colormap = defaultColormap dpy (defaultScreen dpy) - (apros,_) <- allocNamedColor dpy colormap color - return $ color_pixel apros - -waitASecond :: Int -> IO () -waitASecond i = - threadDelay (i*1000000) - --- A version of maskEvent that does not block in foreign calls. -maskEvent' :: Display -> EventMask -> XEventPtr -> IO () -maskEvent' d m p = do - pend <- pending d - if pend /= 0 - then maskEvent d m p - else do - threadWaitRead (Fd fd) - maskEvent' d m p - where - fd = connectionNumber d diff --git a/xmonad-utils.cabal b/xmonad-utils.cabal --- a/xmonad-utils.cabal +++ b/xmonad-utils.cabal @@ -1,9 +1,9 @@ name: xmonad-utils -version: 0.1 +version: 0.1.1 license: BSD3 license-file: LICENSE author: Andrea Rossato -maintainer: +maintainer: stability: experimental category: System @@ -22,14 +22,13 @@ to unclutter. homepage: http://www.haskell.org/haskellwiki/Xmonad-utils -build-depends: base>=2.0, X11>=1.3, ghc>=6.8, unix, random>=1.0 +build-depends: base<4, X11>=1.3, ghc>=6.8, unix, random>=1.0 build-type: Simple cabal-version: >=1.4 tested-with: GHC==6.8.2 executable: hxsel main-is: Hxsel.hs -other-modules: Heval Hhp Hmanage Hxput Hxsel Utils hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all @@ -56,12 +55,6 @@ executable: hhp main-is: Hhp.hs -hs-source-dirs: src -ghc-options: -funbox-strict-fields -Wall -ghc-prof-options: -prof -auto-all - -executable: heval -main-is: Heval.hs hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all