-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.GhcPrompt
-- Copyright   :  (C) 2007 Andrea Rossato
-- License     :  BSD3
-- 
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A ssh prompt for XMonad
--
-----------------------------------------------------------------------------

module XMonadContrib.GhcPrompt (
                             -- * Usage
                             -- $usage
                             ghcPrompt
                              ) where

import Data.Dynamic
import Data.List
import Data.Maybe

import XMonad
import XMonadContrib.XPrompt

import GHC
import DynFlags
import PackageConfig

-- $usage
-- 1. In xmonad.cabal change: 
--
-- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0
--
-- to
--
-- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, ghc>= 6.6
--
-- 2. In Config.hs add:
--
-- > import XMonadContrib.XPrompt
-- > import XMonadContrib.GhcPrompt
--
-- 3. In your keybindings add something like:
--
-- >   , ((modMask .|. controlMask, xK_h), ghcPrompt defaultXPConfig)
--
-- 4. edit the ghcPath below to fit your system!

-- EDIT TO FIR YOUR SYSTEM!!
ghcPath :: String
ghcPath = "/usr/lib/ghc-6.6.1"

data Ghc = Ghc

instance XPrompt Ghc where
    showXPrompt Ghc = "Eval:   "
                     
ghcPrompt :: XPConfig -> X ()
ghcPrompt conf = do
  ses <- io initSession
  mkXPrompt Ghc conf (mkComplFunFromList []) (ghc conf ses)

ghc :: XPConfig -> Session -> String -> X ()
ghc conf ses s
    -- exit
    | s == ":quit" || s == ":q" || s == [] = return ()
    -- "let: " update session
    | "let " `isPrefixOf` s = do
  io $ runStmt ses s
  mkXPrompt Ghc conf (mkComplFunFromList []) (ghc conf ses)
    -- something to eval
    | otherwise = do
  res <- io $ dynCompileExpr ses ("show $ "++ s)
  case res of
    Just x -> do 
        let res' = fromDynamic x :: Maybe String
        io $ putStrLn (show res')
        mkXPrompt Ghc conf (\_ -> return [fromMaybe "" res']) (ghc conf ses)
    _ -> do io $ putStrLn "fallito"
            mkXPrompt Ghc conf (\_ -> return ["failed"]) (ghc conf ses)

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