-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Eval
-- Copyright   :  (c) 2009 Daniel Schoepe
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Daniel Schoepe <daniel.schoepe@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Evaluate haskell expressions at runtime in the running xmonad instance.
--
-----------------------------------------------------------------------------

module XMonad.Actions.Eval (
                            -- * Usage
                            -- $usage

                            -- * Documentation
                            -- $documentation

                             evalExpression
                           , evalExpressionWithReturn
                           , EvalConfig(..)
                           , defaultEvalConfig
                           ) where

import XMonad.Core
import XMonad.Util.Run
import Language.Haskell.Interpreter
import Data.List

-- $usage
-- This module provides functions to evaluate haskell expressions at runtime
-- To use it, bind a key to evalExpression, for example in combination with a prompt:
--
-- > import XMonad
-- > import XMonad.Actions.Eval
-- > import XMonad.Prompt.Input
-- > ..
-- >   , ((modMask,xK_t), inputPrompt defaultXPConfig "Eval" >>= flip whenJust (evalExpression defaultEvalConfig))
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- $documentation

-- In here due to the apparent lack of a replace function in the standard library.
-- (Used for correctly displaying newlines in error messages)
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace :: forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace lst :: [a]
lst@(a
x:[a]
xs) [a]
sub [a]
repl | [a]
sub [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
lst = [a]
repl [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sub) [a]
lst) [a]
sub [a]
repl
                            | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace [a]
xs [a]
sub [a]
repl)
replace [a]
_ [a]
_ [a]
_ = []

-- | Configuration structure
data EvalConfig = EvalConfig { EvalConfig -> InterpreterError -> X String
handleError :: InterpreterError -> X String
                             -- ^ Function to handle errors
                             , EvalConfig -> [(String, Maybe String)]
imports     :: [(ModuleName,Maybe String)]
                             -- ^ Modules to import for interpreting the expression.
                             -- The pair consists of the module name and an optional
                             -- qualification of the imported module.
                             , EvalConfig -> [String]
modules     :: [String]
                             -- ^ Other source files that should be loaded
                             -- The definitions of these modules will be visible
                             -- regardless of whether they are exported.
                             }

-- | Defaults for evaluating expressions.
defaultEvalConfig :: EvalConfig
defaultEvalConfig :: EvalConfig
defaultEvalConfig = EvalConfig { handleError :: InterpreterError -> X String
handleError = InterpreterError -> X String
handleErrorDefault
                               , imports :: [(String, Maybe String)]
imports = [(String
"Prelude",Maybe String
forall a. Maybe a
Nothing),(String
"XMonad",Maybe String
forall a. Maybe a
Nothing),
                                            (String
"XMonad.StackSet",String -> Maybe String
forall a. a -> Maybe a
Just String
"W"),(String
"XMonad.Core",Maybe String
forall a. Maybe a
Nothing)]
                               , modules :: [String]
modules = []
                               }

-- | Default way to handle(in this case: display) an error during interpretation of an expression.
handleErrorDefault :: InterpreterError -> X String
handleErrorDefault :: InterpreterError -> X String
handleErrorDefault InterpreterError
err = IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> [String] -> IO ()
forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
"/usr/bin/xmessage" [String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace (InterpreterError -> String
forall a. Show a => a -> String
show InterpreterError
err) String
"\\n" String
"\n"]) X () -> X String -> X String
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                         String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Error"

-- | Returns an Interpreter action that loads the desired modules and interprets the expression.
interpret' :: EvalConfig -> String -> Interpreter (X String)
interpret' :: EvalConfig -> String -> Interpreter (X String)
interpret' EvalConfig
conf String
s = do
  [String] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
loadModules ([String] -> InterpreterT IO ()) -> [String] -> InterpreterT IO ()
forall a b. (a -> b) -> a -> b
$ EvalConfig -> [String]
modules EvalConfig
conf
  [String] -> InterpreterT IO ()
forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
setTopLevelModules ([String] -> InterpreterT IO ())
-> InterpreterT IO [String] -> InterpreterT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InterpreterT IO [String]
forall (m :: * -> *). MonadInterpreter m => m [String]
getLoadedModules
  [(String, Maybe String)] -> InterpreterT IO ()
forall (m :: * -> *).
MonadInterpreter m =>
[(String, Maybe String)] -> m ()
setImportsQ ([(String, Maybe String)] -> InterpreterT IO ())
-> [(String, Maybe String)] -> InterpreterT IO ()
forall a b. (a -> b) -> a -> b
$ EvalConfig -> [(String, Maybe String)]
imports EvalConfig
conf
  String -> X String -> Interpreter (X String)
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
String -> a -> m a
interpret (String
"show `fmap` ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")") (String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")

-- | Evaluates a given expression whose result type has to be an instance of Show
evalExpressionWithReturn :: EvalConfig -> String -> X String
evalExpressionWithReturn :: EvalConfig -> String -> X String
evalExpressionWithReturn EvalConfig
conf String
s = IO (Either InterpreterError (X String))
-> X (Either InterpreterError (X String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Interpreter (X String) -> IO (Either InterpreterError (X String))
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InterpreterT m a -> m (Either InterpreterError a)
runInterpreter (Interpreter (X String) -> IO (Either InterpreterError (X String)))
-> Interpreter (X String)
-> IO (Either InterpreterError (X String))
forall a b. (a -> b) -> a -> b
$ EvalConfig -> String -> Interpreter (X String)
interpret' EvalConfig
conf String
s) X (Either InterpreterError (X String))
-> (Either InterpreterError (X String) -> X String) -> X String
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                  (InterpreterError -> X String)
-> (X String -> X String)
-> Either InterpreterError (X String)
-> X String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EvalConfig -> InterpreterError -> X String
handleError EvalConfig
conf) X String -> X String
forall a. a -> a
id

-- | Evaluates a given expression, but discard the returned value. Provided for
-- more convenient use in keybindings
evalExpression :: EvalConfig -> String -> X ()
evalExpression :: EvalConfig -> String -> X ()
evalExpression EvalConfig
cnf = (X String -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (X String -> X ()) -> (String -> X String) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalConfig -> String -> X String
evalExpressionWithReturn EvalConfig
cnf