Merge branch 'master' of github.com:jrahm/xmonad-jrahm

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