Move logic from Keys.hs to Lib.hs.

Added an monad XPlus that holds extra state with the
MarkContext, etc. This should make it easier to handle
as more and more state accrues over time.

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