diff options
| -rw-r--r-- | Main.hs | 20 | ||||
| -rw-r--r-- | WMonad.hs | 46 |
2 files changed, 31 insertions, 35 deletions
@@ -147,14 +147,18 @@ refresh :: W () refresh = do ws <- gets workspace whenJust (W.peek ws) $ \w -> - withScreen $ \(d,sw,sh) -> io $ do - moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen - raiseWindow d w + withDisplay $ \d -> do + sw <- gets screenWidth + sh <- gets screenHeight + io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen + raiseWindow d w -- | hide. Hide a list of windows by moving them offscreen. hide :: Window -> W () -hide w = withScreen $ \(dpy,sw,sh) -> io $ - moveWindow dpy w (2*fromIntegral sw) (2*fromIntegral sh) +hide w = withDisplay $ \d -> do + sw <- gets screenWidth + sh <- gets screenHeight + io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh) -- | reveal. Expose a list of windows, moving them on screen reveal :: Window -> W () @@ -162,7 +166,11 @@ reveal w = withDisplay $ \d -> io $ moveWindow d w 0 0 -- | windows. Modify the current window list with a pure function, and refresh windows :: (WorkSpace -> WorkSpace) -> W () -windows f = modifyWorkspace f >> refresh +windows f = do + modify $ \s -> s { workspace = f (workspace s) } + ws <- gets workspace + refresh + trace (show ws) -- log state changes to stderr -- --------------------------------------------------------------------- -- Window operations @@ -14,7 +14,10 @@ -- manager state, and support routines. -- -module WMonad where +module WMonad ( + W, WorkSpace, WState(..), + runW, withDisplay, io, io_, forever, spawn, trace, whenJust + ) where import StackSet (StackSet) @@ -36,13 +39,19 @@ type WorkSpace = StackSet Window -- | The W monad, a StateT transformer over IO encapuslating the window -- manager state -newtype W a = W { unW :: StateT WState IO a } +newtype W a = W (StateT WState IO a) deriving (Functor, Monad, MonadIO, MonadState WState) -- | Run the W monad, given a chunk of W monad code, and an initial state -- Return the result, and final state runW :: WState -> W a -> IO (a, WState) -runW st a = runStateT (unW a) st +runW st (W a) = runStateT a st + +-- | Run a monad action with the current display settings +withDisplay :: (Display -> W ()) -> W () +withDisplay f = gets display >>= f + +------------------------------------------------------------------------ -- | Lift an IO action into the W monad io :: IO a -> W a @@ -60,33 +69,12 @@ forever a = a >> forever a spawn :: String -> W () spawn = io_ . runCommand --- | A 'trace' for the W monad. Logs a string to stderr. The result may --- be found in your .xsession-errors file -trace :: String -> W () -trace msg = io $ do - hPutStrLn stderr msg - hFlush stderr - --- | Run a monad action with the current display settings -withDisplay :: (Display -> W ()) -> W () -withDisplay f = gets display >>= f - --- | Run a monadic action with the display, screen width and height -withScreen :: ((Display,Int,Int) -> W ()) -> W () -withScreen f = do - d <- gets display - sw <- gets screenWidth - sh <- gets screenHeight - f (d,sw,sh) - --- | Modify the workspace list. -modifyWorkspace :: (WorkSpace -> WorkSpace) -> W () -modifyWorkspace f = do - modify $ \s -> s { workspace = f (workspace s) } - ws <- gets workspace - trace (show ws) -- log state changes to stderr - -- | Run a side effecting action with the current workspace. Like 'when' but whenJust :: Maybe a -> (a -> W ()) -> W () whenJust mg f = maybe (return ()) f mg + +-- | A 'trace' for the W monad. Logs a string to stderr. The result may +-- be found in your .xsession-errors file +trace :: String -> W () +trace msg = io $ do hPutStrLn stderr msg; hFlush stderr |