{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving,
  FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Util.WindowState
-- Description  :  Functions for saving per-window data.
-- Copyright    : (c) Dmitry Bogatov <KAction@gnu.org>
-- License      : BSD
--
-- Maintainer   : Dmitry Bogatov <KAction@gnu.org>
-- Stability    : unstable
-- Portability  : unportable
--
-- Functions for saving per-window data.
-----------------------------------------------------------------------------

module XMonad.Util.WindowState ( -- * Usage
                                 -- $usage
                                 get,
                                 put,
                                 StateQuery(..),
                                 runStateQuery,
                                 catchQuery ) where
import XMonad hiding (get, put, modify)
import Control.Monad.Reader(ReaderT(..))
import Control.Monad.State.Class
import Data.Typeable (typeOf)
-- $usage
--
-- This module allow to store state data with some 'Window'.
-- It is implemented with XProperties, so resources will be freed when
-- 'Window' is destoyed.
--
-- This module have advantage over "XMonad.Actions.TagWindows" in that it
-- hides from you implementation details and provides simple type-safe
-- interface.  Main datatype is "StateQuery", which is simple wrapper around
-- "Query", which is instance of MonadState, with 'put' and 'get' are
-- functions to acess data, stored in "Window".
--
-- To save some data in window you probably want to do following:
-- > (runStateQuery  (put $ Just value)  win) :: X ()
-- To retrive it, you can use
-- > (runStateQuery get win) :: X (Maybe YourValueType)
-- "Query" can be promoted to "StateQuery" simply by constructor,
-- and reverse is 'getQuery'.
--
-- For example, I use it to have all X applications @russian@ or @dvorak@
-- layout, but emacs have only @us@, to not screw keybindings. Use your
-- imagination!

-- | Wrapper around "Query" with phanom type @s@, representing state, saved in
-- window.
newtype StateQuery s a = StateQuery {
      forall s a. StateQuery s a -> Query a
getQuery :: Query a
    } deriving (Applicative (StateQuery s)
Applicative (StateQuery s)
-> (forall a b.
    StateQuery s a -> (a -> StateQuery s b) -> StateQuery s b)
-> (forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b)
-> (forall a. a -> StateQuery s a)
-> Monad (StateQuery s)
forall {s}. Applicative (StateQuery s)
forall a. a -> StateQuery s a
forall s a. a -> StateQuery s a
forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b
forall a b.
StateQuery s a -> (a -> StateQuery s b) -> StateQuery s b
forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s b
forall s a b.
StateQuery s a -> (a -> StateQuery s b) -> StateQuery s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> StateQuery s a
$creturn :: forall s a. a -> StateQuery s a
>> :: forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b
$c>> :: forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s b
>>= :: forall a b.
StateQuery s a -> (a -> StateQuery s b) -> StateQuery s b
$c>>= :: forall s a b.
StateQuery s a -> (a -> StateQuery s b) -> StateQuery s b
Monad, Monad (StateQuery s)
Monad (StateQuery s)
-> (forall a. IO a -> StateQuery s a) -> MonadIO (StateQuery s)
forall s. Monad (StateQuery s)
forall a. IO a -> StateQuery s a
forall s a. IO a -> StateQuery s a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> StateQuery s a
$cliftIO :: forall s a. IO a -> StateQuery s a
MonadIO, Functor (StateQuery s)
Functor (StateQuery s)
-> (forall a. a -> StateQuery s a)
-> (forall a b.
    StateQuery s (a -> b) -> StateQuery s a -> StateQuery s b)
-> (forall a b c.
    (a -> b -> c)
    -> StateQuery s a -> StateQuery s b -> StateQuery s c)
-> (forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b)
-> (forall a b. StateQuery s a -> StateQuery s b -> StateQuery s a)
-> Applicative (StateQuery s)
forall {s}. Functor (StateQuery s)
forall a. a -> StateQuery s a
forall s a. a -> StateQuery s a
forall a b. StateQuery s a -> StateQuery s b -> StateQuery s a
forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b
forall a b.
StateQuery s (a -> b) -> StateQuery s a -> StateQuery s b
forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s a
forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s b
forall s a b.
StateQuery s (a -> b) -> StateQuery s a -> StateQuery s b
forall a b c.
(a -> b -> c) -> StateQuery s a -> StateQuery s b -> StateQuery s c
forall s a b c.
(a -> b -> c) -> StateQuery s a -> StateQuery s b -> StateQuery s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. StateQuery s a -> StateQuery s b -> StateQuery s a
$c<* :: forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s a
*> :: forall a b. StateQuery s a -> StateQuery s b -> StateQuery s b
$c*> :: forall s a b. StateQuery s a -> StateQuery s b -> StateQuery s b
liftA2 :: forall a b c.
(a -> b -> c) -> StateQuery s a -> StateQuery s b -> StateQuery s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> StateQuery s a -> StateQuery s b -> StateQuery s c
<*> :: forall a b.
StateQuery s (a -> b) -> StateQuery s a -> StateQuery s b
$c<*> :: forall s a b.
StateQuery s (a -> b) -> StateQuery s a -> StateQuery s b
pure :: forall a. a -> StateQuery s a
$cpure :: forall s a. a -> StateQuery s a
Applicative, (forall a b. (a -> b) -> StateQuery s a -> StateQuery s b)
-> (forall a b. a -> StateQuery s b -> StateQuery s a)
-> Functor (StateQuery s)
forall a b. a -> StateQuery s b -> StateQuery s a
forall a b. (a -> b) -> StateQuery s a -> StateQuery s b
forall s a b. a -> StateQuery s b -> StateQuery s a
forall s a b. (a -> b) -> StateQuery s a -> StateQuery s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StateQuery s b -> StateQuery s a
$c<$ :: forall s a b. a -> StateQuery s b -> StateQuery s a
fmap :: forall a b. (a -> b) -> StateQuery s a -> StateQuery s b
$cfmap :: forall s a b. (a -> b) -> StateQuery s a -> StateQuery s b
Functor)

packIntoQuery :: (Window -> X a) -> Query a
packIntoQuery :: forall a. (Window -> X a) -> Query a
packIntoQuery = ReaderT Window X a -> Query a
forall a. ReaderT Window X a -> Query a
Query (ReaderT Window X a -> Query a)
-> ((Window -> X a) -> ReaderT Window X a)
-> (Window -> X a)
-> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> X a) -> ReaderT Window X a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT

-- | Apply "StateQuery" to "Window".
runStateQuery :: StateQuery s a -> Window ->  X a
runStateQuery :: forall s a. StateQuery s a -> Window -> X a
runStateQuery = Query a -> Window -> X a
forall a. Query a -> Window -> X a
runQuery (Query a -> Window -> X a)
-> (StateQuery s a -> Query a) -> StateQuery s a -> Window -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateQuery s a -> Query a
forall s a. StateQuery s a -> Query a
getQuery

-- | Lifted to "Query" version of 'catchX'
catchQuery :: Query a -> Query (Maybe a)
catchQuery :: forall a. Query a -> Query (Maybe a)
catchQuery Query a
q = (Window -> X (Maybe a)) -> Query (Maybe a)
forall a. (Window -> X a) -> Query a
packIntoQuery ((Window -> X (Maybe a)) -> Query (Maybe a))
-> (Window -> X (Maybe a)) -> Query (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Window
win -> X a -> X (Maybe a)
forall a. X a -> X (Maybe a)
userCode (X a -> X (Maybe a)) -> X a -> X (Maybe a)
forall a b. (a -> b) -> a -> b
$ Query a -> Window -> X a
forall a. Query a -> Window -> X a
runQuery Query a
q Window
win

-- | Instance of MonadState for StateQuery.
instance (Show s, Read s, Typeable s) => MonadState (Maybe s) (StateQuery s) where
    get :: StateQuery s (Maybe s)
get = Query (Maybe s) -> StateQuery s (Maybe s)
forall s a. Query a -> StateQuery s a
StateQuery  (Query (Maybe s) -> StateQuery s (Maybe s))
-> Query (Maybe s) -> StateQuery s (Maybe s)
forall a b. (a -> b) -> a -> b
$ Read s => String -> Maybe s
String -> Maybe s
read' (String -> Maybe s) -> Query String -> Query (Maybe s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s -> Query String
get' Maybe s
forall a. HasCallStack => a
undefined where
        get'   :: Maybe s -> Query String
        get' :: Maybe s -> Query String
get' Maybe s
x = String -> Query String
stringProperty (Maybe s -> String
forall a. Typeable a => a -> String
typePropertyName Maybe s
x)
        read'  :: (Read s) => String -> Maybe s
        read' :: Read s => String -> Maybe s
read' String
"" = Maybe s
forall a. Maybe a
Nothing
        read' String
s  = s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> s -> Maybe s
forall a b. (a -> b) -> a -> b
$ String -> s
forall a. Read a => String -> a
read String
s
    put :: Maybe s -> StateQuery s ()
put = Query () -> StateQuery s ()
forall s a. Query a -> StateQuery s a
StateQuery (Query () -> StateQuery s ())
-> ((Window -> X ()) -> Query ())
-> (Window -> X ())
-> StateQuery s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> X ()) -> Query ()
forall a. (Window -> X a) -> Query a
packIntoQuery ((Window -> X ()) -> StateQuery s ())
-> (Maybe s -> Window -> X ()) -> Maybe s -> StateQuery s ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s -> Window -> X ()
forall {a}. (Show a, Typeable a) => Maybe a -> Window -> X ()
setWindowProperty' where
        setWindowProperty' :: Maybe a -> Window -> X ()
setWindowProperty' Maybe a
val = String -> String -> Window -> X ()
setWindowProperty String
prop String
strValue where
            prop :: String
prop = Maybe a -> String
forall a. Typeable a => a -> String
typePropertyName Maybe a
val
            strValue :: String
strValue = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" a -> String
forall a. Show a => a -> String
show Maybe a
val

typePropertyName :: (Typeable a) => a -> String
typePropertyName :: forall a. Typeable a => a -> String
typePropertyName a
x = String
"_XMONAD_WINSTATE__" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x)

type PropertyName = String
setWindowProperty :: PropertyName -> String -> Window -> X ()
setWindowProperty :: String -> String -> Window -> X ()
setWindowProperty String
prop String
val Window
win = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$
                                 Display -> String -> Bool -> IO Window
internAtom Display
d String
prop Bool
False IO Window -> (Window -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                 Display -> Window -> String -> Window -> IO ()
setTextProperty Display
d Window
win String
val