aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--plug/src/Montis/Constraints.hs1
-rw-r--r--plug/src/Montis/Core.hs47
-rw-r--r--plug/src/Montis/Core/ButtonEvent.hs18
-rw-r--r--plug/src/Montis/Core/Keys.hs19
-rw-r--r--plug/src/Montis/Core/W.hs6
-rw-r--r--plug/src/Montis/Dsl/Bind.hs5
-rw-r--r--plug/src/Montis/Foreign/Export.hs3
-rw-r--r--plug/src/Montis/Foreign/WlRoots.hs12
-rw-r--r--plug/src/Montis/Keys/MagicModifierKey.hs5
-rw-r--r--plug/src/Montis/Layout/Full.hs1
-rw-r--r--plug/src/Montis/StackSet.hs4
11 files changed, 66 insertions, 55 deletions
diff --git a/plug/src/Montis/Constraints.hs b/plug/src/Montis/Constraints.hs
index 8c7957f..242f1fb 100644
--- a/plug/src/Montis/Constraints.hs
+++ b/plug/src/Montis/Constraints.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
-- | Contains useful constraints and constraint combinators for type-level
-- metaprogramming.
module Montis.Constraints where
diff --git a/plug/src/Montis/Core.hs b/plug/src/Montis/Core.hs
index a5479dc..24d7f12 100644
--- a/plug/src/Montis/Core.hs
+++ b/plug/src/Montis/Core.hs
@@ -1,5 +1,7 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
-module Montis.Core
+
+module Montis.Core where
+
-- ( WState (..),
-- WConfig (..),
-- SurfaceState (..),
@@ -18,7 +20,6 @@ module Montis.Core
-- KeyEvent (..),
-- KeyState (..),
-- )
-where
-- import Control.Arrow (first)
-- import Control.Exception
@@ -32,35 +33,35 @@ where
-- 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
@@ -79,13 +80,13 @@ where
-- ]
-- where
-- sym = fromIntegral . ord
---
+--
-- defaultConfig :: WConfig
-- defaultConfig =
-- WConfig
-- { keybindingHandler = \keyEvent -> do
-- seatPtr <- (wio . ForeignInterface.getSeat . ctxForeignInterface) =<< getWContext
---
+--
-- maybe
-- ( wio $ do
-- wlrSeatSetKeyboard seatPtr (device keyEvent)
@@ -97,7 +98,7 @@ where
-- KeyReleased -> 0
-- _ -> 1
-- )
---
+--
-- return True
-- )
-- (fmap (const True))
@@ -106,7 +107,7 @@ where
-- defaultBindings,
-- surfaceHandler = \state surface -> wio (printf "Surface %s is %s\n" (show surface) (show state))
-- }
---
+--
-- readWState :: ByteString -> IO WState
-- readWState bs =
-- catch
@@ -114,38 +115,38 @@ where
-- ( \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/plug/src/Montis/Core/ButtonEvent.hs b/plug/src/Montis/Core/ButtonEvent.hs
index a8b336e..3a79922 100644
--- a/plug/src/Montis/Core/ButtonEvent.hs
+++ b/plug/src/Montis/Core/ButtonEvent.hs
@@ -1,16 +1,18 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
module Montis.Core.ButtonEvent where
-import Montis.Foreign.WlRoots
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)
+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/Keys.hs b/plug/src/Montis/Core/Keys.hs
index b3faadd..c9291e4 100644
--- a/plug/src/Montis/Core/Keys.hs
+++ b/plug/src/Montis/Core/Keys.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
module Montis.Core.Keys where
import Control.Monad (forever, void, when)
@@ -9,9 +10,9 @@ 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 qualified Montis.Core.ButtonEvent as ButtonEvent
import Montis.Core.W
import Montis.Foreign.WlRoots (wlrSeatKeyboardNotifyKey, wlrSeatSetKeyboard)
@@ -131,11 +132,11 @@ 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)
-
+ 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}}
@@ -148,10 +149,8 @@ nextButtonOrKeyPress = do
Left bev -> forwardButtonEvent bev >> nextButtonOrKeyPress
Right kev | KeyEvent.state kev == KeyEvent.KeyPressed -> return ev
Right kev -> forwardEvent kev >> nextButtonOrKeyPress
-
- where
- forwardButtonEvent _ = return ()
-
+ where
+ forwardButtonEvent _ = return ()
-- | Returns the next KeyPressed event. This is likely what 90% of use cases
-- want rather than nextKeyEvent.
diff --git a/plug/src/Montis/Core/W.hs b/plug/src/Montis/Core/W.hs
index b2046ff..9235b2f 100644
--- a/plug/src/Montis/Core/W.hs
+++ b/plug/src/Montis/Core/W.hs
@@ -19,9 +19,6 @@ 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 Montis.Core.ButtonEvent (ButtonEvent)
import Montis.Core.KeyEvent
import Montis.Core.SurfaceEvent
@@ -30,6 +27,9 @@ import qualified Montis.Foreign.ForeignInterface as ForeignInterface
import Montis.Foreign.WlRoots (Surface, WlrSeat)
import Montis.StackSet hiding (layout)
import qualified Montis.StackSet as StackSet
+import Text.Printf (printf)
+import Text.Read hiding (lift)
+import Type.Reflection (someTypeRep, someTypeRepTyCon)
data RationalRect = RationalRect Rational Rational Rational Rational
diff --git a/plug/src/Montis/Dsl/Bind.hs b/plug/src/Montis/Dsl/Bind.hs
index ddba481..8d4e173 100644
--- a/plug/src/Montis/Dsl/Bind.hs
+++ b/plug/src/Montis/Dsl/Bind.hs
@@ -1,4 +1,5 @@
{-# 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
@@ -18,9 +19,9 @@ where
import Control.Monad
import Data.Bits
import Data.Word
-import Montis.Core.ButtonEvent (ButtonEvent(..))
+import Montis.Core.ButtonEvent (ButtonEvent (..))
import qualified Montis.Core.ButtonEvent as ButtonEvent
-import Montis.Core.KeyEvent (KeyEvent(..))
+import Montis.Core.KeyEvent (KeyEvent (..))
import qualified Montis.Core.KeyEvent as KeyEvent
import Montis.Core.W
import Montis.Dsl.Buttons as X
diff --git a/plug/src/Montis/Foreign/Export.hs b/plug/src/Montis/Foreign/Export.hs
index f6be82f..2bef0e9 100644
--- a/plug/src/Montis/Foreign/Export.hs
+++ b/plug/src/Montis/Foreign/Export.hs
@@ -1,4 +1,5 @@
{-# 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
@@ -22,7 +23,7 @@ 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 (W, Montis)
+import Montis.Core.W (Montis, W)
import qualified Montis.Core.W as W
import Montis.Foreign.ForeignInterface
import Montis.Foreign.WlRoots
diff --git a/plug/src/Montis/Foreign/WlRoots.hs b/plug/src/Montis/Foreign/WlRoots.hs
index a8b25d2..c4adaf8 100644
--- a/plug/src/Montis/Foreign/WlRoots.hs
+++ b/plug/src/Montis/Foreign/WlRoots.hs
@@ -1,7 +1,8 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
module Montis.Foreign.WlRoots where
-import Foreign (IntPtr, Ptr, Word32, intPtrToPtr, ptrToIntPtr, nullPtr)
+import Foreign (IntPtr, Ptr, Word32, intPtrToPtr, nullPtr, ptrToIntPtr)
import Text.Read
data WlrKeyboard
@@ -54,13 +55,16 @@ guardNull :: Ptr a -> Maybe (Ptr a)
guardNull p | p == nullPtr = Nothing
guardNull p = Just p
-foreign import ccall "wlr_seat_set_keyboard" wlrSeatSetKeyboard ::
+foreign import ccall "wlr_seat_set_keyboard"
+ wlrSeatSetKeyboard ::
Ptr WlrSeat -> Ptr WlrInputDevice -> IO ()
-foreign import ccall "wlr_seat_get_keyboard" wlrSeatGetKeyboard ::
+foreign import ccall "wlr_seat_get_keyboard"
+ wlrSeatGetKeyboard ::
Ptr WlrSeat -> IO (Ptr WlrKeyboard)
-foreign import ccall "wlr_keyboard_get_modifiers" wlrKeyboardGetModifiers ::
+foreign import ccall "wlr_keyboard_get_modifiers"
+ wlrKeyboardGetModifiers ::
Ptr WlrKeyboard -> IO Word32
foreign import ccall "wlr_seat_keyboard_notify_key"
diff --git a/plug/src/Montis/Keys/MagicModifierKey.hs b/plug/src/Montis/Keys/MagicModifierKey.hs
index e1a70d5..f9b87eb 100644
--- a/plug/src/Montis/Keys/MagicModifierKey.hs
+++ b/plug/src/Montis/Keys/MagicModifierKey.hs
@@ -1,14 +1,15 @@
{-# 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
-import Control.Monad.RWS (MonadTrans(lift))
-import Control.Monad.Trans.Maybe (MaybeT(..))
data MagicModifierProxy (keycode :: Natural) inputproxy
deriving (Typeable)
diff --git a/plug/src/Montis/Layout/Full.hs b/plug/src/Montis/Layout/Full.hs
index 7715526..816ddc2 100644
--- a/plug/src/Montis/Layout/Full.hs
+++ b/plug/src/Montis/Layout/Full.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
module Montis.Layout.Full where
import Data.Data (Typeable)
diff --git a/plug/src/Montis/StackSet.hs b/plug/src/Montis/StackSet.hs
index 4101a2f..a147eb8 100644
--- a/plug/src/Montis/StackSet.hs
+++ b/plug/src/Montis/StackSet.hs
@@ -2,10 +2,10 @@
module Montis.StackSet where
-import Data.Monoid (First(..))
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
@@ -207,4 +207,4 @@ 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)
+delete win = Montis.StackSet.filter (/= win)
generated by cgit (git 2.34.1) at 2026-01-09 02:43:14 +0000