1 files changed, 147 insertions, 171 deletions

diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
index d3515fc..d853191 100644
--- a/src/Wetterhorn/Core.hs
+++ b/src/Wetterhorn/Core.hs
@@ -1,176 +1,152 @@
 {-# HLINT ignore "Use camelCase" #-}
 
 module Wetterhorn.Core
-  ( WState (..),
-    WConfig (..),
-    SurfaceState (..),
-    W,
-    getWConfig,
-    getWState,
-    runW,
-    Wetterhorn,
-    initWetterhorn,
-    wio,
-    incrementState,
-    readWState,
-    defaultConfig,
-    requestHotReload,
-    ctxConfig,
-    KeyEvent (..),
-    KeyState (..),
-  )
+--   ( 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 Control.Monad (when)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as CH
-import Data.Char (chr, ord)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-import Foreign (Ptr, StablePtr, Word32, castForeignPtr, newStablePtr, ptrToIntPtr)
-import Numeric (showHex)
-import Text.Printf
-import Wetterhorn.Core.ForeignInterface (ForeignInterface)
-import qualified Wetterhorn.Core.ForeignInterface as ForeignInterface
-import Wetterhorn.WlRoots
-
-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)
-
-data WState = WState
-  { someString :: String,
-    integer :: Int
-  }
-  deriving (Show, Read)
-
-data SurfaceState = Map | Unmap | Destroy deriving (Eq, Ord, Show, Enum)
-
-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)
-
-data WConfig = WConfig
-  { keybindingHandler :: KeyEvent -> W Bool,
-    surfaceHandler :: SurfaceState -> Surface -> W ()
-  }
-
-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 '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)
+-- 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)