-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.StringProp
-- Description :  Internal utility functions for storing Strings with the root window.
-- Copyright   :  (c) Nicolas Pouillard 2009
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Nicolas Pouillard <nicolas.pouillard@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Internal utility functions for storing Strings with the root window.
--
-- Used for global state like IORefs with string keys, but more latency,
-- persistent between xmonad restarts.

module XMonad.Util.StringProp (
    StringProp,
    getStringProp, setStringProp,
    getStringListProp, setStringListProp,
    ) where

import XMonad
import Foreign.C.String (castCCharToChar,castCharToCChar)

type StringProp = String

withStringProp :: (MonadIO m) => StringProp -> Display -> (Window -> Atom -> m b) -> m b
withStringProp :: forall (m :: * -> *) b.
MonadIO m =>
StringProp -> Display -> (Window -> Window -> m b) -> m b
withStringProp StringProp
prop Display
dpy Window -> Window -> m b
f = do
    Window
rootw <- IO Window -> m Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber -> IO Window
rootWindow Display
dpy (ScreenNumber -> IO Window) -> ScreenNumber -> IO Window
forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
dpy
    Window
a     <- IO Window -> m Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ Display -> StringProp -> Bool -> IO Window
internAtom Display
dpy StringProp
prop Bool
False
    Window -> Window -> m b
f Window
rootw Window
a

-- | Set the value of a string property.
setStringProp :: (MonadIO m) => Display -> StringProp -> [Char] -> m ()
setStringProp :: forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> StringProp -> m ()
setStringProp Display
dpy StringProp
prop StringProp
string =
  StringProp -> Display -> (Window -> Window -> m ()) -> m ()
forall (m :: * -> *) b.
MonadIO m =>
StringProp -> Display -> (Window -> Window -> m b) -> m b
withStringProp StringProp
prop Display
dpy ((Window -> Window -> m ()) -> m ())
-> (Window -> Window -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Window
rootw Window
a ->
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CChar] -> IO ()
changeProperty8 Display
dpy Window
rootw Window
a Window
a CInt
propModeReplace ([CChar] -> IO ()) -> [CChar] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char -> CChar) -> StringProp -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar StringProp
string

-- | Get the name of a string property and returns it as a 'Maybe'.
getStringProp :: (MonadIO m) => Display -> StringProp -> m (Maybe [Char])
getStringProp :: forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> m (Maybe StringProp)
getStringProp Display
dpy StringProp
prop =
  StringProp
-> Display
-> (Window -> Window -> m (Maybe StringProp))
-> m (Maybe StringProp)
forall (m :: * -> *) b.
MonadIO m =>
StringProp -> Display -> (Window -> Window -> m b) -> m b
withStringProp StringProp
prop Display
dpy ((Window -> Window -> m (Maybe StringProp))
 -> m (Maybe StringProp))
-> (Window -> Window -> m (Maybe StringProp))
-> m (Maybe StringProp)
forall a b. (a -> b) -> a -> b
$ \Window
rootw Window
a -> do
    Maybe [CChar]
p <- IO (Maybe [CChar]) -> m (Maybe [CChar])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CChar]) -> m (Maybe [CChar]))
-> IO (Maybe [CChar]) -> m (Maybe [CChar])
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 Display
dpy Window
a Window
rootw
    Maybe StringProp -> m (Maybe StringProp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StringProp -> m (Maybe StringProp))
-> Maybe StringProp -> m (Maybe StringProp)
forall a b. (a -> b) -> a -> b
$ (CChar -> Char) -> [CChar] -> StringProp
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar ([CChar] -> StringProp) -> Maybe [CChar] -> Maybe StringProp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CChar]
p

-- | Given a property name, returns its contents as a list. It uses the empty
-- list as default value.
getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String]
getStringListProp :: forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> m [StringProp]
getStringListProp Display
dpy StringProp
prop = [StringProp]
-> (StringProp -> [StringProp]) -> Maybe StringProp -> [StringProp]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] StringProp -> [StringProp]
words (Maybe StringProp -> [StringProp])
-> m (Maybe StringProp) -> m [StringProp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> StringProp -> m (Maybe StringProp)
forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> m (Maybe StringProp)
getStringProp Display
dpy StringProp
prop

-- | Given a property name and a list, sets the value of this property with
-- the list given as argument.
setStringListProp :: (MonadIO m) => Display -> StringProp -> [String] -> m ()
setStringListProp :: forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> [StringProp] -> m ()
setStringListProp Display
dpy StringProp
prop [StringProp]
str = Display -> StringProp -> StringProp -> m ()
forall (m :: * -> *).
MonadIO m =>
Display -> StringProp -> StringProp -> m ()
setStringProp Display
dpy StringProp
prop ([StringProp] -> StringProp
unwords [StringProp]
str)