diff options
author | Spencer Janssen <spencerjanssen@gmail.com> | 2008-09-17 10:18:38 +0200 |
---|---|---|
committer | Spencer Janssen <spencerjanssen@gmail.com> | 2008-09-17 10:18:38 +0200 |
commit | faabea241a4df52a360255f76ce70bf8014eebdb (patch) | |
tree | 270fd5bfcec9b329870318412bba723c9aa8480f | |
parent | 77fbe236449437a590e4267f97bdd985246ff1b9 (diff) | |
download | XMonadContrib-faabea241a4df52a360255f76ce70bf8014eebdb.tar.gz XMonadContrib-faabea241a4df52a360255f76ce70bf8014eebdb.tar.xz XMonadContrib-faabea241a4df52a360255f76ce70bf8014eebdb.zip |
Sketch of XMonad.Config.Monad
darcs-hash:20080917081838-25a6b-de782d7b8398c109500fefc89ad0cf5cde825fb2.gz
-rw-r--r-- | XMonad/Config/Monad.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/XMonad/Config/Monad.hs b/XMonad/Config/Monad.hs new file mode 100644 index 0000000..db29097 --- /dev/null +++ b/XMonad/Config/Monad.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- experimental, not expected to work + +{- our goal: +config = do + add layout Full + set terminal "urxvt" + add keys [blah blah blah] +-} + +{- +ideas: + composability! + "only once" features like avoidStruts, ewmhDesktops +-} + +module XMonad.Config.Monad where + +import XMonad hiding (terminal, keys) +import qualified XMonad as X +import Control.Monad.Writer +import Data.Monoid +import Data.Accessor +import Data.Accessor.Basic hiding (set) + +-- Ugly! To fix this we'll need to change the kind of XConfig. +newtype LayoutList a = LL [Layout a] deriving Monoid + +type W = Dual (Endo (XConfig LayoutList)) +mkW = Dual . Endo + +newtype Config a = C (WriterT W IO a) + deriving (Functor, Monad, MonadWriter W) + +-- references: +layout = fromSetGet (\x c -> c { layoutHook = x }) layoutHook +terminal = fromSetGet (\x c -> c { X.terminal = x }) X.terminal +keys = fromSetGet (\x c -> c { X.keys = x }) X.keys + +set :: Accessor (XConfig LayoutList) a -> a -> Config () +set r x = tell (mkW $ r ^= x) +add r x = tell (mkW (r ^: mappend x)) + +-- +example :: Config () +example = do + add layout $ LL [Layout $ Full] -- make this better + set terminal "urxvt" |