{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
{- |
Module : XMonad.Util.WindowState2
Copyright : (c) Dmitry Bogatov <KAction@gnu.org>
License : GPL3
Maintainer : Dmitry Bogatov <KAction@gnu.org>
Stability : unstable
Portability : unportable
Functions for saving and retriving arbitary data in windows.
This module have advantage over `XMonad.Actions.TagWindows' in that it
hides from you implementation details and provides simple type-safe
interface.
-}
-----------------------------------------------------------------------------
module XMonad.Util.WindowState2
(
-- * Usage
-- $usage
stateQuery,
unstate,
runStateQuery,
get, put, modify) where
import XMonad hiding (get, put, modify)
import Control.Monad.Reader(ReaderT(..))
import Control.Monad.State.Class
import Data.Typeable (typeOf, TypeRep)
import Control.Applicative
import Control.Monad
import Data.Proxy
{-| $usage
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".
Data to store and retrieve is serialized to XProperties 'String's together
with its type, so it must be instance of `Typeable', `Show' and `Read'.
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 "stateQuery",
and reverse is 'unstate'.
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 { unstate :: Query a }
deriving instance Functor (StateQuery s)
deriving instance Monad (StateQuery s)
deriving instance MonadIO (StateQuery s)
-- to silent GHC 7.8. It will break under 7.10.
instance Applicative (StateQuery s) where
pure = return
(<*>) = ap
-- | Same, as "runQuery".
runStateQuery :: StateQuery s a -> Window -> X a
runStateQuery = runQuery . unstate
-- | Lift Query to StateQuery.
stateQuery :: Query a -> StateQuery s a
stateQuery = StateQuery
-- | Read, if string is not empty, Nothing otherwise
maybeRead :: (Read s) => String -> Maybe s
maybeRead "" = Nothing
maybeRead str = Just (read str)
getData :: forall s. (Show s, Read s, Typeable s) => Query (Maybe s)
getData = maybeRead <$> typedPropertyString (Proxy :: Proxy s)
putData :: forall s. (Show s, Read s, Typeable s) => Maybe s -> Query ()
putData val = let valueRepr = maybe "" show val in
setTypedPropertyString (Proxy :: Proxy s) valueRepr
instance (Show s, Read s, Typeable s)
=> MonadState (Maybe s) (StateQuery s) where
put val = stateQuery (putData val)
get = stateQuery getData
type PropertyKey = String
type PropertyString = String
-- | Return representation of type, corresponding to given proxy.
proxyTypeOf :: (Typeable a) => Proxy a -> TypeRep
proxyTypeOf p = typeOf $ undefined `asProxyTypeOf` p
-- | Return key to store type of proxy.
typedPropertyKey :: (Typeable a) => Proxy a -> PropertyKey
typedPropertyKey proxy = "__XMONAD_WINSTATE__" ++ show (proxyTypeOf proxy)
-- | Get value for type of proxy.
typedPropertyString :: (Typeable a) => Proxy a -> Query PropertyString
typedPropertyString = stringProperty . typedPropertyKey
-- | Set value for type of proxy.
setTypedPropertyString :: (Typeable a) => Proxy a -> PropertyString -> Query ()
setTypedPropertyString = setStringProperty . typedPropertyKey
-- | Missing complement function to "stringProperty", which do all hard work.
setStringProperty :: PropertyKey -> PropertyString -> Query ()
setStringProperty prop val = Query . ReaderT $ \win ->
withDisplay $ \d -> io $
internAtom d prop False >>=
setTextProperty d win val