From cd08ed8a005a38e54231f71dbe24e15d251bfbdd Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Fri, 25 Feb 2011 19:44:32 +0100
Subject: Allow spawning processes bound to workspaces

---
 lib/Storage.hs | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)
 create mode 100644 lib/Storage.hs

(limited to 'lib/Storage.hs')

diff --git a/lib/Storage.hs b/lib/Storage.hs
new file mode 100644
index 0000000..6a8608b
--- /dev/null
+++ b/lib/Storage.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TypeSynonymInstances, MultiParamTypeClasses, ScopedTypeVariables, FlexibleInstances, PatternGuards #-}
+
+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 qualified Data.Map as M
+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 :: StorageMessage d) <- fromMessage m = do
+      io $ writeIORef ref $ Just d
+      return $ Nothing
+
+    | Just (SetStoreData d' :: StorageMessage 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
+
+
+getStoreData :: StoreData d => X (Maybe d)
+getStoreData = do
+  ref <- io . newIORef $ Nothing
+  broadcastMessage $ 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
\ No newline at end of file
-- 
cgit v1.2.3