diff --git a/ChangeLog.md b/ChangeLog.md index 762f186..9356762 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,9 @@ # Revision history for reflex-vty -## Unreleased +## 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 diff --git a/nixpkgs/default.nix b/dep/nixpkgs/default.nix similarity index 100% rename from nixpkgs/default.nix rename to dep/nixpkgs/default.nix diff --git a/nixpkgs/github.json b/dep/nixpkgs/github.json similarity index 100% rename from nixpkgs/github.json rename to dep/nixpkgs/github.json diff --git a/nixpkgs/thunk.nix b/dep/nixpkgs/thunk.nix similarity index 100% rename from nixpkgs/thunk.nix rename to dep/nixpkgs/thunk.nix diff --git a/reflex-platform/default.nix b/dep/reflex-platform/default.nix similarity index 100% rename from reflex-platform/default.nix rename to dep/reflex-platform/default.nix diff --git a/reflex-platform/github.json b/dep/reflex-platform/github.json similarity index 100% rename from reflex-platform/github.json rename to dep/reflex-platform/github.json diff --git a/reflex-platform/thunk.nix b/dep/reflex-platform/thunk.nix similarity index 100% rename from reflex-platform/thunk.nix rename to dep/reflex-platform/thunk.nix diff --git a/dep/reflex/default.nix b/dep/reflex/default.nix new file mode 100644 index 0000000..2b4d4ab --- /dev/null +++ b/dep/reflex/default.nix @@ -0,0 +1,2 @@ +# DO NOT HAND-EDIT THIS FILE +import (import ./thunk.nix) \ No newline at end of file diff --git a/dep/reflex/github.json b/dep/reflex/github.json new file mode 100644 index 0000000..82e0461 --- /dev/null +++ b/dep/reflex/github.json @@ -0,0 +1,8 @@ +{ + "owner": "reflex-frp", + "repo": "reflex", + "branch": "release/0.9.2.0", + "private": false, + "rev": "b7d933a33a72949a700414bda7a23aa90105431a", + "sha256": "03h5n2jzxmic779d334ini7bgy4xmy59j9iyd5pdprkpqqa930nh" +} diff --git a/dep/reflex/thunk.nix b/dep/reflex/thunk.nix new file mode 100644 index 0000000..20f2d28 --- /dev/null +++ b/dep/reflex/thunk.nix @@ -0,0 +1,12 @@ +# DO NOT HAND-EDIT THIS FILE +let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: + if !fetchSubmodules && !private then builtins.fetchTarball { + url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; + } else (import (builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz"; + sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr"; +}) {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; + json = builtins.fromJSON (builtins.readFile ./github.json); +in fetch json \ No newline at end of file diff --git a/reflex-vty.cabal b/reflex-vty.cabal index 459c154..841cb9c 100644 --- a/reflex-vty.cabal +++ b/reflex-vty.cabal @@ -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 (). @@ -48,6 +48,7 @@ library 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 @@ library 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 diff --git a/release.nix b/release.nix index 0352923..48d8eef 100644 --- a/release.nix +++ b/release.nix @@ -1,7 +1,8 @@ -{ reflex-platform ? import ./reflex-platform +{ reflex-platform ? import ./dep/reflex-platform }: let - pkgs = (reflex-platform {}).nixpkgs; + rp = reflex-platform {}; + pkgs = rp.nixpkgs; supportedSystems = [ "x86_64-linux" "x86_64-darwin" ]; inherit (pkgs) lib; haskellLib = pkgs.haskell.lib; @@ -11,13 +12,14 @@ let ver = "5.38"; sha256 = "0kcd3ln9xmc62ka0i7habzvjjar8z63mlvl15rdhf8hqmda0b7r7"; } {}; + reflex = self.callCabal2nix "reflex" (rp.hackGet ./dep/reflex) {}; }; ghcs = lib.genAttrs supportedSystems (system: let rp = reflex-platform { inherit system; __useNewerCompiler = true; }; rpGhc = rp.ghc.override { overrides = commonOverrides; }; - nixGhc945 = (import ./nixpkgs { inherit system; }).haskell.packages.ghc945.override { + nixGhc945 = (import ./dep/nixpkgs { inherit system; }).haskell.packages.ghc945.override { overrides = self: super: commonOverrides self super // { hlint = self.callHackageDirect { pkg = "hlint"; @@ -33,26 +35,19 @@ let sha256 = "160zqqhjg48fr3a33gffd82qm3728c8hwf8sn37pbpv82fw71rzg"; } {}; - reflex = self.callHackageDirect { - pkg = "reflex"; - ver = "0.9.0.1"; - sha256 = "1yrcashxxclvlvv3cs5gv75rvlsg1gb0m36kssnk2zvhbh94240y"; - } {}; }; }; - nixGhc961 = (import ./nixpkgs { inherit system; }).haskell.packages.ghc961.override { + nixGhc961 = (import ./dep/nixpkgs { inherit system; }).haskell.packages.ghc961.override { overrides = self: super: { + + reflex = self.callCabal2nix "reflex" (rp.hackGet ./dep/reflex) {}; + patch = self.callHackageDirect { pkg = "patch"; ver = "0.0.8.2"; sha256 = "160zqqhjg48fr3a33gffd82qm3728c8hwf8sn37pbpv82fw71rzg"; } {}; - reflex = self.callHackageDirect { - pkg = "reflex"; - ver = "0.9.0.1"; - sha256 = "1yrcashxxclvlvv3cs5gv75rvlsg1gb0m36kssnk2zvhbh94240y"; - } {}; these-lens = self.callHackageDirect { pkg = "these-lens"; ver = "1.0.1.3"; diff --git a/shell.nix b/shell.nix index 9651049..6105664 100644 --- a/shell.nix +++ b/shell.nix @@ -2,7 +2,7 @@ # or nixpkgs (which provides ghc943) { compiler ? "ghc810" # or "ghc943" }: -let pkgs = (import ./reflex-platform { }).nixpkgs; +let pkgs = (import ./dep/reflex-platform { }).nixpkgs; in pkgs.mkShell { name = "shell-${compiler}"; diff --git a/src/Control/Monad/NodeId.hs b/src/Control/Monad/NodeId.hs index d5f6175..6c1a8db 100644 --- a/src/Control/Monad/NodeId.hs +++ b/src/Control/Monad/NodeId.hs @@ -10,6 +10,7 @@ module Control.Monad.NodeId , 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 @@ newtype NodeIdT m a = NodeIdT { unNodeIdT :: ReaderT (IORef NodeId) m a } , PerformEvent t , PostBuild t , TriggerEvent t + , MonadCatch + , MonadThrow + , MonadMask ) instance MonadNodeId m => MonadNodeId (ReaderT x m) diff --git a/src/Reflex/Vty/Host.hs b/src/Reflex/Vty/Host.hs index 9add9b6..d1f61f5 100644 --- a/src/Reflex/Vty/Host.hs +++ b/src/Reflex/Vty/Host.hs @@ -16,6 +16,7 @@ import Control.Concurrent (forkIO, killThread) 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 @@ data VtyResult t = VtyResult -- 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. diff --git a/src/Reflex/Vty/Widget.hs b/src/Reflex/Vty/Widget.hs index 211653d..3a0bfca 100644 --- a/src/Reflex/Vty/Widget.hs +++ b/src/Reflex/Vty/Widget.hs @@ -7,6 +7,7 @@ Description: Basic set of widgets and building blocks for reflex-vty application 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 @@ newtype Input t m a = Input , MonadFix , MonadIO , MonadRef + , MonadCatch + , MonadThrow + , MonadMask ) instance (Adjustable t m, MonadHold t m, Reflex t) => Adjustable t (Input t m) where @@ -237,7 +241,7 @@ inputInFocusedRegion = do V.EvKey _ _ | not focused -> Nothing -- filter scroll wheel input based on mouse position - ev@(V.EvMouseDown x y btn _) | btn == V.BScrollUp || btn == V.BScrollDown -> case tracking of + 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) @@ -336,6 +340,9 @@ newtype DisplayRegion t m a = DisplayRegion , MonadIO , MonadRef , MonadSample t + , MonadCatch + , MonadThrow + , MonadMask ) instance (Monad m, Reflex t) => HasDisplayRegion t (DisplayRegion t m) where @@ -401,6 +408,9 @@ newtype FocusReader t m a = FocusReader , MonadIO , MonadRef , MonadSample t + , MonadCatch + , MonadThrow + , MonadMask ) instance (Monad m, Reflex t) => HasFocusReader t (FocusReader t m) where @@ -466,6 +476,9 @@ newtype ImageWriter t m a = ImageWriter , PerformEvent t , PostBuild t , TriggerEvent t + , MonadCatch + , MonadThrow + , MonadMask ) instance MonadTrans (ImageWriter t) where @@ -536,6 +549,9 @@ newtype ThemeReader t m a = ThemeReader , MonadIO , MonadRef , MonadSample t + , MonadCatch + , MonadThrow + , MonadMask ) instance (Monad m, Reflex t) => HasTheme t (ThemeReader t m) where diff --git a/src/Reflex/Vty/Widget/Layout.hs b/src/Reflex/Vty/Widget/Layout.hs index 683cfd6..3c708a9 100644 --- a/src/Reflex/Vty/Widget/Layout.hs +++ b/src/Reflex/Vty/Widget/Layout.hs @@ -7,6 +7,7 @@ Description: Monad transformer and tools for arranging widgets and building scre 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 @@ newtype Focus t m a = Focus , PostBuild t , MonadNodeId , MonadIO + , MonadCatch + , MonadThrow + , MonadMask ) @@ -395,6 +399,9 @@ newtype Layout t m a = Layout , PerformEvent t , PostBuild t , TriggerEvent t + , MonadCatch + , MonadThrow + , MonadMask ) instance MonadTrans (Layout t) where