[refactor] Wetterhorn -> Montis

1 files changed, 152 insertions, 0 deletions

diff --git a/plug/src/Montis/Core.hs b/plug/src/Montis/Core.hs
new file mode 100644
index 0000000..df024e2
--- /dev/null
+++ b/plug/src/Montis/Core.hs
@@ -0,0 +1,152 @@
+{-# HLINT ignore "Use camelCase" #-}
+
+module Montis.Core
+--   ( WState (..),
+--     WConfig (..),
+--     SurfaceState (..),
+--     W,
+--     getWConfig,
+--     getWState,
+--     runW,
+--     Montis,
+--     initMontis,
+--     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 Montis.Foreign.ForeignInterface (ForeignInterface)
+-- import Montis.Foreign.WlRoots
+-- import qualified Data.ByteString.Char8 as CH
+-- import qualified Data.Map as Map
+-- import qualified Montis.Foreign.ForeignInterface as ForeignInterface
+-- 
+-- data WContext = WContext
+--   { ctxForeignInterface :: ForeignInterface,
+--     ctxConfig :: WConfig
+--   }
+-- 
+-- -- This is the OpaqueState passed to the harness.
+-- type Montis = 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
+-- 
+-- initMontis :: WConfig -> IO Montis
+-- initMontis 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)