aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/XPlus.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Internal/XPlus.hs')
-rw-r--r--src/Internal/XPlus.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/src/Internal/XPlus.hs b/src/Internal/XPlus.hs
new file mode 100644
index 0000000..c546665
--- /dev/null
+++ b/src/Internal/XPlus.hs
@@ -0,0 +1,53 @@
+module Internal.XPlus where
+
+import Internal.Marking
+import XMonad
+
+-- The X Monad with additional information. Used for configuring the system.
+
+data XPlusState l =
+ XPlusState {
+ markContext :: MarkContext
+ , xConfig :: XConfig l
+ }
+
+data XPlus l a = XPlus (XPlusState l -> X (a, XPlusState l))
+
+instance Functor (XPlus l) where
+ fmap fn (XPlus xfn) =
+ XPlus $ \st -> do
+ (a, b) <- xfn st
+ return (fn a, b)
+
+instance Applicative (XPlus l) where
+ pure = return
+ (<*>) afn aarg = do
+ fn <- afn
+ arg <- aarg
+ return (fn arg)
+
+instance Monad (XPlus l) where
+ -- (>>=) :: XPlus l a -> (a -> XPlus l b) -> XPlus l b
+ (>>=) (XPlus afn) bfn = do
+ XPlus $ \s0 -> do
+ (a, s1) <- afn s0
+ let (XPlus xBFn) = bfn a
+ xBFn s1
+
+ return x = XPlus $ \s -> return (x, s)
+
+getXPlusState :: XPlus l (XPlusState l)
+getXPlusState = XPlus $ \s -> return (s, s)
+
+getXConfig :: XPlus l (XConfig l)
+getXConfig = xConfig <$> getXPlusState
+
+getMarkContext :: XPlus l MarkContext
+getMarkContext = markContext <$> getXPlusState
+
+runXPlus :: MarkContext -> XConfig l -> XPlus l a -> X a
+runXPlus markCtx cfg (XPlus fn) = do
+ fst <$> fn (XPlusState markCtx cfg)
+
+liftXPlus :: X a -> XPlus l a
+liftXPlus xa = XPlus $ \s -> (\a -> (a, s)) <$> xa