module XMonad.Actions.Eval (
evalExpression
, evalExpressionWithReturn
, EvalConfig(..)
, defaultEvalConfig
) where
import XMonad.Core
import XMonad.Util.Run
import Language.Haskell.Interpreter
import Data.List
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]
_ = []
data EvalConfig = EvalConfig { EvalConfig -> InterpreterError -> X String
handleError :: InterpreterError -> X String
, EvalConfig -> [(String, Maybe String)]
imports :: [(ModuleName,Maybe String)]
, EvalConfig -> [String]
modules :: [String]
}
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 = []
}
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"
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
"")
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
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