{-# 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