Merge pull request #76 from reflex-frp/aa/monadmask-2

Add MonadCatch, MonadThrow, MonadMask instances

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
 

dep/reflex/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

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"
+}

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

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 (<https://reflex-frp.org>).
@@ -48,14 +48,15 @@ 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,
     mmorph >= 1.1 && < 1.3,
     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

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";

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}";

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)

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.

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

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