Port to brick versions >= 1.0 (#229)

* Port to brick versions >= 1.0 * Add source-overrides for brick 1.4 until nixpkgs bump
tweag · Nov 6, 2022 · 50b4865 · 50b4865
1 parent 99464a3
commit 50b4865
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 11 deletions.
diff --git a/flake.nix b/flake.nix
@@ -61,7 +61,35 @@
           "^test.*$"
           "^.*\.md"
         ];
-        monad-bayes = pkgs.haskell.packages.ghc902.callCabal2nixWithOptions "monad-bayes" src "--benchmark" {};
+        monad-bayes = pkgs.haskell.packages.ghc902.developPackage {
+          name = "monad-bayes";
+          root = src;
+
+          # Remove this override when bumping nixpkgs
+          source-overrides = {
+            vty = pkgs.fetchzip {
+              url = "mirror://hackage/vty-5.37/vty-5.37.tar.gz";
+              sha256 = "sha256-OOrJBi/mSIyaibgObrp6NmUTWxRu9pxmjAL0EuPV9wY=";
+            };
+
+            text-zipper = pkgs.fetchzip {
+              url = "mirror://hackage/text-zipper-0.12/text-zipper-0.12.tar.gz";
+              sha256 = "sha256-P2/UHuG3UuSN7G31DyYvyUWSyIj2YXAOmjGkHtTaP8o=";
+            };
+
+            bimap = pkgs.fetchzip {
+              url = "mirror://hackage/bimap-0.5.0/bimap-0.5.0.tar.gz";
+              sha256 = "sha256-pbw+xg9Qz/c7YoXAJg8SR11RJGmgMw5hhnzKv+bGK9w=";
+            };
+
+            brick = pkgs.fetchzip {
+              url = "mirror://hackage/brick-1.4/brick-1.4.tar.gz";
+              sha256 = "sha256-KDa7RVQQPpinkJ0aKsYP0E50pn2auEIP38l6Uk7GmmE=";
+            };
+          };
+
+          cabal2nixOptions = "--benchmark";
+        };
 
         iHaskell = pkgs.kernels.iHaskellWith {
           # Identifier that will appear on the Jupyter interface.

diff --git a/monad-bayes.cabal b/monad-bayes.cabal
@@ -65,7 +65,7 @@ library
   default-language:   Haskell2010
   build-depends:
       base             >=4.11   && <4.17
-    , brick
+    , brick            >=1.0    && <2.0
     , containers       >=0.5.10 && <0.7
     , foldl
     , free             >=5.0.2  && <5.2

diff --git a/src/Control/Monad/Bayes/Inference/TUI.hs b/src/Control/Monad/Bayes/Inference/TUI.hs
@@ -21,6 +21,7 @@ import Control.Monad.Bayes.Sampler.Strict (SamplerIO, sampleIO)
 import Control.Monad.Bayes.Traced (Traced)
 import Control.Monad.Bayes.Traced.Common
 import Control.Monad.Bayes.Weighted
+import Control.Monad.State.Class (put)
 import Data.Scientific (FPFormat (Exponent), formatScientific, fromFloatDigits)
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
@@ -108,14 +109,11 @@ showVal :: Show a => [a] -> Widget n
 showVal = txt . T.pack . (\case [] -> ""; a -> show $ head a)
 
 -- | handler for events received by the TUI
-appEvent :: s -> B.BrickEvent n1 s -> B.EventM n2 (B.Next s)
-appEvent p (B.VtyEvent e) =
-  case e of
-    V.EvKey (V.KChar 'q') [] -> do
-      B.halt p
-    _ -> B.continue p
-appEvent _ (B.AppEvent d) = B.continue d
-appEvent _ _ = error "unknown event"
+appEvent :: B.BrickEvent n s -> B.EventM n s ()
+appEvent (B.VtyEvent (V.EvKey (V.KChar 'q') [])) = B.halt
+appEvent (B.VtyEvent _) = pure ()
+appEvent (B.AppEvent d) = put d
+appEvent _ = error "unknown event"
 
 doneAttr, toDoAttr :: B.AttrName
 doneAttr = B.attrName "theBase" <> B.attrName "done"
@@ -145,7 +143,7 @@ tui burnIn distribution visualizer = void do
             { B.appDraw = drawUI visualizer,
               B.appChooseCursor = B.showFirstCursor,
               B.appHandleEvent = appEvent,
-              B.appStartEvent = return,
+              B.appStartEvent = return (),
               B.appAttrMap = const theMap
             }
         )