{-# 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 phantom type @s@, representing state, saved in
-- window.
newtype StateQuery s a = StateQuery {
      forall s a. StateQuery s a -> Query a
getQuery :: Query a
    } deriving (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, 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, 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 -> 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 = forall a. ReaderT Window X a -> Query a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Query a -> Window -> X a
runQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (Window -> X a) -> Query a
packIntoQuery forall a b. (a -> b) -> a -> b
$ \Window
win -> forall a. X a -> X (Maybe a)
userCode forall a b. (a -> b) -> a -> b
$ 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 = forall s a. Query a -> StateQuery s a
StateQuery  forall a b. (a -> b) -> a -> b
$ Read s => String -> Maybe s
read' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe s -> Query String
get' forall a. HasCallStack => a
undefined where
        get'   :: Maybe s -> Query String
        get' :: Maybe s -> Query String
get' Maybe s
x = String -> Query String
stringProperty (forall a. Typeable a => a -> String
typePropertyName Maybe s
x)
        read'  :: (Read s) => String -> Maybe s
        read' :: Read s => String -> Maybe s
read' String
"" = forall a. Maybe a
Nothing
        read' String
s  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
s
    put :: Maybe s -> StateQuery s ()
put = forall s a. Query a -> StateQuery s a
StateQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Window -> X a) -> Query a
packIntoQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. Typeable a => a -> String
typePropertyName Maybe a
val
            strValue :: String
strValue = forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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__" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (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 = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
                                 Display -> String -> Bool -> IO Window
internAtom Display
d String
prop Bool
False 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