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