68 lines
No EOL
1.9 KiB
Haskell
68 lines
No EOL
1.9 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, PatternGuards, DatatypeContexts #-}
|
|
|
|
module Storage ( StoreData
|
|
, Storage
|
|
, storage
|
|
, getStoreData
|
|
, setStoreData
|
|
, updateStoreData
|
|
) where
|
|
|
|
import XMonad
|
|
import qualified XMonad.StackSet as W
|
|
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
|
|
|
|
import Control.Applicative ((<$>))
|
|
import Control.Monad
|
|
|
|
import Data.IORef
|
|
import Data.Maybe
|
|
import Data.Typeable
|
|
|
|
|
|
class (Typeable d, Show d, Read d) => StoreData d
|
|
|
|
|
|
data (StoreData d) => StorageMessage d = GetStoreData (IORef (Maybe d)) | SetStoreData d
|
|
deriving Typeable
|
|
instance (StoreData d) => Message (StorageMessage d)
|
|
|
|
|
|
data (StoreData d) => Storage d a = Storage d deriving (Show, Read)
|
|
|
|
instance (StoreData d) => LayoutModifier (Storage d) a where
|
|
modifierDescription _ = "Storage"
|
|
|
|
handleMess (Storage d) m
|
|
| Just (GetStoreData ref) <- fromMessage m = do
|
|
io $ writeIORef ref $ Just d
|
|
return $ Nothing
|
|
|
|
| Just (SetStoreData d') <- fromMessage m = do
|
|
return $ Just $ Storage d'
|
|
|
|
handleMess _ _ = return Nothing
|
|
|
|
|
|
storage :: (LayoutClass l a, StoreData d) => d -> l a -> ModifiedLayout (Storage d) l a
|
|
storage def = ModifiedLayout $ Storage def
|
|
|
|
|
|
sendMessage' :: Message a => a -> X ()
|
|
sendMessage' a = W.workspace . W.current <$> gets windowset >>= sendMessageWithNoRefresh a
|
|
|
|
|
|
getStoreData :: StoreData d => X (Maybe d)
|
|
getStoreData = do
|
|
ref <- io . newIORef $ Nothing
|
|
sendMessage' $ GetStoreData ref
|
|
io . readIORef $ ref
|
|
|
|
|
|
setStoreData :: StoreData d => d -> X ()
|
|
setStoreData = broadcastMessage . SetStoreData
|
|
|
|
updateStoreData :: StoreData d => (d -> d) -> X ()
|
|
updateStoreData f = do
|
|
d <- getStoreData
|
|
when (isJust d) $ setStoreData . f $ fromJust d |