reflex-vty 0.5.0.0 → 0.5.1.0
raw patch · 6 files changed
+69/−21 lines, 6 filesdep +exceptionsdep ~reflex
Dependencies added: exceptions
Dependency ranges changed: reflex
Files
- ChangeLog.md +5/−0
- reflex-vty.cabal +3/−2
- src/Control/Monad/NodeId.hs +4/−0
- src/Reflex/Vty/Host.hs +16/−12
- src/Reflex/Vty/Widget.hs +34/−7
- src/Reflex/Vty/Widget/Layout.hs +7/−0
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for reflex-vty +## 0.5.1.0++* Change `inputInFocusedRegion` to filter mouse scroll wheel input based on if the region under than the mouse rather than using mouse drag tracking+* Add MonadCatch, MonadThrow, and MonadMask instances (relies on reflex-0.9.2.0 or greater)+ ## 0.5.0.0 * *Breaking change*:
reflex-vty.cabal view
@@ -1,5 +1,5 @@ name: reflex-vty-version: 0.5.0.0+version: 0.5.1.0 synopsis: Reflex FRP host and widgets for VTY applications description: Build terminal applications using functional reactive programming (FRP) with Reflex FRP (<https://reflex-frp.org>).@@ -48,6 +48,7 @@ stm >= 2.4 && < 2.6, data-default >= 0.7.1 && < 0.8, dependent-map >= 0.4 && < 0.5,+ exceptions >= 0.10 && < 0.11, text >= 1.2.3 && < 2.1, dependent-sum >= 0.7 && < 0.8, exception-transformers >= 0.4.0 && < 0.5,@@ -55,7 +56,7 @@ ordered-containers >= 0.2.2 && < 0.3, primitive >= 0.6.3 && < 0.8, ref-tf >= 0.4.0 && < 0.6,- reflex >= 0.8 && < 1,+ reflex >= 0.9.2 && < 1, time >= 1.8.0 && < 1.13, vty >= 5.28 && < 5.39 hs-source-dirs: src
src/Control/Monad/NodeId.hs view
@@ -10,6 +10,7 @@ , runNodeIdT ) where +import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask) import Control.Monad.Morph import Control.Monad.Fix import Control.Monad.Reader@@ -49,6 +50,9 @@ , PerformEvent t , PostBuild t , TriggerEvent t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance MonadNodeId m => MonadNodeId (ReaderT x m)
src/Reflex/Vty/Host.hs view
@@ -16,6 +16,7 @@ import Control.Concurrent.Chan (newChan, readChan, writeChan) import Control.Exception (onException) import Control.Monad (forM, forM_, forever)+import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask) import Control.Monad.Fix (MonadFix, fix) import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Monad.Identity (Identity(..))@@ -48,23 +49,26 @@ -- on why each of these are necessary and how they can be fulfilled. type MonadVtyApp t m = ( Reflex t- , MonadHold t m- , MonadHold t (Performable m)- , MonadFix m+ , Adjustable t m+ , MonadCatch m , MonadFix (Performable m)- , PrimMonad (HostFrame t)- , ReflexHost t+ , MonadFix m+ , MonadHold t (Performable m)+ , MonadHold t m , MonadIO (HostFrame t)- , Ref m ~ IORef- , Ref (HostFrame t) ~ IORef+ , MonadIO (Performable m)+ , MonadIO m+ , MonadMask m , MonadRef (HostFrame t)+ , MonadThrow m , NotReady t m- , TriggerEvent t m- , PostBuild t m , PerformEvent t m- , MonadIO m- , MonadIO (Performable m)- , Adjustable t m+ , PostBuild t m+ , PrimMonad (HostFrame t)+ , Ref (HostFrame t) ~ IORef+ , Ref m ~ IORef+ , ReflexHost t+ , TriggerEvent t m ) -- | A functional reactive vty application.
src/Reflex/Vty/Widget.hs view
@@ -7,6 +7,7 @@ module Reflex.Vty.Widget where import Control.Applicative (liftA2)+import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Morph (MFunctor(..))@@ -109,6 +110,9 @@ , MonadFix , MonadIO , MonadRef+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance (Adjustable t m, MonadHold t m, Reflex t) => Adjustable t (Input t m) where@@ -208,16 +212,18 @@ -- * 'WaitingForInput' means state will be set on next 'EvMouseDown' event data MouseTrackingState = Tracking V.Button | NotTracking | WaitingForInput deriving (Show, Eq) --- | Filter mouse input outside the current display region and--- all input if the region is not focused--- mouse drag sequences that start OFF the region are NOT reported--- mouse drag sequences that start ON the region and drag off ARE reported+-- | Filter mouse input outside the current display region+-- keyboard input is reported only if the region is focused+-- scroll wheel input is reported only if the region is focused+-- mouse input is reported if the mouse is in the region+-- EXCEPT mouse drag sequences that start OFF the region are NOT reported+-- AND mouse drag sequences that start ON the region and drag off ARE reported inputInFocusedRegion :: forall t m. (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasFocusReader t m, HasInput t m) => m (Event t VtyEvent) inputInFocusedRegion = do inp <- input- reg <- current <$> askRegion+ regBeh <- current <$> askRegion foc <- current <$> focus let trackMouse ::@@ -228,11 +234,20 @@ -- sampling (as oppose to using attachPromptlyDyn) is necessary here as the focus may change from the event produced here focused <- sample foc -- strictly speaking the same could also happen here too- reg'@(Region l t _ _) <- sample reg+ reg@(Region l t _ _) <- sample regBeh return $ case e of++ -- filter keyboard input if region is not focused V.EvKey _ _ | not focused -> Nothing++ -- filter scroll wheel input based on mouse position+ ev@(V.EvMouseDown x y btn m) | btn == V.BScrollUp || btn == V.BScrollDown -> case tracking of+ trck@(Tracking _) -> Just (trck, Nothing)+ _ -> Just (WaitingForInput, if withinRegion reg x y then Just (V.EvMouseDown (x - l) (y - t) btn m) else Nothing)++ -- only do tracking for l/m/r mouse buttons V.EvMouseDown x y btn m ->- if tracking == Tracking btn || (tracking == WaitingForInput && withinRegion reg' x y)+ if tracking == Tracking btn || (tracking == WaitingForInput && withinRegion reg x y) then Just (Tracking btn, Just $ V.EvMouseDown (x - l) (y - t) btn m) else Just (NotTracking, Nothing) V.EvMouseUp x y mbtn -> case mbtn of@@ -325,6 +340,9 @@ , MonadIO , MonadRef , MonadSample t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance (Monad m, Reflex t) => HasDisplayRegion t (DisplayRegion t m) where@@ -390,6 +408,9 @@ , MonadIO , MonadRef , MonadSample t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance (Monad m, Reflex t) => HasFocusReader t (FocusReader t m) where@@ -455,6 +476,9 @@ , PerformEvent t , PostBuild t , TriggerEvent t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance MonadTrans (ImageWriter t) where@@ -525,6 +549,9 @@ , MonadIO , MonadRef , MonadSample t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance (Monad m, Reflex t) => HasTheme t (ThemeReader t m) where
src/Reflex/Vty/Widget/Layout.hs view
@@ -7,6 +7,7 @@ module Reflex.Vty.Widget.Layout where import Control.Applicative (liftA2)+import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask) import Control.Monad.Morph import Control.Monad.NodeId (MonadNodeId(..), NodeId) import Control.Monad.Fix@@ -111,6 +112,9 @@ , PostBuild t , MonadNodeId , MonadIO+ , MonadCatch+ , MonadThrow+ , MonadMask ) @@ -395,6 +399,9 @@ , PerformEvent t , PostBuild t , TriggerEvent t+ , MonadCatch+ , MonadThrow+ , MonadMask ) instance MonadTrans (Layout t) where