reflex-vty 0.1.3.0 → 0.1.4.0
raw patch · 8 files changed
+99/−44 lines, 8 filesdep ~basedep ~primitivedep ~reflexnew-uploader
Dependency ranges changed: base, primitive, reflex, time, vty
Files
- ChangeLog.md +19/−14
- README.md +1/−2
- reflex-vty.cabal +7/−7
- src-bin/example.hs +2/−1
- src/Reflex/Class/Switchable.hs +2/−3
- src/Reflex/Vty/Host.hs +4/−5
- src/Reflex/Vty/Widget.hs +63/−12
- src/Reflex/Vty/Widget/Layout.hs +1/−0
ChangeLog.md view
@@ -1,28 +1,33 @@ # Revision history for reflex-vty +## 0.1.4.0+* ([#15](https://github.com/reflex-frp/reflex-vty/pull/15)) Add `PostBuild` instance for `Layout`.+* ([#17](https://github.com/reflex-frp/reflex-vty/pull/17)) Add `splitH` to implement horizontal functionality of `splitV`.+* ([#19](https://github.com/reflex-frp/reflex-vty/pull/19)) Add `boxTitle`: a box with a title.+* ([#19](https://github.com/reflex-frp/reflex-vty/pull/19)) Update the text editing example to use `boxTitle`.+* ([#21](https://github.com/reflex-frp/reflex-vty/pull/21)) Fix bug in `drag` that caused dragging with different mouse button to trigger the click event.+* ([#22](https://github.com/reflex-frp/reflex-vty/pull/22)) Add support for GHC 8.8.+ ## 0.1.3.0-* Add `mouseScroll` to capture scroll wheel events-* Add `scrollableText`: a text display widget that can be scrolled using the mouse or keyboard-* Add widget to the example executable that displays scrollable text+* Add `mouseScroll` to capture scroll wheel events.+* Add `scrollableText`: a text display widget that can be scrolled using the mouse or keyboard.+* Add widget to the example executable that displays scrollable text. ## 0.1.2.1-* Add `keyCombo` function (single-key-combination version of `keyCombos`)-* Use upstream `NotReady` instances instead of orphans defined in this package if reflex-0.6.3 is available+* Add `keyCombo` function (single-key-combination version of `keyCombos`).+* Use upstream `NotReady` instances instead of orphans defined in this package if reflex-0.6.3 is available. ## 0.1.2.0-* Allow TextZipper contents to be tranformed before being displayed-* Fix bug in `row` orientation-* Handle wrapping of lines containing fullwidth unicode characters in `textInput`+* Allow `TextZipper` contents to be transformed before being displayed.+* Fix bug in `row` orientation.+* Handle wrapping of lines containing full-width unicode characters in `textInput`. ## 0.1.1.1--* Bump minimum version of reflex+* Bump minimum version of reflex. ## 0.1.1.0--* Set version bounds in cabal file-* Add travis CI config+* Set version bounds in cabal file.+* Add travis CI config. ## 0.1.0.0- * Initial release
README.md view
@@ -33,10 +33,9 @@ From the reflex-vty project directory: ```bash+# nix-shell -p cabal-install binutils icu # for nix users cabal new-configure cabal new-build # to build the library and example cabal new-repl # to enter a repl for the library cabal new-repl example # to enter a repl for the example executable ```--
reflex-vty.cabal view
@@ -1,5 +1,5 @@ name: reflex-vty-version: 0.1.3.0+version: 0.1.4.0 synopsis: Reflex FRP host and widgets for vty applications description: Host and widget library for Reflex-based FRP applications@@ -18,7 +18,7 @@ ChangeLog.md extra-doc-files: doc/welcome.gif , doc/tasks.png-tested-with: GHC ==8.6.5 || ==8.4.4+tested-with: GHC ==8.8.3 || ==8.6.5 || ==8.4.4 library exposed-modules: Reflex.Vty@@ -32,7 +32,7 @@ , Reflex.Spider.Orphans , Control.Monad.NodeId build-depends:- base >= 4.10.0 && < 4.13,+ base >= 4.10.0 && < 4.14, bimap >= 0.3.3 && < 0.4, containers >= 0.5.0 && < 0.7, mtl >= 2.2.2 && < 2.3,@@ -44,11 +44,11 @@ text-icu >= 0.7 && < 0.8, dependent-sum >= 0.3 && < 0.7, exception-transformers >= 0.4.0 && < 0.5,- primitive >= 0.6.3 && < 0.7,+ primitive >= 0.6.3 && < 0.8, ref-tf >= 0.4.0 && < 0.5,- reflex >= 0.6.2 && < 0.7,- time >= 1.8.0 && < 1.9,- vty >= 5.21 && < 5.26+ reflex >= 0.6.2 && < 0.8,+ time >= 1.8.0 && < 1.10,+ vty >= 5.21 && < 5.29 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall
src-bin/example.hs view
@@ -97,7 +97,8 @@ { _textInputConfig_initialValue = "This box is a text input. The box below responds to mouse drag inputs. You can also drag the separator between the boxes to resize them." }- textBox = boxStatic roundedBoxStyle $ multilineTextInput cfg+ textBox = boxTitle (pure roundedBoxStyle) "Text Edit" $+ multilineTextInput cfg dragBox = boxStatic roundedBoxStyle dragTest in splitVDrag (hRule doubleBoxStyle) textBox dragBox return ()
src/Reflex/Class/Switchable.hs view
@@ -4,7 +4,6 @@ -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} module Reflex.Class.Switchable where @@ -26,5 +25,5 @@ instance (Reflex t, Switchable t a, Switchable t b) => Switchable t (a, b) where switching (a, b) e = (,)- <$> (switching a $ fmap fst e)- <*> (switching b $ fmap snd e)+ <$> switching a (fmap fst e)+ <*> switching b (fmap snd e)
src/Reflex/Vty/Host.hs view
@@ -28,8 +28,7 @@ import Control.Monad.Primitive (PrimMonad) import Control.Monad.Ref (MonadRef, Ref, readRef) import Data.Dependent.Sum (DSum ((:=>)))-import Data.IORef (IORef)-import Data.IORef (readIORef)+import Data.IORef (IORef, readIORef) import Data.Maybe (catMaybes) import Reflex@@ -76,7 +75,7 @@ type VtyApp t m = MonadVtyApp t m => DisplayRegion -- ^ The initial display size (updates to this come as events)- -> Event t (V.Event)+ -> Event t V.Event -- ^ Vty input events. -> m (VtyResult t) -- ^ The output of the 'VtyApp'. The application runs in a context that,@@ -115,7 +114,7 @@ -- processed. events <- liftIO newChan - displayRegion0 <- V.displayBounds $ V.outputIface vty+ displayRegion0 <- liftIO $ V.displayBounds $ V.outputIface vty -- Run the vty "guest" application, providing the appropriate context. The -- result is a 'VtyResult', and a 'FireCommand' that will be used to@@ -179,7 +178,7 @@ triggerInvocation = TriggerInvocation ne $ return () -- Write our input event's 'EventTrigger' with the newly created -- 'TriggerInvocation' value to the queue of events.- writeChan events $ [triggerRef :=> triggerInvocation]+ writeChan events [triggerRef :=> triggerInvocation] -- The main application loop. We wait for new events, fire those that -- have subscribers, and update the display. If we detect a shutdown
src/Reflex/Vty/Widget.hs view
@@ -43,7 +43,9 @@ , mouseScroll , pane , splitV+ , splitH , splitVDrag+ , boxTitle , box , boxStatic , RichTextConfig(..)@@ -69,8 +71,9 @@ import Control.Applicative (liftA2) import Control.Monad.Fix (MonadFix)-import Control.Monad.Reader-import Control.Monad.Trans (lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)+import Control.Monad.Trans (MonadTrans, lift) import Data.Default (Default(..)) import Data.Set (Set) import qualified Data.Set as Set@@ -141,7 +144,7 @@ instance MonadNodeId m => MonadNodeId (VtyWidget t m) where getNextNodeId = VtyWidget $ do- lift $ lift $ getNextNodeId+ lift $ lift getNextNodeId -- | Runs a 'VtyWidget' with a given context runVtyWidget@@ -338,13 +341,13 @@ f Nothing = \case V.EvMouseDown x y btn' mods | btn == btn' -> Just $ Drag (x,y) (x,y) btn' mods False- | otherwise -> Nothing+ | otherwise -> Nothing _ -> Nothing f (Just (Drag from _ _ mods end)) = \case V.EvMouseDown x y btn' mods'- | end -> Just $ Drag (x,y) (x,y) btn' mods' False- | btn == btn' -> Just $ Drag from (x,y) btn mods' False- | otherwise -> Nothing -- Ignore other buttons.+ | end && btn == btn' -> Just $ Drag (x,y) (x,y) btn' mods' False+ | btn == btn' -> Just $ Drag from (x,y) btn mods' False+ | otherwise -> Nothing -- Ignore other buttons. V.EvMouseUp x y (Just btn') | end -> Nothing | btn == btn' -> Just $ Drag from (x,y) btn mods True@@ -474,6 +477,35 @@ rb <- pane regB (snd <$> focD) wB return (ra,rb) +-- | A plain split of the available space into horizontally stacked panes.+-- No visual separator is built in here.+splitH :: (Reflex t, Monad m, MonadNodeId m)+ => Dynamic t (Int -> Int)+ -- ^ Function used to determine size of first pane based on available size+ -> Dynamic t (Bool, Bool)+ -- ^ How to focus the two sub-panes, given that we are focused.+ -> VtyWidget t m a+ -- ^ Widget for first pane+ -> VtyWidget t m b+ -- ^ Widget for second pane+ -> VtyWidget t m (a,b)+splitH sizeFunD focD wA wB = do+ dw <- displayWidth+ dh <- displayHeight+ let regA = DynRegion+ { _dynRegion_left = pure 0+ , _dynRegion_top = pure 0+ , _dynRegion_width = sizeFunD <*> dw+ , _dynRegion_height = dh+ }+ regB = DynRegion+ { _dynRegion_left = _dynRegion_width regA+ , _dynRegion_top = pure 0+ , _dynRegion_width = liftA2 (-) dw (_dynRegion_width regA)+ , _dynRegion_height = dh+ }+ liftA2 (,) (pane regA (fmap fst focD) wA) (pane regB (fmap snd focD) wB)+ -- | A split of the available space into two parts with a draggable separator. -- Starts with half the space allocated to each, and the first pane has focus. -- Clicking in a pane switches focus.@@ -491,7 +523,7 @@ rec splitterCheckpoint <- holdDyn splitter0 $ leftmost [fst <$> ffilter snd dragSplitter, resizeSplitter] splitterPos <- holdDyn splitter0 $ leftmost [fst <$> dragSplitter, resizeSplitter] splitterFrac <- holdDyn ((1::Double) / 2) $ ffor (attach (current dh) (fst <$> dragSplitter)) $ \(h, x) ->- fromIntegral x / (max 1 (fromIntegral h))+ fromIntegral x / max 1 (fromIntegral h) let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $ \(splitterY, Drag (_, fromY) (_, toY) _ _ end) -> if splitterY == fromY then Just (toY, end) else Nothing@@ -563,12 +595,13 @@ roundedBoxStyle :: BoxStyle roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│' --- | Draws a box in the provided style and a child widget inside of that box-box :: (Monad m, Reflex t, MonadNodeId m)+-- | Draws a titled box in the provided style and a child widget inside of that box+boxTitle :: (Monad m, Reflex t, MonadNodeId m) => Behavior t BoxStyle+ -> Text -> VtyWidget t m a -> VtyWidget t m a-box boxStyle child = do+boxTitle boxStyle title child = do dh <- displayHeight dw <- displayWidth let boxReg = DynRegion (pure 0) (pure 0) dw dh@@ -583,7 +616,8 @@ bottom = top + height - 1 sides = [ withinImage (Region (left + 1) top (width - 2) 1) $- V.charFill V.defAttr (_boxStyle_n style) (width - 2) 1+ V.text' V.defAttr $+ hPadText title (_boxStyle_n style) (width - 2) , withinImage (Region right (top + 1) 1 (height - 2)) $ V.charFill V.defAttr (_boxStyle_e style) 1 (height - 2) , withinImage (Region (left + 1) bottom (width - 2) 1) $@@ -602,6 +636,23 @@ V.char V.defAttr (_boxStyle_sw style) ] in sides ++ if width > 1 && height > 1 then corners else []+ hPadText :: T.Text -> Char -> Int -> T.Text+ hPadText t c l = if lt >= l+ then t+ else left <> t <> right+ where+ lt = T.length t+ delta = l - lt+ mkHalf n = T.replicate (n `div` 2) (T.singleton c)+ left = mkHalf $ delta + 1+ right = mkHalf delta++-- | A box without a title+box :: (Monad m, Reflex t, MonadNodeId m)+ => Behavior t BoxStyle+ -> VtyWidget t m a+ -> VtyWidget t m a+box boxStyle = boxTitle boxStyle mempty -- | A box whose style is static boxStatic
src/Reflex/Vty/Widget/Layout.hs view
@@ -78,6 +78,7 @@ , MonadReflexCreateTrigger t , HasDisplaySize t , MonadNodeId+ , PostBuild t ) instance MonadTrans (Layout t) where