diff --git a/flake.nix b/flake.nix index df761d92..e1b12981 100644 --- 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 index 06c903ff..d39806f8 100644 --- 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 index 51713164..9ea4aadc 100644 --- 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 } )