[wip] rewrite plugin to a more scalable architecture.

33 files changed, 583 insertions, 2607 deletions

diff --git a/plug/src/Config.hs b/plug/src/Config.hs
index 70920fd..0904ded 100644
--- a/plug/src/Config.hs
+++ b/plug/src/Config.hs
@@ -1,88 +1,18 @@
-module Config (config) where
+module Config () where
 
-import Control.Monad (unless)
-import Data.Bits
-import Data.Data (Proxy (Proxy))
-import Montis.Core.ButtonEvent as ButtonEvent
-import Montis.Core.KeyEvent as KeyEvent
-import Montis.Core.W
-import Montis.Dsl.Bind
-import Montis.Dsl.Input
-import Montis.Keys.Macros
-import Montis.Keys.MagicModifierKey
-import Montis.Layout.Full
-import Montis.Core.Runtime (requestHotReload)
+import Montis.Core
 
-config :: Config WindowLayout
-config =
-  defaultConfig
-    { hooks =
-        defaultHooks
-          { surfaceHook = do
-              handleSurface
-          },
-      layout = WindowLayout Full,
-      resetHook = do
-        useInputHandler $
-          withProxies inputProxies $ do
-            ev <- nextInputEvent
+foreign export ccall "plugin_cold_start"
+  coldStart :: MontisColdStart
 
-            bind ev (released btnLeft) $
-              run $
-                wio $
-                  putStrLn "Left Button Released!!"
+foreign export ccall "plugin_hot_start"
+  hotStart :: MontisHotStart
 
-            unless (isPressEvent ev) $ do
-              forwardEvent ev
-              continue
+coldStart :: MontisColdStart
+coldStart = coldStartMontis config
 
-            bind ev (Shift .+ Mod1 .+ 'R') $ run requestHotReload
+hotStart :: MontisHotStart
+hotStart = hotStartMontis config
 
-            -- bind ev (Mod1 .+ 't') $ run (shellExec "alacritty")
-
-            bind ev (Mod1 .+ 'p') $ do
-              ev2 <- nextInputPressEvent
-
-              bind ev2 (Mod1 .+ 'p') $
-                run $
-                  wio $
-                    putStrLn "Test"
-
-            bind ev (Mod1 .+ btnLeft) $
-              run $
-                wio $
-                  putStrLn "Left Button Press!!"
-
-            bind ev (Mod1 .+ 'q') macroStartStopKeybind
-
-            bind ev (weak $ Mod1 .+ '@') macroReplayKeybind
-
-            bind ev (weak $ ModX 5 .+ btnLeft) $
-              run $
-                wio $
-                  putStrLn "Fake Modifier With Button!!!"
-
-            bind ev (weak $ ModX 5 .+ 't') $
-              run $
-                wio $
-                  putStrLn "Fake Modifier!!"
-
-            forwardEvent ev
-    }
-  where
-    inputProxies ::
-      Proxy
-        '[ MacroSupport,
-           MagicModifierProxy 59 SetXtra -- Only log keys when F1 (keycode 59 is pressed)
-         ]
-    inputProxies = Proxy
-
-data SetXtra
-
-instance InputProxy SetXtra where
-  onKeyEvent _ ie =
-    case ie of
-      (InputKeyEvent ke@(KeyEvent {KeyEvent.modifiers = modifiers})) ->
-        return $ InputKeyEvent ke {KeyEvent.modifiers = modifiers .|. modifierToMask (ModX 5)}
-      (InputButtonEvent be@(ButtonEvent {ButtonEvent.modifiers = modifiers})) ->
-        return $ InputButtonEvent be {ButtonEvent.modifiers = modifiers .|. modifierToMask (ModX 5)}
+config :: MontisConfig
+config = defaultConfig
diff --git a/plug/src/Lib.hs b/plug/src/Lib.hs
deleted file mode 100644
index d36ff27..0000000
--- a/plug/src/Lib.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Lib
-    ( someFunc
-    ) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
diff --git a/plug/src/Montis/Foreign/Import.hs b/plug/src/Montis/Base/Foreign/Runtime.hs
index e83841b..c43471e 100644
--- a/plug/src/Montis/Foreign/Import.hs
+++ b/plug/src/Montis/Base/Foreign/Runtime.hs
@@ -1,4 +1,4 @@
-module Montis.Foreign.Import where
+module Montis.Base.Foreign.Runtime where
 
 import Data.Void
 import Foreign.C (CInt (..), CString)
@@ -8,6 +8,6 @@ foreign import ccall "montis_do_request_hot_reload" foreign_doRequestHotReload :
 
 foreign import ccall "montis_do_request_log" foreign_doRequestLog :: Ptr Void -> CString -> IO ()
 
-foreign import ccall "montis_do_request_exit" foregin_doExit :: Ptr Void -> CInt -> IO ()
+foreign import ccall "montis_do_request_exit" foreign_doRequestExit :: Ptr Void -> CInt -> IO ()
 
 foreign import ccall "montis_plugin_get_seat" foreign_getSeat :: Ptr Void -> IO (Ptr Void)
diff --git a/plug/src/Montis/Base/Foreign/WlRoots.hs b/plug/src/Montis/Base/Foreign/WlRoots.hs
new file mode 100644
index 0000000..272567f
--- /dev/null
+++ b/plug/src/Montis/Base/Foreign/WlRoots.hs
@@ -0,0 +1,44 @@
+-- | Contains functions and thin wrappers via ffi to the wlroots API.
+module Montis.Base.Foreign.WlRoots where
+
+import Foreign (Ptr, Word32, nullPtr)
+import Montis.Base.Foreign.WlRoots.Types
+
+-- | Converts a null pointer into 'Nothing' to avoid dangling FFI handles.
+guardNull :: Ptr a -> Maybe (Ptr a)
+guardNull p | p == nullPtr = Nothing
+guardNull p = Just p
+
+foreign import ccall "wlr_seat_set_keyboard"
+  foreign_wlrSetSeatKeyboard ::
+    Ptr ForeignWlrSeat -> Ptr ForeignWlrInputDevice -> IO ()
+
+-- | Binds the given input device as the active keyboard for a seat.
+setSeatKeyboard :: WlrSeat -> WlrInputDevice -> IO ()
+setSeatKeyboard (WlrSeat p1) (WlrInputDevice p2) =
+  foreign_wlrSetSeatKeyboard p1 p2
+
+foreign import ccall "wlr_seat_get_keyboard"
+  foreign_wlrSeatGetKeyboard ::
+    Ptr ForeignWlrSeat -> IO (Ptr ForeignWlrKeyboard)
+
+-- | Looks up the current keyboard for a seat, if one exists.
+getSeatKeyboard :: WlrSeat -> IO (Maybe WlrKeyboard)
+getSeatKeyboard (WlrSeat p) =
+  fmap WlrKeyboard . guardNull <$> foreign_wlrSeatGetKeyboard p
+
+foreign import ccall "wlr_keyboard_get_modifiers"
+  foreign_wlrKeyboardGetModifiers ::
+    Ptr ForeignWlrKeyboard -> IO Word32
+
+-- | Returns the current keyboard modifier mask for the keyboard.
+getKeyboardModifiers :: WlrKeyboard -> IO Word32
+getKeyboardModifiers (WlrKeyboard p) = foreign_wlrKeyboardGetModifiers p
+
+foreign import ccall "wlr_seat_keyboard_notify_key"
+  foreign_wlrSeatKeyboardNotifyKey ::
+    Ptr ForeignWlrSeat -> Word32 -> Word32 -> Word32 -> IO ()
+
+-- | Forwards a key event to the seat with time, keycode, and state.
+seatKeyboardNotifyKey :: WlrSeat -> Word32 -> Word32 -> Word32 -> IO ()
+seatKeyboardNotifyKey (WlrSeat p) = foreign_wlrSeatKeyboardNotifyKey p
diff --git a/plug/src/Montis/Base/Foreign/WlRoots/Types.hs b/plug/src/Montis/Base/Foreign/WlRoots/Types.hs
new file mode 100644
index 0000000..51762d5
--- /dev/null
+++ b/plug/src/Montis/Base/Foreign/WlRoots/Types.hs
@@ -0,0 +1,85 @@
+module Montis.Base.Foreign.WlRoots.Types where
+
+import Foreign (IntPtr, Ptr, intPtrToPtr, ptrToIntPtr)
+import Text.Read
+
+-- | Opaque foreign type for a wlroots keyboard.
+data ForeignWlrKeyboard
+
+newtype WlrKeyboard where
+  WlrKeyboard :: Ptr ForeignWlrKeyboard -> WlrKeyboard
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for a wlroots pointer.
+data ForeignWlrPointer
+
+newtype WlrPointer where
+  WlrPointer :: Ptr ForeignWlrPointer -> WlrPointer
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for wlroots pointer button events.
+data ForeignWlrPointerButtonEvent
+
+newtype WlrPointerButtonEvent where
+  WlrPointerButtonEvent :: Ptr ForeignWlrPointerButtonEvent -> WlrPointerButtonEvent
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for a wlroots seat.
+data ForeignWlrSeat
+
+newtype WlrSeat where
+  WlrSeat :: Ptr ForeignWlrSeat -> WlrSeat
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for a wlroots input device.
+data ForeignWlrInputDevice
+
+newtype WlrInputDevice where
+  WlrInputDevice :: Ptr ForeignWlrInputDevice -> WlrInputDevice
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for wlroots keyboard key events.
+data ForeignWlrEventKeyboardKey
+
+newtype WlrEventKeyboardKey where
+  WlrEventKeyboardKey :: Ptr ForeignWlrEventKeyboardKey -> WlrEventKeyboardKey
+  deriving (Show, Ord, Eq)
+
+-- | Opaque foreign type for xdg-shell surfaces.
+data ForeignWlrXdgSurface
+
+-- | Opaque foreign type for XWayland surfaces.
+data ForeignWlrXWaylandSurface
+
+-- | Tagged wrapper over surface pointer variants.
+data Surface where
+  XdgSurface :: Ptr ForeignWlrXdgSurface -> Surface
+  XWaylandSurface :: Ptr ForeignWlrXWaylandSurface -> Surface
+  deriving (Ord, Eq)
+
+instance Show Surface where
+  show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p))
+  show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p))
+
+instance Read Surface where
+  readPrec = fmap toSurf readPrec
+    where
+      -- Rebuild constructors from serialized pointers.
+      toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip)
+      toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip)
+
+-- | Serializable version of 'Surface' to enable Read/Show.
+data SerializableSurface
+  = XdgSerializeSurface IntPtr
+  | XWaylandSerializeSurface IntPtr
+  deriving (Read, Show)
+
+class ForeignSurface a where
+  -- | Converts a foreign surface pointer into the tagged wrapper.
+  toSurface :: Ptr a -> Surface
+
+instance ForeignSurface ForeignWlrXdgSurface where
+  toSurface = XdgSurface
+
+instance ForeignSurface ForeignWlrXWaylandSurface where
+  toSurface = XWaylandSurface
diff --git a/plug/src/Montis/Constraints.hs b/plug/src/Montis/Constraints.hs
deleted file mode 100644
index 242f1fb..0000000
--- a/plug/src/Montis/Constraints.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
--- | Contains useful constraints and constraint combinators for type-level
--- metaprogramming.
-module Montis.Constraints where
-
--- | A null constraint. All types implement this.
-class Unconstrained a
-
-instance Unconstrained a
-
--- | Combines multiple constraints by 'And'ing them together.
-class (c1 a, c2 a) => (&&&&) c1 c2 a
-
-instance (c1 a, c2 a) => (&&&&) c1 c2 a
diff --git a/plug/src/Montis/Core.hs b/plug/src/Montis/Core.hs
index e01d2f7..65dcdad 100644
--- a/plug/src/Montis/Core.hs
+++ b/plug/src/Montis/Core.hs
@@ -1,371 +1,9 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Core where
-
-import Control.Arrow (Arrow (first))
-import Control.Monad ((<=<))
-import Control.Monad.RWS (MonadIO (liftIO), MonadReader (..), MonadState, modify)
-import Control.Monad.Reader (ReaderT (runReaderT))
-import Control.Monad.State (StateT (runStateT), gets, modify')
-import Control.Monad.Trans.Maybe
-import Data.Data (Typeable, cast, tyConModule, tyConName, tyConPackage)
-import Data.Default.Class (Default, def)
-import Data.Kind (Constraint, Type)
-import Data.Map (Map)
-import Data.Map qualified as M
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Proxy
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Singletons.Decide (Void)
-import Foreign (Ptr, StablePtr, intPtrToPtr, ptrToIntPtr)
-import Montis.Core.ButtonEvent (ButtonEvent)
-import Montis.Core.KeyEvent
-import Montis.Core.SurfaceEvent
-import Montis.Foreign.ForeignInterface qualified as ForeignInterface
-import Montis.Foreign.WlRoots (Surface, WlrSeat)
-import Montis.StackSet hiding (layout)
-import Montis.StackSet qualified as StackSet
-import Text.Printf (printf)
-import Text.Read hiding (lift)
-import Type.Reflection (someTypeRep, someTypeRepTyCon)
-
-data RationalRect = RationalRect Rational Rational Rational Rational
-
--- | Wrapper for a message. Messages are sent to layout and layouts are supposed
--- to handle them. This hides a typeable parameter.
-data Message where
-  Message :: (Typeable a) => a -> Message
-
--- | casts a message to a type.
-fromMessage :: (Typeable a) => Message -> Maybe a
-fromMessage (Message t) = cast t
-
--- | Wraps a type in a message.
-toMessage :: (Typeable a) => a -> Message
-toMessage = Message
-
-class (Typeable l) => HandleMessage l where
-  handleMessage :: Message -> l -> MaybeT W l
-  handleMessage _ = return
-
-newtype Window = Window
-  { surface :: Surface
-  }
-  deriving (Show, Ord, Eq, Read)
-
--- | Types of this class "lay out" windows by assigning rectangles and handle
--- messages.
-class (Typeable l, HandleMessage l) => LayoutClass l where
-  -- | Constraints on the type to lay out. Sometimes a layout requires the 'a'
-  -- type to be "Ord", other times "Eq", this is the mechanism by which this
-  -- constraint is expressed.
-  type LayoutConstraint l :: Type -> Constraint
-
-  -- | Runs the layout in an impure way returning a modified layout and the list
-  -- of windows to their rectangles under a monad.
-  runLayout :: (LayoutConstraint l a) => Stack a -> l -> W (l, [(a, RationalRect)])
-
-  readLayout :: String -> Maybe l
-  default readLayout :: (Read l) => String -> Maybe l
-  readLayout = readMaybe
-
-  serializeLayout :: l -> String
-  default serializeLayout :: (Show l) => l -> String
-  serializeLayout = show
-
-  description :: l -> String
-  default description :: (Show l) => l -> String
-  description = show
-  {-# MINIMAL runLayout #-}
-
--- | Lifts a pure-layout implementation to a signature that complies with
--- 'runLayout'
-pureLayout ::
-  (Stack a -> l -> [(a, RationalRect)]) ->
-  Stack a ->
-  l ->
-  W (l, [(a, RationalRect)])
-pureLayout fn as l = return (l, fn as l)
-
--- A Layout which hides the layout parameter under an existential type and
--- asserts the layout hidden can work with Window types.
-data WindowLayout
-  = forall l a.
-    (LayoutClass l, LayoutConstraint l a, a ~ Window) =>
-    WindowLayout l
-
-runWindowLayout :: Stack Window -> WindowLayout -> W (WindowLayout, [(Window, RationalRect)])
-runWindowLayout as (WindowLayout l) = first WindowLayout <$> runLayout as l
-
-handleWindowMessage :: Message -> WindowLayout -> MaybeT W WindowLayout
-handleWindowMessage m (WindowLayout l) = WindowLayout <$> handleMessage m l
-
--- | Using the 'Layout' as a witness, parse existentially wrapped windows
--- from a 'String'.
-readWindowLayout :: WindowLayout -> String -> WindowLayout
-readWindowLayout (WindowLayout l) s
-  | (Just x) <- readLayout s =
-      WindowLayout (asTypeOf x l)
-readWindowLayout l _ = l
-
--- | Serializes a window layout to a string.
-serializeWindowLayout :: WindowLayout -> String
-serializeWindowLayout (WindowLayout l) = serializeLayout l
-
-type ScreenId = ()
-
-type ScreenDetail = ()
-
-type Tag = String
-
-newtype ReadPtr a = ReadPtr (Ptr ())
-
-instance Read (ReadPtr a) where
-  readPrec = fmap (ReadPtr . intPtrToPtr) readPrec
-
-instance Show (ReadPtr a) where
-  show (ReadPtr ptr) = show (ptrToIntPtr ptr)
-
-type Montis = StablePtr (Context, State)
-
-data Plugin
-
--- Read-only context under which montis is run under.
-data Context = Context
-  { ctxConfig :: Config WindowLayout,
-    ctxPluginPtr :: Ptr Plugin
-  }
-
-defaultHooks :: Hooks
-defaultHooks =
-  Hooks
-    { keyHook = \_ -> return (),
-      surfaceHook = handleSurface,
-      buttonHook = \_ -> return ()
-    }
-
-defaultConfig :: Config ()
-defaultConfig =
-  Config
-    { hooks = defaultHooks,
-      layout = (),
-      resetHook = return ()
-    }
-
-data Hooks = Hooks
-  { keyHook :: KeyEvent -> W (),
-    surfaceHook :: SurfaceEvent -> W (),
-    buttonHook :: ButtonEvent -> W ()
-  }
-
-data Config l = Config
-  { layout :: l,
-    hooks :: Hooks,
-    resetHook :: W ()
-  }
-
--- | Typeclass defining the set of types which can be used as state extensions
--- to the W monad. These state extensions may be persistent or not.
---
--- There are default implementations for all methods if the type implements
--- Read, Show and Default,
-class (Typeable a) => ExtensionClass a where
-  -- | The initial value used for the first time an extension is 'gotten' or
-  -- demarshalling fails.
-  initialValue :: a
-
-  -- | Transforms a type into a string. If the type cannot be marshalled, this
-  -- function should return Nothing.
-  --
-  -- If a type cannot be marshalled, it cannot persist across hot reloads.
-  marshalExtension :: a -> Maybe String
-
-  -- | Reads an extension from a string. If this type is not marshallable or
-  -- reading fails, this function should return Nothing.
-  demarshalExtension :: String -> Maybe a
-
-  -- | If the type implements Default, use the default implementation.
-  default initialValue :: (Default a) => a
-  initialValue = def
-
-  -- | If the type implements Show, use show for the marshalling.
-  default marshalExtension :: (Show a) => a -> Maybe String
-  marshalExtension = Just . show
-
-  -- | If the type implements Read, use read for the demarshalling.
-  default demarshalExtension :: (Read a) => String -> Maybe a
-  demarshalExtension = readMaybe
-
-data StateExtension where
-  StateExtension :: (ExtensionClass a) => a -> StateExtension
-
--- | Puts a state extension.
-xput :: forall a m. (ExtensionClass a, Wlike m) => a -> m ()
-xput val = liftW $ do
-  modify' $ \state@State {extensibleState = extensibleState} ->
-    state
-      { extensibleState =
-          M.insert
-            ( xRepr (Proxy :: Proxy a)
-            )
-            (Right $ StateExtension val)
-            extensibleState
-      }
-
--- | Modifies a state extension.
-xmodify :: forall a m. (ExtensionClass a, Wlike m) => (a -> a) -> m ()
-xmodify fn = xput . fn =<< xget
-
--- | Modifies a state extension in the monadic context.
-xmodifyM :: forall a m. (ExtensionClass a, Wlike m) => (a -> m a) -> m ()
-xmodifyM fn = (xput <=< fn) =<< xget
-
--- | Produces a string representation of a type used to key into the extensible
--- state map.
-xRepr :: forall proxy a. (ExtensionClass a) => proxy a -> String
-xRepr _ = tyconToStr $ someTypeRepTyCon (someTypeRep (Proxy :: Proxy a))
-  where
-    tyconToStr tc =
-      printf "%s.%s.%s" (tyConPackage tc) (tyConModule tc) (tyConName tc)
-
--- | Gets a state extension.
-xget :: forall a m. (ExtensionClass a, Wlike m) => m a
-xget = do
-  xs <- liftW $ gets extensibleState
-  case M.lookup (xRepr (Proxy :: Proxy a)) xs of
-    Just (Right (StateExtension a)) -> return (fromMaybe initialValue (cast a))
-    Just (Left str) ->
-      let v = fromMaybe initialValue (demarshalExtension str)
-       in xput v >> return v
-    Nothing ->
-      xput (initialValue :: a) >> return initialValue
-
-xgets :: forall a b m. (ExtensionClass a, Wlike m) => (a -> b) -> m b
-xgets fn = fn <$> xget
-
--- State as it is marshalled. Used for derived instances of Show and Read.
-data MarshalledState
-  = MarshalledState
-      (StackSet ScreenId ScreenDetail Tag String Window)
-      (Set Window)
-      [(String, String)]
-  deriving (Show, Read)
-
-data State = State
-  { -- The datastructure containing the state of the windows.
-    mapped :: StackSet ScreenId ScreenDetail Tag WindowLayout Window,
-    -- | All the windows wetterhorn knows about, even if they are not mapped.
-    allWindows :: Set Window,
-    -- | Current set of hooks. The initial hooks are provided by the
-    -- configuration, but the hooks can change during operation. This is how key
-    -- sequences can be mapped.
-    currentHooks :: Hooks,
-    -- | Map from the typerep string to the state extension.
-    extensibleState :: Map String (Either String StateExtension)
-  }
-
--- | Initializes a "cold" state from a configuration. A cold state is the
--- initial state on startup. It is constrasted with a "hot" state, which is a
--- persisted state after a hot-reload.
-initColdState :: Config WindowLayout -> IO State
-initColdState Config {layout = layout, hooks = hooks} =
-  return $
-    State
-      ( StackSet (Screen () () (Workspace "0" layout (Stack [] []))) [] []
-      )
-      mempty
-      hooks
-      mempty
-
--- | Marshals the serializable parts of the state to a string. This happens
--- during a hot-reload where some state must be saved to persist across hot
--- reloads.
-marshalState :: State -> String
-marshalState
-  ( State
-      { mapped = mapped,
-        allWindows = allWindows,
-        extensibleState = xs
-      }
-    ) =
-    show $
-      MarshalledState
-        (mapLayout serializeWindowLayout mapped)
-        allWindows
-        (mapMaybe (\(k, v) -> (k,) <$> doMarshalEx v) (M.toList xs))
-    where
-      doMarshalEx (Left s) = Just s
-      doMarshalEx (Right (StateExtension a)) = marshalExtension a
-
--- | Demarshals the string from "marshalState" into a state. Uses the provided
--- config to fill out non-persistent parts of the state.
-demarshalState :: Config WindowLayout -> String -> State
-demarshalState Config {hooks = hooks, layout = layout} str =
-  State mapped allWindows hooks xs
-  where
-    ( MarshalledState
-        (mapLayout (readWindowLayout layout) -> mapped)
-        allWindows
-        (fmap Left . M.fromList -> xs)
-      ) = read str
-
--- | This is _the_ main monad used for Montis operations. Contains
--- everything required to operate. Contains the state, configuration and
--- interface to foreign code.
-newtype W a = W (ReaderT Context (StateT State IO) a)
-  deriving (Functor, Applicative, Monad, MonadState State, MonadIO)
-
--- | Let Config be the thing W is a reader for. There is already a way to get
--- the foreign interface in the context.
-instance MonadReader (Config WindowLayout) W where
-  local fn (W r) =
-    W $
-      local
-        ( \(Context conf pluginPtr) -> Context (fn conf) pluginPtr
-        )
-        r
-  ask = W $ ctxConfig <$> ask
-
-runW :: W a -> (Context, State) -> IO (a, State)
-runW (W fn) (ctx, st) = runStateT (runReaderT fn ctx) st
-
-wio :: IO a -> W a
-wio = liftIO
-
--- | Type class to lift an arbitrary 'W' computation into another monad.
-class (Monad m) => Wlike m where
-  liftW :: W a -> m a
-
--- | Trivial instance of W for Wlike.
-instance Wlike W where
-  liftW = id
-
--- Default implementations for common handlers.
-
--- | handles a new surface event. This updates the state to reflect how it
--- should look in the harness.
-handleSurface :: SurfaceEvent -> W ()
-handleSurface (SurfaceEvent state (Window -> win)) =
-  case state of
-    Destroy ->
-      modify $
-        \st@State
-           { allWindows = allWindows,
-             mapped = mapped
-           } ->
-            st
-              { allWindows = Set.delete win allWindows,
-                mapped = StackSet.delete win mapped
-              }
-    Unmap -> modify $
-      \st@State {mapped = mapped} ->
-        st
-          { mapped = StackSet.delete win mapped
-          }
-    Map -> modify $
-      \st@State {mapped = mapped, allWindows = allWindows} ->
-        st
-          { mapped = StackSet.insertTiled win mapped,
-            allWindows = Set.insert win allWindows
-          }
+module Montis.Core
+  ( module X,
+  )
+where
+
+import Montis.Core.Events as X
+import Montis.Core.Monad as X
+import Montis.Core.Start as X
+import Montis.Core.State as X
diff --git a/plug/src/Montis/Core/ButtonEvent.hs b/plug/src/Montis/Core/ButtonEvent.hs
deleted file mode 100644
index 3a79922..0000000
--- a/plug/src/Montis/Core/ButtonEvent.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Core.ButtonEvent where
-
-import Data.Word (Word32)
-import Foreign (Ptr)
-import Montis.Foreign.WlRoots
-
-data ButtonState = ButtonReleased | ButtonPressed deriving (Show, Read, Eq, Enum, Ord)
-
-data ButtonEvent = ButtonEvent
-  { pointer :: Ptr WlrPointer,
-    timeMs :: Word32,
-    button :: Word32,
-    modifiers :: Word32,
-    state :: ButtonState
-  }
-  deriving (Eq, Show, Ord)
diff --git a/plug/src/Montis/Core/Events.hs b/plug/src/Montis/Core/Events.hs
new file mode 100644
index 0000000..8c0742e
--- /dev/null
+++ b/plug/src/Montis/Core/Events.hs
@@ -0,0 +1,37 @@
+module Montis.Core.Events where
+
+import Data.Word (Word32)
+import Montis.Base.Foreign.WlRoots.Types
+
+data KeyState = KeyPressed | KeyReleased deriving (Show, Read, Eq, Enum, Ord)
+
+data KeyEvent = KeyEvent
+  { keyEvent_timeMs :: Word32,
+    keyEvent_keycode :: Word32,
+    keyEvent_state :: KeyState,
+    keyEvent_modifiers :: Word32,
+    keyEvent_keysym :: Word32,
+    keyEvent_codepoint :: Char,
+    keyEvent_device :: WlrInputDevice
+  }
+  deriving (Show, Ord, Eq)
+
+data ButtonState = ButtonReleased | ButtonPressed deriving (Show, Read, Eq, Enum, Ord)
+
+data ButtonEvent = ButtonEvent
+  { buttonEvent_pointer :: WlrPointer,
+    buttonEvent_timeMs :: Word32,
+    buttonEvent_button :: Word32,
+    buttonEvent_modifiers :: Word32,
+    buttonEvent_state :: ButtonState
+  }
+  deriving (Eq, Show, Ord)
+
+data SurfaceState = Map | Unmap | Destroy
+  deriving (Eq, Ord, Show, Read, Enum)
+
+data SurfaceEvent = SurfaceEvent
+  { surfaceEvent_state :: SurfaceState,
+    surfaceEvent_surface :: Surface
+  }
+  deriving (Eq, Ord, Show)
diff --git a/plug/src/Montis/Core/Extensions.hs b/plug/src/Montis/Core/Extensions.hs
new file mode 100644
index 0000000..a44debe
--- /dev/null
+++ b/plug/src/Montis/Core/Extensions.hs
@@ -0,0 +1,29 @@
+module Montis.Core.Extensions where
+
+import Data.Data
+  ( Typeable,
+    tyConModule,
+    tyConName,
+    tyConPackage,
+  )
+import Data.Kind (Constraint, Type)
+import Text.Printf (printf)
+import Type.Reflection (someTypeRep, someTypeRepTyCon)
+
+-- | A key to key into the Extension maps.
+data ExtensionKey where
+  ExtensionKey :: {extensionKeyValue :: String} -> ExtensionKey
+  deriving (Eq, Ord, Show)
+
+data Extension (c :: Type -> Constraint) where
+  Extension :: (Typeable a, c a) => a -> Extension c
+
+class Nil a
+
+-- | Produces a string representation of a type used to key into the extensible
+-- state map.
+typeRepr :: forall proxy a. (Typeable a) => proxy a -> ExtensionKey
+typeRepr proxy = ExtensionKey $ tyconToStr $ someTypeRepTyCon (someTypeRep proxy)
+  where
+    tyconToStr tc =
+      printf "%s.%s.%s" (tyConPackage tc) (tyConModule tc) (tyConName tc)
diff --git a/plug/src/Montis/Core/Internal/Foreign/Export.hs b/plug/src/Montis/Core/Internal/Foreign/Export.hs
new file mode 100644
index 0000000..fc535c9
--- /dev/null
+++ b/plug/src/Montis/Core/Internal/Foreign/Export.hs
@@ -0,0 +1,85 @@
+-- | This module has no public functions, but provides the surface interface
+-- between the Montis runtime and the plugin.
+module Montis.Core.Internal.Foreign.Export () where
+
+import Control.Monad (forM_)
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as CH
+import Data.Singletons.Decide (Void)
+import Foreign
+  ( Ptr,
+    Storable (poke, pokeByteOff),
+    Word32,
+    Word8,
+    deRefStablePtr,
+    freeStablePtr,
+    mallocBytes,
+    newStablePtr,
+  )
+import Foreign.C (CChar, CInt (..))
+import Montis.Base.Foreign.WlRoots.Types (ForeignWlrXdgSurface, WlrEventKeyboardKey, WlrInputDevice, WlrPointerButtonEvent)
+import Montis.Core
+import Montis.Core.State.Marshal (marshalState)
+import Montis.Core.State
+
+-- | Marshals the opaque state to a C-style byte array and size pointer.
+foreign export ccall "plugin_marshal_state"
+  pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8)
+
+pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8)
+pluginMarshalState opqStT outlen = do
+  (_, st) <- deRefStablePtr opqStT
+  let bs = CH.pack (marshalState st)
+  ret <- mallocBytes (BS.length bs)
+  poke outlen (fromIntegral $ BS.length bs)
+  forM_ (zip [0 ..] (BS.unpack bs)) $ \(off, w8) -> do
+    pokeByteOff ret off w8
+  return ret
+
+foreign export ccall "plugin_handle_button"
+  pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT
+
+pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT
+pluginHandleButton = undefined
+
+foreign export ccall "plugin_handle_keybinding"
+  pluginHandleKeybinding ::
+    Ptr WlrInputDevice ->
+    Ptr WlrEventKeyboardKey ->
+    Word32 ->
+    Word32 ->
+    Word32 ->
+    Ptr CInt ->
+    OpqStT ->
+    IO OpqStT
+
+pluginHandleKeybinding ::
+  Ptr WlrInputDevice ->
+  Ptr WlrEventKeyboardKey ->
+  Word32 ->
+  Word32 ->
+  Word32 ->
+  Ptr CInt ->
+  OpqStT ->
+  IO OpqStT
+pluginHandleKeybinding = undefined
+
+-- | Function exported to the harness to handle the mapping/unmapping/deletion
+-- of an XDG surface.
+foreign export ccall "plugin_handle_surface"
+  pluginHandleSurface ::
+    Ptr Void -> CInt -> OpqStT -> IO OpqStT
+
+pluginHandleSurface ::
+  Ptr Void -> CInt -> OpqStT -> IO OpqStT
+pluginHandleSurface = undefined
+
+-- | Function exported to the harness to handle the mapping/unmapping/deletion
+-- of an XWayland surface.
+foreign export ccall "plugin_handle_xwayland_surface"
+  pluginHandleXWaylandSurface ::
+    Ptr Void -> CInt -> OpqStT -> IO OpqStT
+
+pluginHandleXWaylandSurface ::
+  Ptr Void -> CInt -> OpqStT -> IO OpqStT
+pluginHandleXWaylandSurface = undefined
diff --git a/plug/src/Montis/Core/KeyEvent.hs b/plug/src/Montis/Core/KeyEvent.hs
deleted file mode 100644
index cbdda4f..0000000
--- a/plug/src/Montis/Core/KeyEvent.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Montis.Core.KeyEvent
-  ( KeyEvent (..),
-    KeyState (..),
-  )
-where
-
-import Data.Word (Word32)
-import Foreign (Ptr)
-import Montis.Foreign.WlRoots
-
-data KeyState = KeyPressed | KeyReleased deriving (Show, Read, Eq, Enum, Ord)
-
-data KeyEvent = KeyEvent
-  { timeMs :: Word32,
-    keycode :: Word32,
-    state :: KeyState,
-    modifiers :: Word32,
-    keysym :: Word32,
-    codepoint :: Char,
-    device :: Ptr WlrInputDevice
-  }
-  deriving (Show, Ord, Eq)
diff --git a/plug/src/Montis/Core/Keys.hs b/plug/src/Montis/Core/Keys.hs
deleted file mode 100644
index fb55cc6..0000000
--- a/plug/src/Montis/Core/Keys.hs
+++ /dev/null
@@ -1,240 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Core.Keys where
-
-import Control.Monad (forever, void, when)
-import Control.Monad.Cont.Class
-import Control.Monad.IO.Class
-import Control.Monad.State (MonadState (get, put), MonadTrans (lift), StateT, evalStateT, gets, modify)
-import Control.Monad.Trans.Cont
-import Data.Bits
-import Data.Word
-import Montis.Core.ButtonEvent (ButtonEvent)
-import qualified Montis.Core.ButtonEvent as ButtonEvent
-import Montis.Core.KeyEvent
-import qualified Montis.Core.KeyEvent as KeyEvent
-import Montis.Core.W
-import Montis.Foreign.WlRoots (wlrSeatKeyboardNotifyKey, wlrSeatSetKeyboard)
-import Montis.Core.Runtime (getSeat)
-
--- | Forwards the given key event to the focused window.
-forwardKey :: KeyEvent -> W ()
-forwardKey keyEvent = do
-  seatPtr <- getSeat
-  wio $ do
-    wlrSeatSetKeyboard
-      seatPtr
-      (device keyEvent)
-
-    wlrSeatKeyboardNotifyKey
-      seatPtr
-      (timeMs keyEvent)
-      (keycode keyEvent)
-      ( case state keyEvent of
-          KeyReleased -> 0
-          _ -> 1
-      )
-
--- | Forwards the current key event to the focused window.
-forwardEvent :: KeyEvent -> KeysM ()
-forwardEvent = liftW . forwardKey
-
--- | Enumeration of possible modifiers
-data Modifier = Shift | Lock | Control | Mod1 | Mod2 | Mod3 | Mod4 | Mod5
-  deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
--- | Converts a modifier to its associated mask.
-modifierToMask :: Modifier -> Word32
-modifierToMask m =
-  1
-    `shiftL` case m of
-      Shift -> 0
-      Lock -> 1
-      Control -> 2
-      Mod1 -> 3
-      Mod2 -> 4
-      Mod3 -> 5
-      Mod4 -> 6
-      Mod5 -> 7
-
-data KeysState = KeysState
-  { -- | Reference to the top. Used for a continue statement.
-    keysTop :: KeysM (),
-    handleContinuation :: KeyContinuation -> W ()
-  }
-
--- | The Keys monad. This monad abstracts away control flow for handling key
--- bindings. This makes it easy to make key-sequence bindings.
--- newtype KeysM a = KeysM ((KeyEvent -> W ()) -> KeyEvent -> W (KeysMR a))
-newtype KeysM a = KeysM (ContT () (StateT KeysState W) a)
-  deriving (Monad, Functor, Applicative, MonadCont, MonadIO)
-
--- | KeysM can be lifted from a W action.
-instance Wlike KeysM where
-  liftW = KeysM . lift . lift
-
-type KeyContinuation = KeyEvent -> W ()
-
-useKeysWithContinuation :: (KeyContinuation -> W ()) -> KeysM () -> W ()
-useKeysWithContinuation continuation (forever -> km@(KeysM c)) =
-  evalStateT (evalContT c) (KeysState km continuation)
-
-useKeys :: KeysM () -> W ()
-useKeys = useKeysWithContinuation putKeyHandler
-
--- | Returns the next key event.
-nextKeyEvent :: KeysM KeyEvent
-nextKeyEvent = do
-  st <- KeysM $ lift get
-  KeysM $
-    shiftT
-      ( \keyHandler ->
-          lift . lift $
-            handleContinuation st (\kp -> evalStateT (keyHandler kp) st)
-      )
-
--- | Discards the rest of the continuation and starts again from the top. Useful
--- for keybinds where once the key is handled, there's nothing left to do.
-continue :: KeysM ()
-continue = do
-  st <- KeysM $ lift get
-  let (KeysM topCont) = keysTop st
-
-  -- This shift discards the rest of the computation and instead returns to the
-  -- top of the handler.
-  KeysM $ shiftT (\_ -> resetT topCont)
-
--- | Returns the "top" continuation.
-getTop :: KeysM (KeysM ())
-getTop = KeysM (gets keysTop)
-
-putKeyHandler :: KeyContinuation -> W ()
-putKeyHandler handler = do
-  s@State {currentHooks = hooks} <- get
-  put
-    s
-      { currentHooks =
-          hooks
-            { keyHook = void <$> handler
-            }
-      }
-
-nextButtonEvent :: KeysM ButtonEvent
-nextButtonEvent = do
-  st <- KeysM get
-  KeysM $
-    shiftT $ \h ->
-      lift $ lift $ putButtonHandler (\ev -> evalStateT (h ev) st)
-  where
-    putButtonHandler h = do
-      modify $ \st -> st {currentHooks = (currentHooks st) {buttonHook = h}}
-
-nextButtonOrKeyEvent :: KeysM (Either ButtonEvent KeyEvent)
-nextButtonOrKeyEvent = do
-  st <- KeysM get
-  KeysM $
-    shiftT $ \rest ->
-      lift $
-        lift $ do
-          putButtonHandler (\ev -> evalStateT (rest (Left ev)) st)
-          handleContinuation st (\ev -> evalStateT (rest (Right ev)) st)
-  where
-    putButtonHandler h = do
-      modify $ \st -> st {currentHooks = (currentHooks st) {buttonHook = h}}
-
-nextButtonOrKeyPress :: KeysM (Either ButtonEvent KeyEvent)
-nextButtonOrKeyPress = do
-  ev <- nextButtonOrKeyEvent
-  case ev of
-    Left bev | ButtonEvent.state bev == ButtonEvent.ButtonPressed -> return ev
-    Left bev -> forwardButtonEvent bev >> nextButtonOrKeyPress
-    Right kev | KeyEvent.state kev == KeyEvent.KeyPressed -> return ev
-    Right kev -> forwardEvent kev >> nextButtonOrKeyPress
-  where
-    forwardButtonEvent _ = return ()
-
--- | Returns the next KeyPressed event. This is likely what 90% of use cases
--- want rather than nextKeyEvent.
-nextKeyPress :: KeysM KeyEvent
-nextKeyPress = do
-  k <- nextKeyEvent
-  if KeyEvent.state k /= KeyPressed
-    then forwardEvent k >> nextKeyPress
-    else return k
-
---
--- binding EDSL used to expressively create key bindings and subbindings inside
--- a KeysM () context.
---
-
-data KeyMatcher = KeyMatcher Word32 Char
-  deriving (Show)
-
--- | Like a KeyMatcher, but allows additional modifiers to be pressed, not just
--- the exact ones given.
-newtype WeakKeyMatcher = WeakKeyMatcher KeyMatcher
-
--- | Converts a KeyMatcher to a weak key matcher.
-weak :: KeyMatcher -> WeakKeyMatcher
-weak = WeakKeyMatcher
-
-class KeyMatcherId r where
-  toKeyMatcher :: r -> KeyMatcher
-
-instance KeyMatcherId KeyMatcher where
-  toKeyMatcher = id
-
-instance KeyMatcherId Char where
-  toKeyMatcher = KeyMatcher 0
-
-class KeyMatcherBuilder b where
-  (.+) :: (KeyMatcherId i) => b -> i -> KeyMatcher
-
-instance KeyMatcherBuilder Modifier where
-  (.+) m (toKeyMatcher -> (KeyMatcher mods ch)) =
-    KeyMatcher (mods .|. modifierToMask m) ch
-
-infixr 9 .+
-
-class MatchKey m where
-  matchKey :: m -> KeyEvent -> Bool
-
-instance MatchKey (KeyEvent -> Bool) where
-  matchKey = ($)
-
-instance MatchKey Bool where
-  matchKey = const
-
-instance MatchKey Char where
-  matchKey ch ev = ch == KeyEvent.codepoint ev
-
-instance MatchKey KeyMatcher where
-  matchKey (KeyMatcher m ch) ev =
-    ch == KeyEvent.codepoint ev && m == KeyEvent.modifiers ev
-
-instance MatchKey WeakKeyMatcher where
-  matchKey (WeakKeyMatcher (KeyMatcher m ch)) ev =
-    ch == KeyEvent.codepoint ev && (m .|. ms) == ms
-    where
-      ms = KeyEvent.modifiers ev
-
-class IsKeysM m where
-  toKeysM :: m a -> KeysM a
-
-instance IsKeysM W where
-  toKeysM = liftW
-
-instance IsKeysM KeysM where
-  toKeysM = id
-
-bind :: (MatchKey m, IsKeysM k) => KeyEvent -> m -> k () -> KeysM ()
-bind ev m act = do
-  when (matchKey m ev) $ do
-    toKeysM act
-    continue
-
-ignoreReleaseEvents :: KeyEvent -> KeysM ()
-ignoreReleaseEvents ev = do
-  when (KeyEvent.state ev /= KeyEvent.KeyPressed) $ do
-    forwardEvent ev
-    continue
diff --git a/plug/src/Montis/Core/Monad.hs b/plug/src/Montis/Core/Monad.hs
new file mode 100644
index 0000000..06cc0db
--- /dev/null
+++ b/plug/src/Montis/Core/Monad.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Montis.Core.Monad where
+
+import Control.Monad.Identity (Identity (Identity))
+import Control.Monad.Reader
+import Control.Monad.State (MonadState, StateT (runStateT), gets, modify')
+import Data.Map qualified as Map
+import Data.Typeable
+import Foreign (StablePtr)
+import Montis.Core.Extensions (Extension (Extension), typeRepr)
+import Montis.Core.State
+
+-- | A Config type for the Montis monad.
+type MontisConfig = Config Montis
+
+-- | A Context type specific for the Montis monad.
+type MontisContext = Context Montis
+
+-- | A State type for the Montis monad.
+type MontisState = State Montis
+
+-- | The Opaque State Type  passed between the plugin and the runtime. The
+-- OpqStT *is* the opq_st_t from the runtime code.
+type OpqStT = StablePtr (MontisContext, MontisState)
+
+-- | THe Montis monad.
+newtype Montis a where
+  Montis :: (ReaderT MontisContext (StateT MontisState IO) a) -> Montis a
+  deriving (Functor, Applicative, Monad, MonadState MontisState, MonadIO)
+
+-- | Monad reader instance for Montis.
+instance MonadReader MontisConfig Montis where
+  ask :: Montis MontisConfig
+  ask = Montis $ asks ctxConfig
+
+  reader :: (MontisConfig -> a) -> Montis a
+  reader fn = Montis $ asks (fn . ctxConfig)
+
+  local :: (MontisConfig -> MontisConfig) -> Montis a -> Montis a
+  local cfn (Montis fn) =
+    Montis $ local (\ctx -> ctx {ctxConfig = cfn (ctxConfig ctx)}) fn
+
+runMontis :: MontisContext -> MontisState -> Montis a -> IO (a, MontisState)
+runMontis ctx initState (Montis m) = runStateT (runReaderT m ctx) initState
+
+-- | The standard default config.
+defaultConfig :: MontisConfig
+defaultConfig =
+  Config
+    { startingHooks =
+        Hooks
+          { keyHook = liftIO . print,
+            surfaceHook = liftIO . print,
+            buttonHook = liftIO . print
+          },
+      startupHook = return (),
+      resetHook = return (),
+      configExtensions = mempty
+    }
+
+xStatePut :: forall a. (StateExtension a) => a -> Montis ()
+xStatePut xst = do
+  modify'
+    ( \st ->
+        st
+          { extensibleState =
+              Map.insert
+                (typeRepr (Identity xst))
+                (Right (Extension xst))
+                (extensibleState st)
+          }
+    )
+
+xStateGet :: forall a. (StateExtension a) => Montis (Maybe a)
+xStateGet = do
+  mp <- gets extensibleState
+  case lookupByType (Proxy :: Proxy a) mp of
+    Nothing -> return Nothing
+    Just (Right (Extension v)) -> return (cast v)
+    Just (Left s) -> do
+      let x = (demarshalExtension s :: Maybe a)
+       in forM_ x xStatePut >> return x
diff --git a/plug/src/Montis/Core/Plugin/Interface.hs b/plug/src/Montis/Core/Plugin/Interface.hs
new file mode 100644
index 0000000..73c0371
--- /dev/null
+++ b/plug/src/Montis/Core/Plugin/Interface.hs
@@ -0,0 +1,20 @@
+-- | Provides the plugin interface through foreign exports.
+module Montis.Core.Plugin.Interface where
+
+import Data.ByteString (ByteString)
+import Data.Data (Typeable)
+import Data.Singletons.Decide (Void)
+import Foreign (Ptr, StablePtr, Word32)
+import Foreign.C (CChar)
+import Montis.Core.State (SelfPtr)
+
+-- type OpqStT l w = StablePtr (Context l w, State l w)
+
+class OpaqueState s where
+  hotStart :: SelfPtr -> ByteString -> IO s
+
+  coldStart :: SelfPtr -> IO s
+
+  marshalState :: s -> ByteString
+
+  teardown :: s -> IO ()
diff --git a/plug/src/Montis/Core/Runtime.hs b/plug/src/Montis/Core/Runtime.hs
deleted file mode 100644
index 6521fba..0000000
--- a/plug/src/Montis/Core/Runtime.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Montis.Core.Runtime where
-
-import Control.Monad.RWS (MonadReader (ask))
-import Data.Void (Void)
-import Foreign (Ptr, castPtr)
-import Montis.Core.W
-import Montis.Foreign.Import
-import Montis.Foreign.WlRoots (WlrSeat)
-
-requestHotReload :: W ()
-requestHotReload = do
-  Context {ctxPlugin = plug} <- W ask
-  wio $ foreign_doRequestHotReload plug
-
-requestLog :: String -> W ()
-requestLog = undefined
-
-requestExit :: Int -> W ()
-requestExit = undefined
-
-newtype Seat = Seat (Ptr Void)
-
-getSeat :: W (Ptr WlrSeat)
-getSeat = do
-  Context {ctxPlugin = plug} <- W ask
-  wio $ castPtr <$> foreign_getSeat plug
diff --git a/plug/src/Montis/Core/Start.hs b/plug/src/Montis/Core/Start.hs
new file mode 100644
index 0000000..54ec8c5
--- /dev/null
+++ b/plug/src/Montis/Core/Start.hs
@@ -0,0 +1,38 @@
+module Montis.Core.Start where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as CH
+import Data.Void
+import Foreign (Word32, newStablePtr)
+import Foreign.C (CChar)
+import Foreign.Ptr
+import Montis.Core.Monad
+import Montis.Core.State
+import Montis.Core.State.Marshal (demarshalState)
+
+type MontisColdStart = Ptr Void -> IO OpqStT
+
+type MontisHotStart = Ptr Void -> Ptr CChar -> Word32 -> IO OpqStT
+
+hotStartMontis :: MontisConfig -> MontisHotStart
+hotStartMontis config self chars len = do
+  bs <- BS.packCStringLen (chars, fromIntegral len)
+
+  let ctx = Context config (SelfPtr self)
+      st = demarshalState config (CH.unpack bs)
+
+  ((), st') <- runMontis ctx st (resetHook config)
+  newStablePtr (ctx, st')
+
+-- Used to start montis given the provided config.
+coldStartMontis :: MontisConfig -> MontisColdStart
+coldStartMontis conf selfPtr =
+  let ctx = Context conf (SelfPtr selfPtr)
+      st =
+        State
+          { currentHooks = startingHooks conf,
+            extensibleState = mempty
+          }
+   in do
+        ((), st') <- runMontis ctx st (startupHook conf)
+        newStablePtr (ctx, st')
diff --git a/plug/src/Montis/Core/State.hs b/plug/src/Montis/Core/State.hs
new file mode 100644
index 0000000..303830b
--- /dev/null
+++ b/plug/src/Montis/Core/State.hs
@@ -0,0 +1,99 @@
+-- | Definitions of montis core state.
+module Montis.Core.State where
+
+import Data.Data (Typeable)
+import Data.Default.Class (Default, def)
+import Data.Map qualified as M
+import Data.Void (Void)
+import Foreign (Ptr)
+import Montis.Core.Events
+import Montis.Core.Extensions
+import Text.Read (readMaybe)
+
+-- | An opaque type used for the plugin's self-reference.
+newtype SelfPtr where
+  SelfPtr :: Ptr Void -> SelfPtr
+
+-- | This is the context the plugin operates under. The context contains data
+-- which must be provided by the runtime or the configuration. This data may not
+-- be cold-created.
+--
+-- Parameters:
+--   `m` the monad for this Context. This is typically W.
+data Context m where
+  Context ::
+    { ctxConfig :: Config m,
+      ctxSelfPtr :: SelfPtr
+    } ->
+    Context m
+
+-- | Montis configuration. This is the structure that defines the user-written
+-- configuration, which is linked in.
+data Config m where
+  Config ::
+    { startingHooks :: Hooks m,
+      startupHook :: m (),
+      resetHook :: m (),
+      configExtensions :: M.Map ExtensionKey (Extension Nil)
+    } ->
+    Config m
+
+-- | Hooks the runtime can call.
+data Hooks m where
+  Hooks ::
+    { keyHook :: KeyEvent -> m (),
+      surfaceHook :: SurfaceEvent -> m (),
+      buttonHook :: ButtonEvent -> m ()
+    } ->
+    Hooks m
+
+-- | Typeclass defining the set of types which can be used as state extensions
+-- to the W monad. These state extensions may be persistent or not.
+--
+-- There are default implementations for all methods if the type implements
+-- Read, Show and Default,
+class (Typeable a) => StateExtension a where
+  -- | The initial value used for the first time an extension is 'gotten' or
+  -- demarshalling fails.
+  initialValue :: a
+
+  -- | Transforms a type into a string. If the type cannot be marshalled, this
+  -- function should return Nothing.
+  --
+  -- If a type cannot be marshalled, it cannot persist across hot reloads.
+  marshalExtension :: a -> Maybe String
+
+  -- | Reads an extension from a string. If this type is not marshallable or
+  -- reading fails, this function should return Nothing.
+  demarshalExtension :: String -> Maybe a
+
+  -- | If the type implements Default, use the default implementation.
+  default initialValue :: (Default a) => a
+  initialValue = def
+
+  -- | If the type implements Show, use show for the marshalling.
+  default marshalExtension :: (Show a) => a -> Maybe String
+  marshalExtension = Just . show
+
+  -- | If the type implements Read, use read for the demarshalling.
+  default demarshalExtension :: (Read a) => String -> Maybe a
+  demarshalExtension = readMaybe
+
+-- | State type. This type contains changeable data.
+data State m where
+  State ::
+    { -- The datastructure containing the state of the windows.
+
+      -- | Current set of hooks. The initial hooks are provided by the
+      -- configuration, but the hooks can change during operation. This is how
+      -- key sequences can be mapped.
+      currentHooks :: Hooks m,
+      -- | Map from the typerep string to the state extension.
+      extensibleState ::
+        M.Map ExtensionKey (Either String (Extension StateExtension))
+    } ->
+    State m
+
+-- | Lookup from an extension map by type.
+lookupByType :: (Typeable a) => proxy a -> M.Map ExtensionKey b -> Maybe b
+lookupByType pxy = M.lookup (typeRepr pxy)
diff --git a/plug/src/Montis/Core/State/Marshal.hs b/plug/src/Montis/Core/State/Marshal.hs
new file mode 100644
index 0000000..642201e
--- /dev/null
+++ b/plug/src/Montis/Core/State/Marshal.hs
@@ -0,0 +1,39 @@
+module Montis.Core.State.Marshal (marshalState, demarshalState) where
+
+import Data.Map qualified as M
+import Data.Maybe (mapMaybe)
+import Montis.Core.Extensions
+import Montis.Core.State
+
+data MarshalledState where
+  MarshalledState ::
+    [(String, String)] ->
+    MarshalledState
+  deriving (Show, Read)
+
+-- | Marshals the serializable parts of the state to a string. This happens
+-- during a hot-reload where some state must be saved to persist across hot
+-- reloads.
+marshalState :: State m -> String
+marshalState
+  ( State
+      { extensibleState = xs
+      }
+    ) =
+    show $
+      MarshalledState
+        (mapMaybe (\(k, v) -> (extensionKeyValue k,) <$> doMarshalEx v) (M.toList xs))
+    where
+      doMarshalEx :: Either String (Extension StateExtension) -> Maybe String
+      doMarshalEx (Left s) = Just s
+      doMarshalEx (Right (Extension a)) = marshalExtension a
+
+-- | Demarshals the string from "marshalState" into a state. Uses the provided
+-- config to fill out non-persistent parts of the state.
+demarshalState :: Config m -> String -> State m
+demarshalState Config {startingHooks = hooks} str =
+  State hooks xs
+  where
+    ( MarshalledState
+        (M.mapKeys ExtensionKey . fmap Left . M.fromList -> xs)
+      ) = read str
diff --git a/plug/src/Montis/Core/SurfaceEvent.hs b/plug/src/Montis/Core/SurfaceEvent.hs
deleted file mode 100644
index 93bcdae..0000000
--- a/plug/src/Montis/Core/SurfaceEvent.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Montis.Core.SurfaceEvent
-  ( SurfaceEvent (..),
-    SurfaceState (..),
-  )
-where
-
-import Montis.Foreign.WlRoots
-
-data SurfaceState = Map | Unmap | Destroy
-  deriving (Eq, Ord, Show, Read, Enum)
-
-data SurfaceEvent = SurfaceEvent
-  { state :: SurfaceState,
-    surface :: Surface
-  }
-  deriving (Eq, Ord, Show)
diff --git a/plug/src/Montis/Core/W.hs b/plug/src/Montis/Core/W.hs
deleted file mode 100644
index 3aac22a..0000000
--- a/plug/src/Montis/Core/W.hs
+++ /dev/null
@@ -1,365 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Core.W where
-
-import Control.Arrow (Arrow (first))
-import Control.Monad ((<=<))
-import Control.Monad.RWS (MonadIO (liftIO), MonadReader (..), MonadState, modify)
-import Control.Monad.Reader (ReaderT (runReaderT))
-import Control.Monad.State (StateT (runStateT), gets, modify')
-import Control.Monad.Trans.Maybe
-import Data.Data (Typeable, cast, tyConModule, tyConName, tyConPackage)
-import Data.Default.Class (Default, def)
-import Data.Kind (Constraint, Type)
-import Data.Map (Map)
-import Data.Map qualified as M
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Proxy
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Void (Void)
-import Foreign (Ptr, StablePtr, intPtrToPtr, ptrToIntPtr)
-import Montis.Core.ButtonEvent (ButtonEvent)
-import Montis.Core.KeyEvent
-import Montis.Core.SurfaceEvent
-import Montis.Foreign.ForeignInterface qualified as ForeignInterface
-import Montis.Foreign.WlRoots (Surface, WlrSeat)
-import Montis.StackSet hiding (layout)
-import Montis.StackSet qualified as StackSet
-import Text.Printf (printf)
-import Text.Read hiding (lift)
-import Type.Reflection (someTypeRep, someTypeRepTyCon)
-
-data RationalRect = RationalRect Rational Rational Rational Rational
-
--- | Wrapper for a message. Messages are sent to layout and layouts are supposed
--- to handle them. This hides a typeable parameter.
-data Message where
-  Message :: (Typeable a) => a -> Message
-
--- | casts a message to a type.
-fromMessage :: (Typeable a) => Message -> Maybe a
-fromMessage (Message t) = cast t
-
--- | Wraps a type in a message.
-toMessage :: (Typeable a) => a -> Message
-toMessage = Message
-
-class (Typeable l) => HandleMessage l where
-  handleMessage :: Message -> l -> MaybeT W l
-  handleMessage _ = return
-
-newtype Window = Window
-  { surface :: Surface
-  }
-  deriving (Show, Ord, Eq, Read)
-
--- | Types of this class "lay out" windows by assigning rectangles and handle
--- messages.
-class (Typeable l, HandleMessage l) => LayoutClass l where
-  -- | Constraints on the type to lay out. Sometimes a layout requires the 'a'
-  -- type to be "Ord", other times "Eq", this is the mechanism by which this
-  -- constraint is expressed.
-  type LayoutConstraint l :: Type -> Constraint
-
-  -- | Runs the layout in an impure way returning a modified layout and the list
-  -- of windows to their rectangles under a monad.
-  runLayout :: (LayoutConstraint l a) => Stack a -> l -> W (l, [(a, RationalRect)])
-
-  readLayout :: String -> Maybe l
-  default readLayout :: (Read l) => String -> Maybe l
-  readLayout = readMaybe
-
-  serializeLayout :: l -> String
-  default serializeLayout :: (Show l) => l -> String
-  serializeLayout = show
-
-  description :: l -> String
-  default description :: (Show l) => l -> String
-  description = show
-  {-# MINIMAL runLayout #-}
-
--- | Lifts a pure-layout implementation to a signature that complies with
--- 'runLayout'
-pureLayout ::
-  (Stack a -> l -> [(a, RationalRect)]) ->
-  Stack a ->
-  l ->
-  W (l, [(a, RationalRect)])
-pureLayout fn as l = return (l, fn as l)
-
--- A Layout which hides the layout parameter under an existential type and
--- asserts the layout hidden can work with Window types.
-data WindowLayout
-  = forall l a.
-    (LayoutClass l, LayoutConstraint l a, a ~ Window) =>
-    WindowLayout l
-
-runWindowLayout :: Stack Window -> WindowLayout -> W (WindowLayout, [(Window, RationalRect)])
-runWindowLayout as (WindowLayout l) = first WindowLayout <$> runLayout as l
-
-handleWindowMessage :: Message -> WindowLayout -> MaybeT W WindowLayout
-handleWindowMessage m (WindowLayout l) = WindowLayout <$> handleMessage m l
-
--- | Using the 'Layout' as a witness, parse existentially wrapped windows
--- from a 'String'.
-readWindowLayout :: WindowLayout -> String -> WindowLayout
-readWindowLayout (WindowLayout l) s
-  | (Just x) <- readLayout s =
-      WindowLayout (asTypeOf x l)
-readWindowLayout l _ = l
-
--- | Serializes a window layout to a string.
-serializeWindowLayout :: WindowLayout -> String
-serializeWindowLayout (WindowLayout l) = serializeLayout l
-
-type ScreenId = ()
-
-type ScreenDetail = ()
-
-type Tag = String
-
-newtype ReadPtr a = ReadPtr (Ptr ())
-
-instance Read (ReadPtr a) where
-  readPrec = fmap (ReadPtr . intPtrToPtr) readPrec
-
-instance Show (ReadPtr a) where
-  show (ReadPtr ptr) = show (ptrToIntPtr ptr)
-
-type Montis = StablePtr (Context, State)
-
--- Read-only context under which montis is run under.
-data Context = Context
-  { ctxConfig :: Config WindowLayout,
-    ctxPlugin :: Ptr Void
-  }
-
-defaultHooks :: Hooks
-defaultHooks =
-  Hooks
-    { keyHook = \_ -> return (),
-      surfaceHook = handleSurface,
-      buttonHook = \_ -> return ()
-    }
-
-defaultConfig :: Config ()
-defaultConfig =
-  Config
-    { hooks = defaultHooks,
-      layout = (),
-      resetHook = return ()
-    }
-
-data Hooks = Hooks
-  { keyHook :: KeyEvent -> W (),
-    surfaceHook :: SurfaceEvent -> W (),
-    buttonHook :: ButtonEvent -> W ()
-  }
-
-data Config l = Config
-  { layout :: l,
-    hooks :: Hooks,
-    resetHook :: W ()
-  }
-
--- | Typeclass defining the set of types which can be used as state extensions
--- to the W monad. These state extensions may be persistent or not.
---
--- There are default implementations for all methods if the type implements
--- Read, Show and Default,
-class (Typeable a) => ExtensionClass a where
-  -- | The initial value used for the first time an extension is 'gotten' or
-  -- demarshalling fails.
-  initialValue :: a
-
-  -- | Transforms a type into a string. If the type cannot be marshalled, this
-  -- function should return Nothing.
-  --
-  -- If a type cannot be marshalled, it cannot persist across hot reloads.
-  marshalExtension :: a -> Maybe String
-
-  -- | Reads an extension from a string. If this type is not marshallable or
-  -- reading fails, this function should return Nothing.
-  demarshalExtension :: String -> Maybe a
-
-  -- | If the type implements Default, use the default implementation.
-  default initialValue :: (Default a) => a
-  initialValue = def
-
-  -- | If the type implements Show, use show for the marshalling.
-  default marshalExtension :: (Show a) => a -> Maybe String
-  marshalExtension = Just . show
-
-  -- | If the type implements Read, use read for the demarshalling.
-  default demarshalExtension :: (Read a) => String -> Maybe a
-  demarshalExtension = readMaybe
-
-data StateExtension where
-  StateExtension :: (ExtensionClass a) => a -> StateExtension
-
--- | Puts a state extension.
-xput :: forall a m. (ExtensionClass a, Wlike m) => a -> m ()
-xput val = liftW $ do
-  modify' $ \state@State {extensibleState = extensibleState} ->
-    state
-      { extensibleState =
-          M.insert
-            ( xRepr (Proxy :: Proxy a)
-            )
-            (Right $ StateExtension val)
-            extensibleState
-      }
-
--- | Modifies a state extension.
-xmodify :: forall a m. (ExtensionClass a, Wlike m) => (a -> a) -> m ()
-xmodify fn = xput . fn =<< xget
-
--- | Modifies a state extension in the monadic context.
-xmodifyM :: forall a m. (ExtensionClass a, Wlike m) => (a -> m a) -> m ()
-xmodifyM fn = (xput <=< fn) =<< xget
-
--- | Produces a string representation of a type used to key into the extensible
--- state map.
-xRepr :: forall proxy a. (ExtensionClass a) => proxy a -> String
-xRepr _ = tyconToStr $ someTypeRepTyCon (someTypeRep (Proxy :: Proxy a))
-  where
-    tyconToStr tc =
-      printf "%s.%s.%s" (tyConPackage tc) (tyConModule tc) (tyConName tc)
-
--- | Gets a state extension.
-xget :: forall a m. (ExtensionClass a, Wlike m) => m a
-xget = do
-  xs <- liftW $ gets extensibleState
-  case M.lookup (xRepr (Proxy :: Proxy a)) xs of
-    Just (Right (StateExtension a)) -> return (fromMaybe initialValue (cast a))
-    Just (Left str) ->
-      let v = fromMaybe initialValue (demarshalExtension str)
-       in xput v >> return v
-    Nothing ->
-      xput (initialValue :: a) >> return initialValue
-
-xgets :: forall a b m. (ExtensionClass a, Wlike m) => (a -> b) -> m b
-xgets fn = fn <$> xget
-
--- State as it is marshalled. Used for derived instances of Show and Read.
-data MarshalledState
-  = MarshalledState
-      (StackSet ScreenId ScreenDetail Tag String Window)
-      (Set Window)
-      [(String, String)]
-  deriving (Show, Read)
-
-data State = State
-  { -- The datastructure containing the state of the windows.
-    mapped :: StackSet ScreenId ScreenDetail Tag WindowLayout Window,
-    -- | All the windows wetterhorn knows about, even if they are not mapped.
-    allWindows :: Set Window,
-    -- | Current set of hooks. The initial hooks are provided by the
-    -- configuration, but the hooks can change during operation. This is how key
-    -- sequences can be mapped.
-    currentHooks :: Hooks,
-    -- | Map from the typerep string to the state extension.
-    extensibleState :: Map String (Either String StateExtension)
-  }
-
--- | Initializes a "cold" state from a configuration. A cold state is the
--- initial state on startup. It is constrasted with a "hot" state, which is a
--- persisted state after a hot-reload.
-initColdState :: Config WindowLayout -> IO State
-initColdState Config {layout = layout, hooks = hooks} =
-  return $
-    State
-      ( StackSet (Screen () () (Workspace "0" layout (Stack [] []))) [] []
-      )
-      mempty
-      hooks
-      mempty
-
--- | Marshals the serializable parts of the state to a string. This happens
--- during a hot-reload where some state must be saved to persist across hot
--- reloads.
-marshalState :: State -> String
-marshalState
-  ( State
-      { mapped = mapped,
-        allWindows = allWindows,
-        extensibleState = xs
-      }
-    ) =
-    show $
-      MarshalledState
-        (mapLayout serializeWindowLayout mapped)
-        allWindows
-        (mapMaybe (\(k, v) -> (k,) <$> doMarshalEx v) (M.toList xs))
-    where
-      doMarshalEx (Left s) = Just s
-      doMarshalEx (Right (StateExtension a)) = marshalExtension a
-
--- | Demarshals the string from "marshalState" into a state. Uses the provided
--- config to fill out non-persistent parts of the state.
-demarshalState :: Config WindowLayout -> String -> State
-demarshalState Config {hooks = hooks, layout = layout} str =
-  State mapped allWindows hooks xs
-  where
-    ( MarshalledState
-        (mapLayout (readWindowLayout layout) -> mapped)
-        allWindows
-        (fmap Left . M.fromList -> xs)
-      ) = read str
-
--- | This is _the_ main monad used for Montis operations. Contains
--- everything required to operate. Contains the state, configuration and
--- interface to foreign code.
-newtype W a = W (ReaderT Context (StateT State IO) a)
-  deriving (Functor, Applicative, Monad, MonadState State, MonadIO)
-
--- | Let Config be the thing W is a reader for. There is already a way to get
--- the foreign interface in the context.
-instance MonadReader (Config WindowLayout) W where
-  local fn (W r) = W $ local (\(Context conf plug) -> Context (fn conf) plug) r
-  ask = W $ ctxConfig <$> ask
-
-runW :: W a -> (Context, State) -> IO (a, State)
-runW (W fn) (ctx, st) = runStateT (runReaderT fn ctx) st
-
-wio :: IO a -> W a
-wio = liftIO
-
--- | Type class to lift an arbitrary 'W' computation into another monad.
-class (Monad m) => Wlike m where
-  liftW :: W a -> m a
-
--- | Trivial instance of W for Wlike.
-instance Wlike W where
-  liftW = id
-
--- Default implementations for common handlers.
-
--- | handles a new surface event. This updates the state to reflect how it
--- should look in the harness.
-handleSurface :: SurfaceEvent -> W ()
-handleSurface (SurfaceEvent state (Window -> win)) =
-  case state of
-    Destroy ->
-      modify $
-        \st@State
-           { allWindows = allWindows,
-             mapped = mapped
-           } ->
-            st
-              { allWindows = Set.delete win allWindows,
-                mapped = StackSet.delete win mapped
-              }
-    Unmap -> modify $
-      \st@State {mapped = mapped} ->
-        st
-          { mapped = StackSet.delete win mapped
-          }
-    Map -> modify $
-      \st@State {mapped = mapped, allWindows = allWindows} ->
-        st
-          { mapped = StackSet.insertTiled win mapped,
-            allWindows = Set.insert win allWindows
-          }
diff --git a/plug/src/Montis/Dsl/Bind.hs b/plug/src/Montis/Dsl/Bind.hs
deleted file mode 100644
index 8d4e173..0000000
--- a/plug/src/Montis/Dsl/Bind.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
--- | eDSL for the 'bind' function. The 'bind' function provides an easy way to
--- bind certain actions to other actions.
-module Montis.Dsl.Bind
-  ( bind,
-    (.+),
-    MatchEvent (..),
-    MatchModifiers (..),
-    Modifier (..),
-    released,
-    weak,
-    run,
-    modifierToMask,
-    module X,
-  )
-where
-
-import Control.Monad
-import Data.Bits
-import Data.Word
-import Montis.Core.ButtonEvent (ButtonEvent (..))
-import qualified Montis.Core.ButtonEvent as ButtonEvent
-import Montis.Core.KeyEvent (KeyEvent (..))
-import qualified Montis.Core.KeyEvent as KeyEvent
-import Montis.Core.W
-import Montis.Dsl.Buttons as X
-import Montis.Dsl.Input
-
-class MatchEvent m where
-  matches :: m -> InputEvent -> W Bool
-
-instance MatchEvent (InputEvent -> W Bool) where
-  matches = ($)
-
-instance MatchEvent Char where
-  matches ch (InputKeyEvent ke) = return $ KeyEvent.codepoint ke == ch
-  matches _ _ = return False
-
-instance MatchEvent Button where
-  matches (Button b) (InputButtonEvent be) =
-    return $ ButtonEvent.button be == b
-  matches _ _ = return False
-
--- | Enumeration of possible modifiers.
---
--- ModX can be used for extra user-defined modifiers which are not standard xkb
--- modifiers.
-data Modifier
-  = Shift
-  | Lock
-  | Control
-  | Mod1
-  | Mod2
-  | Mod3
-  | Mod4
-  | Mod5
-  | ModX Int
-  deriving (Eq, Ord, Show, Read)
-
--- | Converts a modifier to its associated mask.
-modifierToMask :: Modifier -> Word32
-modifierToMask m =
-  1
-    `shiftL` case m of
-      Shift -> 0
-      Lock -> 1
-      Control -> 2
-      Mod1 -> 3
-      Mod2 -> 4
-      Mod3 -> 5
-      Mod4 -> 6
-      Mod5 -> 7
-      ModX b -> b + 8
-
-released :: (MatchEvent m) => m -> InputEvent -> W Bool
-released me ev | not (isPressEvent ev) = matches me ev
-released _ _ = return False
-
-data MatchModifiers = MatchModifiers
-  { weakModifierMatch :: Bool,
-    modifierMask :: Word32,
-    baseMatch :: InputEvent -> W Bool
-  }
-
-instance MatchEvent MatchModifiers where
-  matches (MatchModifiers weakMatch bits base) ev = do
-    mods <- getMods ev
-    b <- liftW $ base ev
-
-    return $
-      b
-        && ( (not weakMatch && mods == bits)
-               || (weakMatch && (bits .&. mods == bits))
-           )
-    where
-      getMods (InputButtonEvent (ButtonEvent {ButtonEvent.modifiers = mods})) = return mods
-      getMods (InputKeyEvent (KeyEvent {KeyEvent.modifiers = mods})) = return mods
-
-class LiftMatchModifiers a where
-  toModifiers :: a -> MatchModifiers
-  default toModifiers :: (MatchEvent a) => a -> MatchModifiers
-  toModifiers = MatchModifiers False 0 . matches
-
-instance LiftMatchModifiers MatchModifiers where
-  toModifiers = id
-
-instance LiftMatchModifiers Char
-
-instance LiftMatchModifiers Button
-
--- toModifiers ch = MatchModifiers False 0 (matches ch)
-
-(.+) :: (LiftMatchModifiers mods) => Modifier -> mods -> MatchModifiers
-(.+) modifier (toModifiers -> (MatchModifiers b mask base)) =
-  MatchModifiers b (mask .|. modifierToMask modifier) base
-
-infixr 9 .+
-
-bind :: (MatchEvent match) => InputEvent -> match -> InputM spy () -> InputM spy ()
-bind ev match action = do
-  matches' <- liftW $ matches match ev
-  when matches' (action >> continue)
-
-weak :: MatchModifiers -> MatchModifiers
-weak m = m {weakModifierMatch = True}
-
-run :: W () -> InputM spy ()
-run = liftW
diff --git a/plug/src/Montis/Dsl/Buttons.hsc b/plug/src/Montis/Dsl/Buttons.hsc
deleted file mode 100644
index a73ccc6..0000000
--- a/plug/src/Montis/Dsl/Buttons.hsc
+++ /dev/null
@@ -1,230 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-module Montis.Dsl.Buttons where
-
-import Data.Word
-
-#include </usr/include/linux/input-event-codes.h>
-
-data Button = Button Word32
-
-btnMisc :: Button
-btnMisc = Button #const BTN_MISC
-
-btn0 :: Button
-btn0 = Button #const BTN_0
-
-btn1 :: Button
-btn1 = Button #const BTN_1
-
-btn2 :: Button
-btn2 = Button #const BTN_2
-
-btn3 :: Button
-btn3 = Button #const BTN_3
-
-btn4 :: Button
-btn4 = Button #const BTN_4
-
-btn5 :: Button
-btn5 = Button #const BTN_5
-
-btn6 :: Button
-btn6 = Button #const BTN_6
-
-btn7 :: Button
-btn7 = Button #const BTN_7
-
-btn8 :: Button
-btn8 = Button #const BTN_8
-
-btn9 :: Button
-btn9 = Button #const BTN_9
-
-btnMouse :: Button
-btnMouse = Button #const BTN_MOUSE
-
-btnLeft :: Button
-btnLeft = Button #const BTN_LEFT
-
-btnRight :: Button
-btnRight = Button #const BTN_RIGHT
-
-btnMiddle :: Button
-btnMiddle = Button #const BTN_MIDDLE
-
-btnSide :: Button
-btnSide = Button #const BTN_SIDE
-
-btnExtra :: Button
-btnExtra = Button #const BTN_EXTRA
-
-btnForward :: Button
-btnForward = Button #const BTN_FORWARD
-
-btnBack :: Button
-btnBack = Button #const BTN_BACK
-
-btnTask :: Button
-btnTask = Button #const BTN_TASK
-
-btnJoystick :: Button
-btnJoystick = Button #const BTN_JOYSTICK
-
-btnTrigger :: Button
-btnTrigger = Button #const BTN_TRIGGER
-
-btnThumb :: Button
-btnThumb = Button #const BTN_THUMB
-
-btnThumb2 :: Button
-btnThumb2 = Button #const BTN_THUMB2
-
-btnTop :: Button
-btnTop = Button #const BTN_TOP
-
-btnTop2 :: Button
-btnTop2 = Button #const BTN_TOP2
-
-btnPinkie :: Button
-btnPinkie = Button #const BTN_PINKIE
-
-btnBase :: Button
-btnBase = Button #const BTN_BASE
-
-btnBase2 :: Button
-btnBase2 = Button #const BTN_BASE2
-
-btnBase3 :: Button
-btnBase3 = Button #const BTN_BASE3
-
-btnBase4 :: Button
-btnBase4 = Button #const BTN_BASE4
-
-btnBase5 :: Button
-btnBase5 = Button #const BTN_BASE5
-
-btnBase6 :: Button
-btnBase6 = Button #const BTN_BASE6
-
-btnDead :: Button
-btnDead = Button #const BTN_DEAD
-
-btnGamepad :: Button
-btnGamepad = Button #const BTN_GAMEPAD
-
-btnSouth :: Button
-btnSouth = Button #const BTN_SOUTH
-
-btnA :: Button
-btnA = Button #const BTN_A
-
-btnEast :: Button
-btnEast = Button #const BTN_EAST
-
-btnB :: Button
-btnB = Button #const BTN_B
-
-btnC :: Button
-btnC = Button #const BTN_C
-
-btnNorth :: Button
-btnNorth = Button #const BTN_NORTH
-
-btnX :: Button
-btnX = Button #const BTN_X
-
-btnWest :: Button
-btnWest = Button #const BTN_WEST
-
-btnY :: Button
-btnY = Button #const BTN_Y
-
-btnZ :: Button
-btnZ = Button #const BTN_Z
-
-btnTl :: Button
-btnTl = Button #const BTN_TL
-
-btnTr :: Button
-btnTr = Button #const BTN_TR
-
-btnTl2 :: Button
-btnTl2 = Button #const BTN_TL2
-
-btnTr2 :: Button
-btnTr2 = Button #const BTN_TR2
-
-btnSelect :: Button
-btnSelect = Button #const BTN_SELECT
-
-btnStart :: Button
-btnStart = Button #const BTN_START
-
-btnMode :: Button
-btnMode = Button #const BTN_MODE
-
-btnThumbl :: Button
-btnThumbl = Button #const BTN_THUMBL
-
-btnThumbr :: Button
-btnThumbr = Button #const BTN_THUMBR
-
-btnDigi :: Button
-btnDigi = Button #const BTN_DIGI
-
-btnToolPen :: Button
-btnToolPen = Button #const BTN_TOOL_PEN
-
-btnToolRubber :: Button
-btnToolRubber = Button #const BTN_TOOL_RUBBER
-
-btnToolBrush :: Button
-btnToolBrush = Button #const BTN_TOOL_BRUSH
-
-btnToolPencil :: Button
-btnToolPencil = Button #const BTN_TOOL_PENCIL
-
-btnToolAirbrush :: Button
-btnToolAirbrush = Button #const BTN_TOOL_AIRBRUSH
-
-btnToolFinger :: Button
-btnToolFinger = Button #const BTN_TOOL_FINGER
-
-btnToolMouse :: Button
-btnToolMouse = Button #const BTN_TOOL_MOUSE
-
-btnToolLens :: Button
-btnToolLens = Button #const BTN_TOOL_LENS
-
-btnToolQuinttap :: Button
-btnToolQuinttap = Button #const BTN_TOOL_QUINTTAP
-
-btnStylus3 :: Button
-btnStylus3 = Button #const BTN_STYLUS3
-
-btnTouch :: Button
-btnTouch = Button #const BTN_TOUCH
-
-btnStylus :: Button
-btnStylus = Button #const BTN_STYLUS
-
-btnStylus2 :: Button
-btnStylus2 = Button #const BTN_STYLUS2
-
-btnToolDoubletap :: Button
-btnToolDoubletap = Button #const BTN_TOOL_DOUBLETAP
-
-btnToolTripletap :: Button
-btnToolTripletap = Button #const BTN_TOOL_TRIPLETAP
-
-btnToolQuadtap :: Button
-btnToolQuadtap = Button #const BTN_TOOL_QUADTAP
-
-btnWheel :: Button
-btnWheel = Button #const BTN_WHEEL
-
-btnGearDown :: Button
-btnGearDown = Button #const BTN_GEAR_DOWN
-
-btnGearUp :: Button
-btnGearUp = Button #const BTN_GEAR_UP
diff --git a/plug/src/Montis/Dsl/Input.hs b/plug/src/Montis/Dsl/Input.hs
deleted file mode 100644
index 1ead0c7..0000000
--- a/plug/src/Montis/Dsl/Input.hs
+++ /dev/null
@@ -1,284 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module Montis.Dsl.Input
-  ( InputM,
-    InputEvent (..),
-    InputProxy (..),
-    NoProxy,
-    withProxies,
-    forwardEvent,
-    forwardKey,
-    whenKeyEvent,
-    whenButtonEvent,
-    useInputHandler,
-    unwrap,
-    filterEvent,
-    isPressEvent,
-    nextInputEventThat,
-    replayEvents,
-    isKeyEvent,
-    nextInputPressEvent,
-    continue,
-    nextInputEvent,
-    getModifierState,
-  )
-where
-
-import Control.Monad
-import Control.Monad.Cont (MonadCont)
-import Control.Monad.Loops (andM)
-import Control.Monad.RWS
-  ( MonadIO (liftIO),
-    MonadReader (ask),
-    MonadState (get),
-    MonadTrans (lift),
-    RWST,
-    execRWST,
-    gets,
-    modify,
-  )
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
-import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.Proxy
-import Data.Word (Word32)
-import Montis.Core.ButtonEvent qualified as ButtonEvent
-import Montis.Core.KeyEvent qualified as KeyEvent
-import Montis.Core.W (W (..))
-import Montis.Core.W qualified as W
-import Montis.Foreign.WlRoots (guardNull, wlrKeyboardGetModifiers, wlrSeatGetKeyboard, wlrSeatKeyboardNotifyKey, wlrSeatSetKeyboard)
-import Montis.Core.Runtime (getSeat)
-
-class InputProxy (spy :: k) where
-  onKeyEvent :: Proxy spy -> InputEvent -> MaybeT W InputEvent
-
-instance (InputProxy h, InputProxy t) => InputProxy (h ': t) where
-  onKeyEvent _ = onKeyEvent (Proxy :: Proxy h) <=< onKeyEvent (Proxy :: Proxy t)
-
-instance InputProxy '[] where
-  onKeyEvent _ = return
-
-data NoProxy
-
-instance InputProxy NoProxy where
-  onKeyEvent _ = return
-
-instance (InputProxy s1, InputProxy s2) => InputProxy (s1, s2) where
-  onKeyEvent proxy = onKeyEvent (fmap fst proxy) <=< onKeyEvent (fmap snd proxy)
-
--- | Union of event types.
-data InputEvent
-  = InputButtonEvent ButtonEvent.ButtonEvent
-  | InputKeyEvent KeyEvent.KeyEvent
-
--- | Context for the input.
-newtype InputContext spy = InputContext
-  { -- | Top of the input routine. Used in "continue" statement.
-    inputTop :: InputM spy ()
-  }
-
-newtype InputState spy = InputState
-  { inputSource :: InputM spy InputEvent
-  }
-
--- | Input monad for handling all kinds of input.
-newtype InputM spy a = InputM (ContT () (RWST (InputContext spy) () (InputState spy) W) a)
-  deriving (Monad, Functor, Applicative, MonadCont, MonadIO)
-
-instance MonadFail (InputM spy) where
-  fail _ = continue
-
--- | Lifts a W action to an InputM action.
-instance W.Wlike (InputM spy) where
-  liftW = InputM . lift . lift
-
--- | Resets the input handler to the top.
-continue :: InputM spy a
-continue = do
-  (InputContext {inputTop = (InputM top)}) <- InputM ask
-  InputM $ shiftT (\_ -> resetT top)
-
--- | Forwards the given key event to the focused window.
-forwardKey :: KeyEvent.KeyEvent -> W ()
-forwardKey keyEvent = do
-  seatPtr <- getSeat
-  W.wio $ do
-    wlrSeatSetKeyboard
-      seatPtr
-      (KeyEvent.device keyEvent)
-
-    wlrSeatKeyboardNotifyKey
-      seatPtr
-      (KeyEvent.timeMs keyEvent)
-      (KeyEvent.keycode keyEvent)
-      ( case KeyEvent.state keyEvent of
-          KeyEvent.KeyReleased -> 0
-          _ -> 1
-      )
-
--- | Executes a function if the input event is a key event. If it is not a key
--- event, then nothing happens.
-whenKeyEvent :: (Monad m) => InputEvent -> (KeyEvent.KeyEvent -> m ()) -> m ()
-whenKeyEvent (InputKeyEvent ke) = ($ ke)
-whenKeyEvent _ = const (return ())
-
--- | Executes a function in the input event is a button event. If it is not a
--- button event, then nothing happens.
-whenButtonEvent ::
-  (Monad m) => InputEvent -> (ButtonEvent.ButtonEvent -> m ()) -> m ()
-whenButtonEvent (InputButtonEvent be) = ($ be)
-whenButtonEvent _ = const (return ())
-
--- | Forwards the given input event to focused window.
-forwardEvent :: (W.Wlike m) => InputEvent -> m ()
-forwardEvent = \case
-  InputKeyEvent kv -> W.liftW $ forwardKey kv
-  InputButtonEvent _ -> return ()
-
--- | "Unwraps" a maybe. If the maybe is present, the handler proceeds. If the
--- maybe is not present, the handler restarts execution from the top.
-unwrap :: Maybe a -> InputM spy a
-unwrap (Just val) = return val
-unwrap Nothing = continue
-
--- | Runs the series of events from the top as if they were input.
-replayEvents :: [InputEvent] -> InputM spy ()
-replayEvents events = do
-  ioref <- liftIO (newIORef events)
-
-  (InputM oldInput) <- InputM $ gets inputSource
-
-  let newInput =
-        InputM $
-          shiftT
-            ( \thingToDo -> do
-                r <- liftIO (readIORef ioref)
-                case r of
-                  [] -> do
-                    modify $ \st -> st {inputSource = InputM oldInput}
-                    a <- oldInput
-                    lift (thingToDo a)
-                  (a : as) -> do
-                    liftIO (writeIORef ioref as)
-                    lift (thingToDo a)
-            )
-
-  InputM $ modify $ \st -> st {inputSource = newInput}
-
--- | Call in the reset handler with the InputM handler you wolud like to use.
-useInputHandler :: (InputProxy spy) => InputM spy () -> W ()
-useInputHandler (forever -> top@(InputM ctop)) = do
-  void $ execRWST (runContT ctop return) (InputContext top) (InputState useSeatEvents)
-
--- | Returns the next input event that's either a kep press or a button press.
-nextInputPressEvent :: InputM spy InputEvent
-nextInputPressEvent = nextInputEventThat (andM [isPressEvent, not . modifierKey])
-
-modifierKey :: InputEvent -> Bool
-modifierKey (InputKeyEvent (KeyEvent.KeyEvent {codepoint = '\NUL'})) = True
-modifierKey _ = False
-
-nextInputEventThat :: (InputEvent -> Bool) -> InputM spy InputEvent
-nextInputEventThat fn =
-  nextInputEvent
-    >>= ( \ie ->
-            if fn ie
-              then return ie
-              else forwardEvent ie >> nextInputEventThat fn
-        )
-
-isKeyEvent :: InputEvent -> Bool
-isKeyEvent (InputKeyEvent _) = True
-isKeyEvent _ = False
-
-isPressEvent :: InputEvent -> Bool
-isPressEvent (InputButtonEvent be)
-  | ButtonEvent.state be == ButtonEvent.ButtonPressed =
-      True
-isPressEvent (InputKeyEvent ke)
-  | KeyEvent.state ke == KeyEvent.KeyPressed =
-      True
-isPressEvent _ = False
-
--- | Returns the event only if it matches the filter. If it does not match the
--- filter, execution resets to the top.
-filterEvent :: (InputEvent -> Bool) -> InputEvent -> InputM spy InputEvent
-filterEvent fn ev | fn ev = return ev
-filterEvent _ _ = continue
-
-getModifierState :: W Word32
-getModifierState = do
-  seat <- getSeat
-  keyboard <- W.wio $ wlrSeatGetKeyboard seat
-  maybe (return 0) (W.wio . wlrKeyboardGetModifiers) (guardNull keyboard)
-
-nextInputEvent :: InputM spy InputEvent
-nextInputEvent = join $ InputM $ gets inputSource
-
-withProxies :: Proxy spy -> InputM spy a -> InputM spy a
-withProxies _ = id
-
--- | Gets the next input event.
-useSeatEvents :: forall spy. (InputProxy spy) => InputM spy InputEvent
-useSeatEvents =
-  InputM $
-    shiftT
-      ( \thingToDo -> do
-          putButtonHandler $ \be -> do
-            runSpies thingToDo (InputButtonEvent be)
-
-          putKeyHandler $ \ke -> do
-            runSpies thingToDo (InputKeyEvent ke)
-      )
-  where
-    runSpies fn ev = do
-      evM <- lift $ runMaybeT (onKeyEvent (Proxy :: Proxy spy) ev)
-      mapM_
-        ( \ev' -> do
-            clearButtonHandler
-            clearKeyHandler
-            fn ev'
-        )
-        evM
-
-    clearButtonHandler =
-      lift $
-        modify $ \st ->
-          st
-            { W.currentHooks =
-                (W.currentHooks st)
-                  { W.buttonHook = const (return ())
-                  }
-            }
-
-    clearKeyHandler =
-      lift $
-        modify $ \st ->
-          st
-            { W.currentHooks =
-                (W.currentHooks st)
-                  { W.keyHook = const (return ())
-                  }
-            }
-
-    putButtonHandler h = lift $ do
-      (r, s) <- (,) <$> ask <*> get
-      lift $
-        modify $ \st ->
-          st
-            { W.currentHooks =
-                (W.currentHooks st)
-                  { W.buttonHook = \be -> void (execRWST (h be) r s)
-                  }
-            }
-
-    putKeyHandler h = lift $ do
-      (r, s) <- (,) <$> ask <*> get
-      lift $
-        modify $ \st ->
-          st
-            { W.currentHooks =
-                (W.currentHooks st)
-                  { W.keyHook = \ke -> void (execRWST (h ke) r s)
-                  }
-            }
diff --git a/plug/src/Montis/Foreign.hs b/plug/src/Montis/Foreign.hs
deleted file mode 100644
index fbbfb08..0000000
--- a/plug/src/Montis/Foreign.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Montis.Foreign
-  ( TypedIntPtr (..),
-    toPtr,
-    fromPtr,
-  )
-where
-
-import Foreign (IntPtr, Ptr)
-import qualified Foreign
-
-toPtr :: TypedIntPtr a -> Ptr a
-toPtr (TypedIntPtr ip) = Foreign.intPtrToPtr ip
-
-fromPtr :: Ptr a -> TypedIntPtr a
-fromPtr = TypedIntPtr . Foreign.ptrToIntPtr
-
-newtype TypedIntPtr a = TypedIntPtr IntPtr
-  deriving (Show, Read, Eq, Ord, Num)
diff --git a/plug/src/Montis/Foreign/Export.hs b/plug/src/Montis/Foreign/Export.hs
deleted file mode 100644
index bb8efeb..0000000
--- a/plug/src/Montis/Foreign/Export.hs
+++ /dev/null
@@ -1,209 +0,0 @@
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-
--- | This module does not export anything. It exists simply to provide C-symbols
--- for the plugin.
-module Montis.Foreign.Export () where
-
-import Config
-import Control.Arrow (Arrow (first))
-import Control.Monad (forM_)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as CH
-import Foreign
-  ( Ptr,
-    Storable (poke, pokeByteOff),
-    Word32,
-    Word8,
-    deRefStablePtr,
-    freeStablePtr,
-    mallocBytes,
-    newStablePtr,
-  )
-import Foreign.C (CChar, CInt (..))
-import Montis.Core.ButtonEvent (ButtonEvent (ButtonEvent), ButtonState (ButtonPressed, ButtonReleased))
-import Montis.Core.KeyEvent (KeyEvent (..), KeyState (..))
-import Montis.Core.SurfaceEvent (SurfaceEvent (SurfaceEvent))
-import Montis.Core.W (Montis, W)
-import qualified Montis.Core.W as W
-import Montis.Foreign.ForeignInterface
-import Montis.Foreign.WlRoots
-import Data.Void (Void)
-
-type Wetter = (W.Config W.WindowLayout, W.State)
-
-toWetter :: (W.Context, W.State) -> (W.Config W.WindowLayout, W.State)
-toWetter = first W.ctxConfig
-
-runForeign :: (Wetter -> W ()) -> Montis -> IO Montis
-runForeign fn stblptr = do
-  w@(ctx, st) <- deRefStablePtr stblptr
-  freeStablePtr stblptr
-  (_, state') <- W.runW (fn $ toWetter w) (ctx, st)
-  newStablePtr (ctx, state')
-
-runForeignWithReturn ::
-  (Storable a) => (Wetter -> W a) -> Ptr a -> Montis -> IO Montis
-runForeignWithReturn fn ptr stableptr = do
-  w@(ctx, st) <- deRefStablePtr stableptr
-  freeStablePtr stableptr
-  (val, state') <- W.runW (fn $ toWetter w) (ctx, st)
-  poke ptr val
-  newStablePtr (ctx, state')
-
-runForeignWithReturn2 ::
-  (Storable a, Storable b) =>
-  (Wetter -> W (a, b)) ->
-  Ptr a ->
-  Ptr b ->
-  Montis ->
-  IO Montis
-runForeignWithReturn2 fn ptrA ptrB stableptr = do
-  w@(ctx, st) <- deRefStablePtr stableptr
-  freeStablePtr stableptr
-  ((vA, vB), state') <- W.runW (fn $ toWetter w) (ctx, st)
-  poke ptrA vA
-  poke ptrB vB
-  newStablePtr (ctx, state')
-
--- | This function is the implementation of the "hotstart" mechanism. It gives a
--- pointer to the previously marshalled state and the length of that array and
--- this function returns a Montis instance.
-foreign export ccall "plugin_hot_start"
-  pluginHotStart ::
-    Ptr Void -> Ptr CChar -> Word32 -> IO Montis
-
-pluginHotStart :: Ptr Void -> Ptr CChar -> Word32 -> IO Montis
-pluginHotStart self chars len = do
-  bs <- BS.packCStringLen (chars, fromIntegral len)
-  wtr <-
-    newStablePtr
-      ( W.Context config self,
-        W.demarshalState config (CH.unpack bs)
-      )
-  runForeign (\(conf, _) -> W.resetHook conf) wtr
-
--- | This function is called when a "coldstart" request is receieved. It just
--- calles the function "wetterhorn". This function should be defined in the main
--- code as it's sort-of the equivalent of XMonad's "main" function.
-foreign export ccall "plugin_cold_start"
-  pluginColdStart :: Ptr Void -> IO Montis
-
-pluginColdStart :: Ptr Void -> IO Montis
-pluginColdStart self = do
-  state <- W.initColdState config
-  wtr <- newStablePtr (W.Context config self, state)
-  runForeign (\(conf, _) -> W.resetHook conf) wtr
-
--- | Marshals the opaque state to a C-style byte array and size pointer.
-foreign export ccall "plugin_marshal_state"
-  pluginMarshalState :: Montis -> Ptr Word32 -> IO (Ptr Word8)
-
-pluginMarshalState :: Montis -> Ptr Word32 -> IO (Ptr Word8)
-pluginMarshalState stblptr outlen = do
-  (_, st) <- deRefStablePtr stblptr
-  let bs = CH.pack (W.marshalState st)
-  ret <- mallocBytes (BS.length bs)
-  poke outlen (fromIntegral $ BS.length bs)
-  forM_ (zip [0 ..] (BS.unpack bs)) $ \(off, w8) -> do
-    pokeByteOff ret off w8
-  return ret
-
-foreign export ccall "plugin_handle_button"
-  pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> Montis -> IO Montis
-
-pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> Montis -> IO Montis
-pluginHandleButton eventPtr modifiers = do
-  runForeign $
-    \( _,
-       W.State {W.currentHooks = W.Hooks {buttonHook = buttonHook}}
-       ) -> do
-        event <- W.wio $
-          runForeignDemarshal eventPtr $ do
-            ButtonEvent
-              <$> demarshal
-              <*> demarshal
-              <*> demarshal
-              <*> pure modifiers
-              <*> ( ( \u8 ->
-                        if (u8 :: Word8) == 0
-                          then ButtonReleased
-                          else ButtonPressed
-                    )
-                      <$> demarshal
-                  )
-
-        buttonHook event
-
-foreign export ccall "plugin_handle_keybinding"
-  pluginHandleKeybinding ::
-    Ptr WlrInputDevice ->
-    Ptr WlrEventKeyboardKey ->
-    Word32 ->
-    Word32 ->
-    Word32 ->
-    Ptr CInt ->
-    Montis ->
-    IO Montis
-
-pluginHandleKeybinding ::
-  Ptr WlrInputDevice ->
-  Ptr WlrEventKeyboardKey ->
-  Word32 ->
-  Word32 ->
-  Word32 ->
-  Ptr CInt ->
-  Montis ->
-  IO Montis
-pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp =
-  runForeignWithReturn $
-    \( _,
-       W.State {W.currentHooks = W.Hooks {keyHook = keyHook}}
-       ) -> do
-        event <- W.wio $
-          runForeignDemarshal eventPtr $ do
-            tMs <- demarshal
-            kc <- demarshal
-            _ <- (demarshal :: ForeignDemarshal Word32)
-            keyState <- demarshal
-            return $
-              KeyEvent
-                tMs
-                kc
-                (if keyState == (0 :: Word8) then KeyReleased else KeyPressed)
-                mods
-                sym
-                (toEnum $ fromIntegral cp)
-                inputDevicePtr
-        keyHook event
-        return 1
-
--- | Function exported to the harness to handle the mapping/unmapping/deletion
--- of an XDG surface.
-foreign export ccall "plugin_handle_surface"
-  pluginHandleSurface ::
-    Ptr WlrXdgSurface -> CInt -> Montis -> IO Montis
-
-pluginHandleSurface :: Ptr WlrXdgSurface -> CInt -> Montis -> IO Montis
-pluginHandleSurface p t =
-  runForeign
-    ( \(_, W.State {currentHooks = W.Hooks {surfaceHook = surfaceHook}}) ->
-        surfaceHook $
-          SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)
-    )
-
--- | Function exported to the harness to handle the mapping/unmapping/deletion
--- of an XWayland surface.
-foreign export ccall "plugin_handle_xwayland_surface"
-  pluginHandleXWaylandSurface ::
-    Ptr WlrXWaylandSurface -> CInt -> Montis -> IO Montis
-
-pluginHandleXWaylandSurface ::
-  Ptr WlrXWaylandSurface -> CInt -> Montis -> IO Montis
-pluginHandleXWaylandSurface p t =
-  runForeign
-    ( \( _,
-         W.State
-           { currentHooks = W.Hooks {surfaceHook = surfaceHook}
-           }
-         ) -> surfaceHook $ SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)
-    )
diff --git a/plug/src/Montis/Foreign/ForeignInterface.hs b/plug/src/Montis/Foreign/ForeignInterface.hs
deleted file mode 100644
index 647fb98..0000000
--- a/plug/src/Montis/Foreign/ForeignInterface.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Montis.Foreign.ForeignInterface
-  ( ForeignDemarshal (..),
-    runForeignDemarshal,
-    demarshal,
-  )
-where
-
-import Control.Monad.State (MonadState (get, put), MonadTrans (lift), StateT, evalStateT)
-import Foreign (Ptr, Storable (peek, sizeOf), castPtr, plusPtr)
-
-newtype ForeignDemarshal a = ForeignDemarshal (StateT (Ptr ()) IO a)
-  deriving (Functor, Monad, Applicative, MonadState (Ptr ()))
-
-runForeignDemarshal :: Ptr b -> ForeignDemarshal a -> IO a
-runForeignDemarshal p (ForeignDemarshal dm) = evalStateT dm (castPtr p)
-
-demarshal :: (Storable a) => ForeignDemarshal a
-demarshal = do
-  ptr <- get
-  val <- ForeignDemarshal $ lift $ peek $ castPtr ptr
-  put (plusPtr ptr (sizeOf val))
-  return val
diff --git a/plug/src/Montis/Foreign/WlRoots.hs b/plug/src/Montis/Foreign/WlRoots.hs
deleted file mode 100644
index c4adaf8..0000000
--- a/plug/src/Montis/Foreign/WlRoots.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Foreign.WlRoots where
-
-import Foreign (IntPtr, Ptr, Word32, intPtrToPtr, nullPtr, ptrToIntPtr)
-import Text.Read
-
-data WlrKeyboard
-
-data WlrPointer
-
-data WlrPointerButtonEvent
-
-data WlrSeat
-
-data WlrInputDevice
-
-data WlrEventKeyboardKey
-
-data WlrXdgSurface
-
-data WlrXWaylandSurface
-
-data Surface
-  = XdgSurface (Ptr WlrXdgSurface)
-  | XWaylandSurface (Ptr WlrXWaylandSurface)
-  deriving (Ord, Eq)
-
-instance Show Surface where
-  show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p))
-  show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p))
-
-instance Read Surface where
-  readPrec = fmap toSurf readPrec
-    where
-      toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip)
-      toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip)
-
--- | Type which exists specifically to derive instances of read and show.
-data SerializableSurface
-  = XdgSerializeSurface IntPtr
-  | XWaylandSerializeSurface IntPtr
-  deriving (Read, Show)
-
-class ForeignSurface a where
-  toSurface :: Ptr a -> Surface
-
-instance ForeignSurface WlrXdgSurface where
-  toSurface = XdgSurface
-
-instance ForeignSurface WlrXWaylandSurface where
-  toSurface = XWaylandSurface
-
-guardNull :: Ptr a -> Maybe (Ptr a)
-guardNull p | p == nullPtr = Nothing
-guardNull p = Just p
-
-foreign import ccall "wlr_seat_set_keyboard"
-  wlrSeatSetKeyboard ::
-    Ptr WlrSeat -> Ptr WlrInputDevice -> IO ()
-
-foreign import ccall "wlr_seat_get_keyboard"
-  wlrSeatGetKeyboard ::
-    Ptr WlrSeat -> IO (Ptr WlrKeyboard)
-
-foreign import ccall "wlr_keyboard_get_modifiers"
-  wlrKeyboardGetModifiers ::
-    Ptr WlrKeyboard -> IO Word32
-
-foreign import ccall "wlr_seat_keyboard_notify_key"
-  wlrSeatKeyboardNotifyKey ::
-    Ptr WlrSeat -> Word32 -> Word32 -> Word32 -> IO ()
diff --git a/plug/src/Montis/Keys/Macros.hs b/plug/src/Montis/Keys/Macros.hs
deleted file mode 100644
index 37f4db4..0000000
--- a/plug/src/Montis/Keys/Macros.hs
+++ /dev/null
@@ -1,145 +0,0 @@
--- There are constraints used for better type-level enforced safety rules.
-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
-
-module Montis.Keys.Macros
-  ( MacroSupport,
-    macroStartStopKeybind,
-    macroReplayKeybind,
-    stopMacroRecording,
-    startRecording,
-  )
-where
-
-import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.Trans (MonadTrans (lift))
-import Data.Default.Class
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Type.Bool
-import Data.Type.Equality
-import Data.Word
-import Foreign (Ptr)
-import GHC.TypeError
-import Montis.Core.KeyEvent
-import Montis.Core.W
-import Montis.Dsl.Input
-import Montis.Foreign.WlRoots (WlrInputDevice)
-
-data RecordedKey = RecordedKey Word32 Word32 KeyState Word32 Word32 Char
-  deriving (Read, Show)
-
-data MacrosState = MacrosState
-  { macros :: Map String [RecordedKey],
-    currentlyRecording :: Maybe String
-  }
-  deriving (Read, Show)
-
-instance Default MacrosState where
-  def = MacrosState mempty def
-
-instance ExtensionClass MacrosState
-
-type family Find a ls where
-  Find b (a : t) = (b == a) || Find b t
-  Find _ '[] = False
-
--- | Provides a Vim-esque keybinding behavior for macro recording.
---
--- Designed to be used like:
---
---   bind ev (Mod1 .+ 'q') macroStartStopKeybind
-macroStartStopKeybind :: (HasMacroSupport spy) => InputM spy ()
-macroStartStopKeybind = do
-  currentlyRecordingMacro
-    >>= ( \case
-            Just ch -> do
-              liftIO $ putStrLn $ "Done Recording: " ++ ch
-              stopMacroRecording
-            Nothing -> do
-              (InputKeyEvent (KeyEvent {codepoint = cp})) <- nextInputPressEvent
-              liftIO $ putStrLn $ "Recording: " ++ [cp]
-              startRecording [cp]
-        )
-
--- | Provides a keybinding for replaying a macro.
---
--- Designed to be used like:
---
---   bind ev (weak $ Mod1 .+ '@') macroReplayKeybind
-macroReplayKeybind :: (HasMacroSupport spy) => InputM spy ()
-macroReplayKeybind = do
-  ( InputKeyEvent
-      (KeyEvent {codepoint = cp, device = device})
-    ) <-
-    nextInputPressEvent
-  replayMacro device [cp]
-
-startRecording :: (Wlike m) => String -> m ()
-startRecording ch =
-  xmodify
-    ( \m@MacrosState {macros = macros} ->
-        m
-          { macros = Map.delete ch macros,
-            currentlyRecording = Just ch
-          }
-    )
-
-stopMacroRecording :: (Wlike m) => m ()
-stopMacroRecording = xmodify (\m -> m {currentlyRecording = Nothing})
-
-currentlyRecordingMacro :: (Wlike m) => m (Maybe String)
-currentlyRecordingMacro = xgets currentlyRecording
-
-replayMacro :: Ptr WlrInputDevice -> String -> InputM spy ()
-replayMacro inputDevice s = do
-  m <- liftW (Map.lookup s <$> xgets macros)
-  -- 'tail' is to cut off the last keystroke which stops the recording.
-  mapM_ (replayEvents . map toInputEvent . reverse . tail) m
-  where
-    toInputEvent :: RecordedKey -> InputEvent
-    toInputEvent (RecordedKey ts kc st mo keysym cp) =
-      InputKeyEvent $ KeyEvent ts kc st mo keysym cp inputDevice
-
-pushMacroKey :: (Wlike m) => KeyEvent -> m ()
-pushMacroKey ke = do
-  cur <- xgets currentlyRecording
-  whenJust cur $ \ch -> do
-    let recordedKey = toRecordedKey ke
-     in xmodify $ \m@MacrosState {macros = macros} ->
-          m {macros = Map.insertWith (++) ch [recordedKey] macros}
-  where
-    whenJust (Just a) fn = fn a
-    whenJust _ _ = return ()
-
-    toRecordedKey (KeyEvent ts c s m keysym cp _) = RecordedKey ts c s m keysym cp
-
--- | Phantom type defining a proxy required to support macros.
-data MacroSupport
-
--- | Instance for macro support.
-instance InputProxy MacroSupport where
-  onKeyEvent _ ie = do
-    lift $ whenKeyEvent ie pushMacroKey
-    return ie
-
-class HasMacroSupport t
-
-instance
-  ( If
-      (Find MacroSupport t)
-      True
-      ( TypeError
-          ( Text "This Requires the Macro Proxy to be Enabled."
-              :<>: Text "Please enable this by adding MacroSupport to your"
-              :<>: Text "inputProxies list.\n"
-              :<>: Text "i.e. Change "
-              :<>: ShowType t
-              :<>: Text " to "
-              :<>: ShowType (MacroSupport ': t)
-          )
-      )
-      ~ True
-  ) =>
-  HasMacroSupport t
-
-instance HasMacroSupport MacroSupport
diff --git a/plug/src/Montis/Keys/MagicModifierKey.hs b/plug/src/Montis/Keys/MagicModifierKey.hs
deleted file mode 100644
index f9b87eb..0000000
--- a/plug/src/Montis/Keys/MagicModifierKey.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Keys.MagicModifierKey where
-
-import Control.Monad.RWS (MonadTrans (lift))
-import Control.Monad.Trans.Maybe (MaybeT (..))
-import Data.Data
-import Data.Default.Class
-import GHC.TypeNats
-import Montis.Core.KeyEvent
-import Montis.Core.W
-import Montis.Dsl.Input
-
-data MagicModifierProxy (keycode :: Natural) inputproxy
-  deriving (Typeable)
-
-newtype MagicModifierState (keycode :: Natural) = MagicModifierState {isPressed :: Bool}
-  deriving (Typeable, Eq, Show, Ord, Read)
-
-instance Default (MagicModifierState k) where
-  def = MagicModifierState False
-
-instance (KnownNat k) => ExtensionClass (MagicModifierState k)
-
-instance
-  (KnownNat keycode, InputProxy inputproxy) =>
-  InputProxy (MagicModifierProxy keycode inputproxy)
-  where
-  onKeyEvent proxy ie = do
-    case ie of
-      (InputKeyEvent (KeyEvent {keycode = kc, state = state}))
-        | fromIntegral kc == natVal (keycodeProxy proxy) -> do
-          lift $ setMagicModifierPressed proxy (state == KeyPressed)
-          MaybeT (return Nothing)
-      _ -> do
-        pressed <- lift $ isMagicModifierPressed proxy
-        if pressed
-          then onKeyEvent (Proxy :: Proxy inputproxy) ie
-          else return ie
-    where
-      keycodeProxy :: Proxy (MagicModifierProxy kc a) -> Proxy kc
-      keycodeProxy _ = Proxy
-
-      isMagicModifierPressed p = isPressed <$> getModState p
-      setMagicModifierPressed p = modifyModState p . const
-
-      getModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> W (MagicModifierState kc)
-      getModState _ = xget
-
-      modifyModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> (MagicModifierState kc -> Bool) -> W ()
-      modifyModState _ fn = xmodify (MagicModifierState . fn)
diff --git a/plug/src/Montis/Layout/Combine.hs b/plug/src/Montis/Layout/Combine.hs
deleted file mode 100644
index 8079da3..0000000
--- a/plug/src/Montis/Layout/Combine.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Layout.Combine where
-
-import Data.Typeable
-import Montis.Constraints
-import Montis.Core.W
-
-data (|||) a b = Comb LR a b
-  deriving (Typeable, Read, Show)
-
-data Next = Next
-  deriving (Typeable)
-
-data Reset = Reset
-  deriving (Typeable)
-
-(|||) :: a -> b -> (a ||| b)
-a ||| b = Comb L a b
-
-data LR = L | R deriving (Read, Show, Ord, Eq, Enum)
-
-instance (HandleMessage a, HandleMessage b) => HandleMessage (a ||| b) where
-  handleMessage (fromMessage -> Just Next) (Comb L l r) = return (Comb R l r)
-  handleMessage (fromMessage -> Just Reset) (Comb _ l r) = return (Comb L l r)
-  handleMessage mesg (Comb L l r) =
-    Comb L <$> handleMessage mesg l <*> pure r
-  handleMessage mesg (Comb R l r) =
-    Comb L l <$> handleMessage mesg r
-
-instance (LayoutClass a, LayoutClass b) => LayoutClass (a ||| b) where
-  -- In order to use this layout class, the lay-out type 'a' must satisfy BOTH
-  -- the left and right constraints.
-  type LayoutConstraint (a ||| b) = LayoutConstraint a &&&& LayoutConstraint b
-
-  runLayout as (Comb R r l) = do
-    (r', ret) <- runLayout as r
-    return (Comb R r' l, ret)
-  runLayout as (Comb L r l) = do
-    (l', ret) <- runLayout as l
-    return (Comb R r l', ret)
-
-  serializeLayout (Comb lr l r) = show (Comb lr (serializeLayout l) (serializeLayout r))
-  readLayout str = Comb lr <$> l <*> r
-    where
-      (Comb lr (readLayout -> l) (readLayout -> r)) = read str
-
-  description (Comb _ l r) = description l ++ " ||| " ++ description r
diff --git a/plug/src/Montis/Layout/Full.hs b/plug/src/Montis/Layout/Full.hs
deleted file mode 100644
index 816ddc2..0000000
--- a/plug/src/Montis/Layout/Full.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-
-module Montis.Layout.Full where
-
-import Data.Data (Typeable)
-import Data.Default.Class
-import Montis.Constraints
-import Montis.Core.W
-import Montis.StackSet
-
-data Full = Full
-  deriving (Read, Show, Typeable)
-
-instance Default Full where
-  def = Full
-
-instance HandleMessage Full
-
-instance LayoutClass Full where
-  type LayoutConstraint Full = Unconstrained
-
-  runLayout = pureLayout $ \l _ ->
-    case l of
-      (focused -> Just a) -> [(a, RationalRect 1 1 1 1)]
-      _ -> []
diff --git a/plug/src/Montis/StackSet.hs b/plug/src/Montis/StackSet.hs
deleted file mode 100644
index a147eb8..0000000
--- a/plug/src/Montis/StackSet.hs
+++ /dev/null
@@ -1,210 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans -Wno-missing-export-lists #-}
-
-module Montis.StackSet where
-
-import Control.Monad.Identity
-import Control.Monad.Writer (MonadWriter (tell), execWriter)
-import Data.Maybe (isJust, mapMaybe)
-import Data.Monoid (First (..))
-
--- | The root datastructure for holding the state of the windows.
-data StackSet s sd t l a = StackSet
-  { -- | The currently selected screen.
-    current :: Screen s sd t l a,
-    -- | Remaining visible screens.
-    visible :: [Screen s sd t l a],
-    -- | Workspaces that exist, but are not on a screen.
-    hidden :: [Workspace t l a]
-  }
-  deriving (Read, Show, Eq, Ord, Functor)
-
-class TraverseWorkspace f where
-  traverseWorkspaces ::
-    (Applicative m) => (Workspace t l a -> m (Workspace t' l' a')) -> f t l a -> m (f t' l' a')
-
-traverseWorkspaces_ :: (TraverseWorkspace f, Monad m) => (Workspace t l a -> m ()) -> f t l a -> m ()
-traverseWorkspaces_ f = void . traverseWorkspaces (\w -> f w >> pure w)
-
-foldMapWorkspaces ::
-  (Monoid m, TraverseWorkspace f) => (Workspace t l a -> m) -> f t l a -> m
-foldMapWorkspaces fn = execWriter . traverseWorkspaces_ (tell . fn)
-
-mapWorkspaces ::
-  (TraverseWorkspace f) =>
-  (Workspace t l a -> Workspace t' l' a') ->
-  f t l a ->
-  f t' l' a'
-mapWorkspaces fn = runIdentity . traverseWorkspaces (pure . fn)
-
-instance TraverseWorkspace Workspace where
-  traverseWorkspaces f = f
-
-instance TraverseWorkspace (Screen s sd) where
-  traverseWorkspaces f scr = (\w' -> scr {workspace = w'}) <$> f (workspace scr)
-
-instance TraverseWorkspace (StackSet s sd) where
-  traverseWorkspaces f (StackSet cur vis hid) =
-    StackSet
-      <$> traverseWorkspaces f cur
-      <*> traverse (traverseWorkspaces f) vis
-      <*> traverse (traverseWorkspaces f) hid
-
-instance Traversable Stack where
-  traverse f (Stack u d) =
-    Stack <$> traverse f u <*> traverse f d
-
-instance (TraverseWorkspace f) => Foldable (f t l) where
-  foldMap fn =
-    execWriter
-      . traverseWorkspaces_ (\(Workspace _ _ s) -> tell (foldMap (fn . windowInSeat) s))
-
-instance (Functor (f t l), TraverseWorkspace f) => Traversable (f t l) where
-  sequenceA =
-    traverseWorkspaces $
-      \(Workspace t l sf) -> Workspace t l <$> traverse sequenceA sf
-
-class HasFocus f where
-  focused :: f a -> Maybe a
-
-data Rectangle = Rectangle Int Int Int Int
-  deriving (Read, Show, Eq, Ord)
-
-instance HasFocus (StackSet s sd t l) where
-  focused (StackSet c _ _) = focused c
-
-data Screen s sd t l a = Screen
-  { screenDetail :: sd,
-    screenId :: s,
-    workspace :: Workspace t l a
-  }
-  deriving (Read, Show, Eq, Ord, Functor)
-
-instance HasFocus (Screen s sd t l) where
-  focused (Screen _ _ w) = focused w
-
--- | Defines where a window should appear.
-data WindowSeat a = Floating Rectangle a | Tiled a
-  deriving (Read, Show, Eq, Ord, Functor, Foldable)
-
-windowInSeat :: WindowSeat a -> a
-windowInSeat (Floating _ a) = a
-windowInSeat (Tiled a) = a
-
-instance Traversable WindowSeat where
-  sequenceA (Floating r fa) = Floating r <$> fa
-  sequenceA (Tiled fa) = Tiled <$> fa
-
-instance HasFocus WindowSeat where
-  focused (Floating _ a) = Just a
-  focused (Tiled a) = Just a
-
-data Workspace t l a = Workspace
-  { tag :: t,
-    layout :: l,
-    stack :: Stack (WindowSeat a)
-  }
-  deriving (Read, Show, Eq, Ord, Functor)
-
-instance HasFocus (Workspace t l) where
-  focused (Workspace _ _ s) = windowInSeat <$> focused s
-
-data Stack a = Stack
-  { -- | The elements above the focused one.
-    up :: ![a],
-    -- | The elements below the focused one including the focused one itself.
-    down :: ![a]
-  }
-  deriving (Read, Show, Eq, Ord, Functor, Foldable)
-
-instance HasFocus Stack where
-  focused (Stack _ (a : _)) = Just a
-  focused _ = Nothing
-
--- | Change the tag in a structure.
-mapTag :: (TraverseWorkspace f) => (t -> t') -> f t l a -> f t' l a
-mapTag fn = mapWorkspaces (\w -> w {tag = fn (tag w)})
-
--- | Change the layout in a structure.
-mapLayout :: (TraverseWorkspace f) => (l -> l') -> f t l a -> f t l' a
-mapLayout fn = mapWorkspaces (\w -> w {layout = fn (layout w)})
-
--- | Return all the tags in a structure.
-tags :: (TraverseWorkspace f) => f t l a -> [t]
-tags = foldMapWorkspaces ((: []) . tag)
-
--- | Insert a new window into the StackSet. The optional rectangle indicates if
--- the window should be floating or tiled.
---
--- The window is inserted just above the the currently focused window and is
--- given focus.
-insert :: a -> Maybe Rectangle -> StackSet s sd t l a -> StackSet s sd t l a
-insert win rect =
-  runIdentity
-    . onCurrentStack
-      ( \(Stack u d) ->
-          return $
-            (\w -> Stack u (w : d)) $
-              maybe (Tiled win) (`Floating` win) rect
-      )
-
--- | Find the tag associated with a window.
-findTag :: (TraverseWorkspace f, Eq a) => a -> f t l a -> Maybe t
-findTag a =
-  getFirst
-    . foldMapWorkspaces
-      ( \ws ->
-          foldMap
-            ( \a' ->
-                First $ if a' == a then Just (tag ws) else Nothing
-            )
-            ws
-      )
-
--- | Return true if the window exist in a structure
-elem :: (TraverseWorkspace f, Eq a) => a -> f t l a -> Bool
-elem a = isJust . findTag a
-
--- | Convenience function for inserting a window in stack set tiled.
-insertTiled :: a -> StackSet s sd t l a -> StackSet s sd t l a
-insertTiled win = insert win Nothing
-
-integrate :: Stack a -> [a]
-integrate (Stack u d) = u ++ d
-
-differentiate :: [a] -> Stack a
-differentiate = Stack []
-
-applyStack ::
-  (Monad m) =>
-  (Stack (WindowSeat a) -> m (Stack (WindowSeat a))) ->
-  Workspace t l a ->
-  m (Workspace t l a)
-applyStack fn (Workspace t l s) = Workspace t l <$> fn s
-
--- | Apply a function to the currently focused stack.
-onCurrentStack ::
-  (Monad m) =>
-  (Stack (WindowSeat a) -> m (Stack (WindowSeat a))) ->
-  StackSet s sd t l a ->
-  m (StackSet s sd t l a)
-onCurrentStack fn (StackSet cur vis hid) =
-  StackSet <$> cur' cur <*> pure vis <*> pure hid
-  where
-    cur' (Screen s sd ws) = Screen s sd <$> ws' ws
-    ws' (Workspace t l s) = Workspace t l <$> fn s
-
-catMaybes :: StackSet s sd t l (Maybe a) -> StackSet s sd t l a
-catMaybes (StackSet cur hidden visible) =
-  StackSet (catMaybesS cur) (map catMaybesS hidden) (map catMaybesW visible)
-  where
-    catMaybesS (Screen a b ws) = Screen a b $ catMaybesW ws
-    catMaybesW (Workspace a b st) = Workspace a b $ catMaybesSt st
-    catMaybesSt (Stack up down) =
-      Stack (mapMaybe sequenceA up) (mapMaybe sequenceA down)
-
-filter :: (a -> Bool) -> StackSet s sd t l a -> StackSet s sd t l a
-filter ffn =
-  Montis.StackSet.catMaybes . fmap (\a -> if ffn a then Just a else Nothing)
-
-delete :: (Eq a) => a -> StackSet s sd t l a -> StackSet s sd t l a
-delete win = Montis.StackSet.filter (/= win)