diff options
Diffstat (limited to 'src/Internal/XPlus.hs')
| -rw-r--r-- | src/Internal/XPlus.hs | 53 |
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 |