-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Eval
-- Copyright   :  Daniel Schoepe <daniel.schoepe@gmail.com>
-- License     :  BSD3
--
-- Maintainer  :  Daniel Schoepe <daniel.schoepe@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A prompt for evaluating Haskell expressions (in the context of the running
-- xmonad instance).
--
-----------------------------------------------------------------------------

module XMonad.Prompt.Eval (
                          -- * Usage
                          -- $usage
                           evalPrompt
                          ,evalPromptWithOutput
                          ,showWithDzen
                          ) where

import XMonad
import XMonad.Prompt
import XMonad.Actions.Eval
import XMonad.Util.Dzen

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Eval
--
-- in your keybindings add:
--
-- >   , ((modMask x .|. controlMask, xK_x), evalPrompt defaultEvalConfig)
--
-- For detailed instruction on editing the key binding see
-- "XMonad.Doc.Extending#Editing_key_bindings".

data EvalPrompt = EvalPrompt

instance XPrompt EvalPrompt where
    showXPrompt :: EvalPrompt -> String
showXPrompt EvalPrompt
EvalPrompt = String
"Eval: "

-- | A prompt that evaluates the entered Haskell expression, whose type has
-- to be an instance of Show.
evalPrompt :: EvalConfig -> XPConfig -> X ()
evalPrompt :: EvalConfig -> XPConfig -> X ()
evalPrompt EvalConfig
evc XPConfig
c = EvalConfig -> XPConfig -> (String -> X ()) -> X ()
evalPromptWithOutput EvalConfig
evc XPConfig
c (X () -> String -> X ()
forall a b. a -> b -> a
const (X () -> String -> X ()) -> X () -> String -> X ()
forall a b. (a -> b) -> a -> b
$ () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | The same as 'evalPrompt', but lets the user supply a function to be
-- executed on the returned string, which is produced by applying show
-- to the executed expression. (This is a crude solution, but the returned
-- type has to be monomorphic)
evalPromptWithOutput :: EvalConfig -> XPConfig -> (String -> X ()) -> X ()
evalPromptWithOutput :: EvalConfig -> XPConfig -> (String -> X ()) -> X ()
evalPromptWithOutput EvalConfig
evc XPConfig
c String -> X ()
f =
  (Maybe String -> (String -> X ()) -> X ())
-> (String -> X ()) -> Maybe String -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust String -> X ()
f (Maybe String -> X ()) -> X (Maybe String) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EvalPrompt
-> XPConfig
-> ComplFunction
-> (String -> X String)
-> X (Maybe String)
forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
mkXPromptWithReturn EvalPrompt
EvalPrompt XPConfig
c (IO [String] -> ComplFunction
forall a b. a -> b -> a
const (IO [String] -> ComplFunction) -> IO [String] -> ComplFunction
forall a b. (a -> b) -> a -> b
$ [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (EvalConfig -> String -> X String
evalExpressionWithReturn EvalConfig
evc)

-- | A nice default to have the result of an expression displayed by dzen,
-- if it's interesting (i.e. not () or an empty string).
-- The first parameter specifies the display time in microseconds, the second parameter
-- allows to pass additional options to dzen.
showWithDzen :: Int -> [String] -> String -> X ()
showWithDzen :: Int -> [String] -> String -> X ()
showWithDzen Int
t [String]
args String
"Error" = String -> [String] -> Int -> X ()
dzenWithArgs String
"Error" ([String
"-bg",String
"#ff0000",String
"-fg",String
"#000000"][String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
args) Int
t
showWithDzen Int
t [String]
args String
s | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"",String
"()"] = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      | Bool
otherwise = String -> [String] -> Int -> X ()
dzenWithArgs String
s ([String
"-bg",String
"#00c600",String
"-fg",String
"#000000"][String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
args) Int
t