Have Meson orchestrate the whole build rather than stack.

As a part of this, I changed the file layout to:

rt/ - the Montis runtime
plug/ - the Montis plugin
wlroots/ - wlroots

22 files changed, 0 insertions, 2504 deletions

diff --git a/src/Config.hs b/src/Config.hs
deleted file mode 100644
index e76e6ea..0000000
--- a/src/Config.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-module Config (config) where
-
-import Control.Monad (unless)
-import Data.Bits
-import Data.Data (Proxy (Proxy))
-import Wetterhorn.Core.ButtonEvent as ButtonEvent
-import Wetterhorn.Core.KeyEvent as KeyEvent
-import Wetterhorn.Core.W
-import Wetterhorn.Dsl.Bind
-import Wetterhorn.Dsl.Input
-import Wetterhorn.Keys.Macros
-import Wetterhorn.Keys.MagicModifierKey
-import Wetterhorn.Layout.Full
-
-config :: Config WindowLayout
-config =
-  defaultConfig
-    { hooks =
-        defaultHooks
-          { surfaceHook = do
-              handleSurface
-          },
-      layout = WindowLayout Full,
-      resetHook = do
-        useInputHandler $
-          withProxies inputProxies $ do
-            ev <- nextInputEvent
-
-            bind ev (released btnLeft) $
-              run $
-                wio $
-                  putStrLn "Left Button Released!!"
-
-            unless (isPressEvent ev) $ do
-              forwardEvent ev
-              continue
-
-            bind ev (Shift .+ Mod1 .+ 'R') $ run requestHotReload
-
-            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)}
-      _ -> return ie
diff --git a/src/Lib.hs b/src/Lib.hs
deleted file mode 100644
index d36ff27..0000000
--- a/src/Lib.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Lib
-    ( someFunc
-    ) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
diff --git a/src/Wetterhorn/Constraints.hs b/src/Wetterhorn/Constraints.hs
deleted file mode 100644
index 129fd6c..0000000
--- a/src/Wetterhorn/Constraints.hs
+++ /dev/null
@@ -1,13 +0,0 @@
--- | Contains useful constraints and constraint combinators for type-level
--- metaprogramming.
-module Wetterhorn.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/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
deleted file mode 100644
index d853191..0000000
--- a/src/Wetterhorn/Core.hs
+++ /dev/null
@@ -1,152 +0,0 @@
-{-# HLINT ignore "Use camelCase" #-}
-
-module Wetterhorn.Core
---   ( WState (..),
---     WConfig (..),
---     SurfaceState (..),
---     W,
---     getWConfig,
---     getWState,
---     runW,
---     Wetterhorn,
---     initWetterhorn,
---     wio,
---     incrementState,
---     readWState,
---     defaultConfig,
---     requestHotReload,
---     ctxConfig,
---     KeyEvent (..),
---     KeyState (..),
---   )
-where
-
--- import Control.Arrow (first)
--- import Control.Exception
--- import Data.ByteString (ByteString)
--- import Data.Char (ord)
--- import Data.Map (Map)
--- import Foreign (Ptr, StablePtr, Word32, newStablePtr)
--- import Text.Printf
--- import Wetterhorn.Foreign.ForeignInterface (ForeignInterface)
--- import Wetterhorn.Foreign.WlRoots
--- import qualified Data.ByteString.Char8 as CH
--- import qualified Data.Map as Map
--- import qualified Wetterhorn.Foreign.ForeignInterface as ForeignInterface
--- 
--- data WContext = WContext
---   { ctxForeignInterface :: ForeignInterface,
---     ctxConfig :: WConfig
---   }
--- 
--- -- This is the OpaqueState passed to the harness.
--- type Wetterhorn = StablePtr (WContext, WState)
--- 
--- requestHotReload :: W ()
--- requestHotReload = do
---   fi <- ctxForeignInterface <$> getWContext
---   wio $ ForeignInterface.requestHotReload fi
--- 
--- requestLog :: String -> W ()
--- requestLog str = do
---   fi <- ctxForeignInterface <$> getWContext
---   wio $ ForeignInterface.requestLog fi str
--- 
--- requestExit :: Int -> W ()
--- requestExit ec = do
---   fi <- ctxForeignInterface <$> getWContext
---   wio $ ForeignInterface.requestExit fi ec
--- 
--- initWetterhorn :: WConfig -> IO Wetterhorn
--- initWetterhorn conf = do
---   foreignInterface <- ForeignInterface.getForeignInterface
---   newStablePtr (WContext foreignInterface conf, WState "this is a string" 0)
--- 
--- defaultBindings :: Map (KeyState, Word32, Word32) (W ())
--- defaultBindings =
---   Map.fromList
---     [ ((KeyPressed, 0x9, sym 'Q'), requestHotReload),
---       ((KeyPressed, 0x8, sym 'r'), wio $ ForeignInterface.doShellExec "wofi --show run"),
---       ((KeyPressed, 0x8, sym 'l'), requestLog "This is a log statement!\n"),
---       ((KeyPressed, 0x8, sym 't'), wio $ ForeignInterface.doShellExec "alacritty"),
---       ((KeyPressed, 0x9, sym 'T'), wio $ ForeignInterface.doShellExec "gnome-terminal"),
---       ((KeyPressed, 0x8, sym 'c'), wio $ ForeignInterface.doShellExec "pavucontrol"),
---       ( (KeyPressed, 0x8, sym 'p'),
---         wio $ do
---           putStrLn "Maps:"
---           putStrLn =<< readFile "/proc/self/maps"
---       ),
---       ((KeyPressed, 0x8, sym 'q'), requestExit 0)
---     ]
---   where
---     sym = fromIntegral . ord
--- 
--- defaultConfig :: WConfig
--- defaultConfig =
---   WConfig
---     { keybindingHandler = \keyEvent -> do
---         seatPtr <- (wio . ForeignInterface.getSeat . ctxForeignInterface) =<< getWContext
--- 
---         maybe
---           ( wio $ do
---               wlrSeatSetKeyboard seatPtr (device keyEvent)
---               wlrSeatKeyboardNotifyKey
---                 seatPtr
---                 (timeMs keyEvent)
---                 (keycode keyEvent)
---                 ( case state keyEvent of
---                     KeyReleased -> 0
---                     _ -> 1
---                 )
--- 
---               return True
---           )
---           (fmap (const True))
---           $ Map.lookup
---             (state keyEvent, modifiers keyEvent, keysym keyEvent)
---             defaultBindings,
---       surfaceHandler = \state surface -> wio (printf "Surface %s is %s\n" (show surface) (show state))
---     }
--- 
--- readWState :: ByteString -> IO WState
--- readWState bs =
---   catch
---     (return $ read (CH.unpack bs))
---     ( \e ->
---         let _ = (e :: SomeException) in return (WState "" 0)
---     )
--- 
--- newtype W a = W ((WContext, WState) -> IO (a, WState))
--- 
--- instance Functor W where
---   fmap mfn (W fn) = W $ fmap (first mfn) <$> fn
--- 
--- instance Applicative W where
---   pure a = W $ \(_, s) -> return (a, s)
---   mfn <*> ma = do
---     fn <- mfn
---     fn <$> ma
--- 
--- instance Monad W where
---   (W fntoa) >>= fnmb = W $ \(config, state) -> do
---     (a, state') <- fntoa (config, state)
---     let W fntob = fnmb a
---     fntob (config, state')
--- 
--- getWContext :: W WContext
--- getWContext = W pure
--- 
--- getWConfig :: W WConfig
--- getWConfig = ctxConfig <$> getWContext
--- 
--- getWState :: W WState
--- getWState = W $ \(_, s) -> pure (s, s)
--- 
--- runW :: W a -> (WContext, WState) -> IO (a, WState)
--- runW (W fn) = fn
--- 
--- incrementState :: W Int
--- incrementState = W $ \(_, WState s i) -> return (i, WState s (i + 1))
--- 
--- wio :: IO a -> W a
--- wio fn = W $ \(_, b) -> fn >>= \a -> return (a, b)
diff --git a/src/Wetterhorn/Core/ButtonEvent.hs b/src/Wetterhorn/Core/ButtonEvent.hs
deleted file mode 100644
index cc3d905..0000000
--- a/src/Wetterhorn/Core/ButtonEvent.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Wetterhorn.Core.ButtonEvent where
-
-import Wetterhorn.Foreign.WlRoots
-import Data.Word (Word32)
-import Foreign (Ptr)
-
-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/src/Wetterhorn/Core/KeyEvent.hs b/src/Wetterhorn/Core/KeyEvent.hs
deleted file mode 100644
index 77d273f..0000000
--- a/src/Wetterhorn/Core/KeyEvent.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Wetterhorn.Core.KeyEvent
-  ( KeyEvent (..),
-    KeyState (..),
-  )
-where
-
-import Data.Word (Word32)
-import Foreign (Ptr)
-import Wetterhorn.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/src/Wetterhorn/Core/Keys.hs b/src/Wetterhorn/Core/Keys.hs
deleted file mode 100644
index 54d7125..0000000
--- a/src/Wetterhorn/Core/Keys.hs
+++ /dev/null
@@ -1,239 +0,0 @@
-module Wetterhorn.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 Wetterhorn.Core.ButtonEvent (ButtonEvent)
-import Wetterhorn.Core.KeyEvent
-import qualified Wetterhorn.Core.KeyEvent as KeyEvent
-import qualified Wetterhorn.Core.ButtonEvent as ButtonEvent
-import Wetterhorn.Core.W
-import Wetterhorn.Foreign.WlRoots (wlrSeatKeyboardNotifyKey, wlrSeatSetKeyboard)
-
--- | 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/src/Wetterhorn/Core/SurfaceEvent.hs b/src/Wetterhorn/Core/SurfaceEvent.hs
deleted file mode 100644
index 3e7eaf3..0000000
--- a/src/Wetterhorn/Core/SurfaceEvent.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Wetterhorn.Core.SurfaceEvent
-  ( SurfaceEvent (..),
-    SurfaceState (..),
-  )
-where
-
-import Wetterhorn.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/src/Wetterhorn/Core/W.hs b/src/Wetterhorn/Core/W.hs
deleted file mode 100644
index 862f9fa..0000000
--- a/src/Wetterhorn/Core/W.hs
+++ /dev/null
@@ -1,379 +0,0 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-
-module Wetterhorn.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.Class
-import Control.Monad.Trans.Maybe
-import Data.Data (TypeRep, Typeable, cast, tyConModule, tyConName, tyConPackage)
-import Data.Default.Class (Default, def)
-import Data.Kind (Constraint, Type)
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Proxy
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Foreign (Ptr, StablePtr, intPtrToPtr, ptrToIntPtr)
-import Text.Printf (printf)
-import Text.Read hiding (lift)
-import Type.Reflection (someTypeRep, someTypeRepTyCon)
-import Wetterhorn.Core.ButtonEvent (ButtonEvent)
-import Wetterhorn.Core.KeyEvent
-import Wetterhorn.Core.SurfaceEvent
-import Wetterhorn.Foreign.ForeignInterface (ForeignInterface)
-import qualified Wetterhorn.Foreign.ForeignInterface as ForeignInterface
-import Wetterhorn.Foreign.WlRoots (Surface, WlrSeat)
-import Wetterhorn.StackSet hiding (layout)
-import qualified Wetterhorn.StackSet as StackSet
-
-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 Wetterhorn = StablePtr (Context, State)
-
-data Context = Context
-  { ctxForeignInterface :: ForeignInterface,
-    ctxConfig :: Config WindowLayout
-  }
-
-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 Wetterhorn 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 t