termbox-banana 0.3.1 → 0.4.0

raw patch · 3 files changed

+112/−142 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−12
• src/Termbox/Banana.hs +94/−128
• termbox-banana.cabal +6/−2

@@ -1,30 +1,30 @@-# Changelog--All notable changes to this project will be documented in this file.+## [0.4.0] - 2022-07-16 -The format is based on [Keep a Changelog](http://keepachangelog.com/)-and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).+- Parameterize `TermboxEvent` (now `Event`) by user event+- Add `Program` type alias for readability+- Remove `TermboxEvent` alias+- Drop GHC 8.2 support  ## [0.3.1] - 2022-04-02 -- Removed example executables+- Remove example executables  ## [0.3.0] - 2020-09-20  - Support GHC 8.8, GHC 8.10 - Depend on `termbox ==0.3`-- Removed `Scene`+- Remove `Scene`  ## [0.2.0] - 2019-06-28 -- Added `run`-- Renamed `main` to `run_`-- Bumped `termbox` lower bound+- Add `run`+- Rename `main` to `run_`+- Bump `termbox` lower bound  ## [0.1.1] - 2019-04-19 -- Removed unnecessary `stm` dependency-- Bumped `base` upper bound+- Remov unnecessary `stm` dependency+- Bump `base` upper bound  ## [0.1.0] - 2018-07-22 

@@ -2,11 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Termbox.Banana-  ( -- $intro-    TermboxEvent,+  ( -- * Introduction+    -- $intro++    -- * Core API+    Event (..),+    Program,     run, -    -- * Re-exports+    -- * Re-exports from @termbox@     Termbox.black,     Termbox.blue,     Termbox.bold,@@ -23,7 +27,6 @@     Termbox.Cell (..),     Termbox.Cells,     Termbox.Cursor (..),-    Termbox.Event (..),     Termbox.InitError (..),     Termbox.Key (..),     pattern Termbox.KeyCtrl2,@@ -38,125 +41,36 @@     pattern Termbox.KeyCtrlUnderscore,     Termbox.Mouse (..),     Termbox.PollError (..),--    -- * Example-    -- $example   ) where  import Control.Concurrent.MVar+import Control.Monad.IO.Class (liftIO) import Data.Function (fix)-import Reactive.Banana-import Reactive.Banana.Frameworks+import qualified Reactive.Banana as Banana+import qualified Reactive.Banana.Frameworks as Banana import qualified Termbox  -- $intro--- See the bottom of this module for a simple, runnable example to get started. ----- This module is intended to be imported qualified.+-- This module is intended to be imported qualified: -- -- @ -- import qualified Termbox.Banana as Termbox -- @---- | A @termbox@ event. This type alias exists only for Haddock readability;--- in code, you are encouraged to use ----- * @Event@ for @reactive-banana@ events--- * @Termbox.Event@ for @termbox@ events-type TermboxEvent =-  Termbox.Event--type EventSource a =-  (AddHandler a, a -> IO ())---- | Run a @termbox@ program with the specified input and output modes.------ Given------ * the terminal event stream--- * the time-varying terminal size (width, then height)------ return------ * a time-varying scene to render--- * an event stream of arbitrary values, only the first of which is relevant,---   which ends the @termbox@ program and returns from the @main@ action.-run ::-  ( Event TermboxEvent ->-    Behavior (Int, Int) ->-    MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event a)-  ) ->-  IO a-run program =-  Termbox.run $ \width height render poll -> do-    doneVar :: MVar a <--      newEmptyMVar--    (eventAddHandler, fireEvent) :: EventSource TermboxEvent <--      newAddHandler--    network :: EventNetwork <--      compile $ do-        eEvent :: Event TermboxEvent <--          fromAddHandler eventAddHandler--        let eResize :: Event (Int, Int)-            eResize =-              filterJust-                ( ( \case-                      Termbox.EventResize w h -> Just (w, h)-                      _ -> Nothing-                  )-                    <$> eEvent-                )--        bSize :: Behavior (Int, Int) <--          flip stepper eResize (width, height)--        moment (uncurry render) program eEvent bSize (putMVar doneVar)--    actuate network--    fix $ \loop -> do-      poll >>= fireEvent-      tryReadMVar doneVar >>= maybe loop pure--moment ::-  ((Termbox.Cells, Termbox.Cursor) -> IO ()) ->-  ( Event TermboxEvent ->-    Behavior (Int, Int) ->-    MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event a)-  ) ->-  Event TermboxEvent ->-  Behavior (Int, Int) ->-  (a -> IO ()) ->-  MomentIO ()-moment render program eEvent bSize abort = do-  (bScene, eDone) :: (Behavior (Termbox.Cells, Termbox.Cursor), Event a) <--    program eEvent bSize--  eScene :: Event (Future (Termbox.Cells, Termbox.Cursor)) <--    changes bScene--  liftIO . render =<< valueB bScene-  reactimate (abort <$> eDone)-  reactimate' ((fmap . fmap) render eScene)---- $example+-- ==== __👉 Quick start example__ ----- Below is a sample program that simply displays the last key pressed, and--- quits on @Esc@:+-- This is a program that displays the last key pressed, and quits on @Esc@: -- -- @--- {-\# LANGUAGE LambdaCase          \#-}--- {-\# LANGUAGE ScopedTypeVariables \#-}+-- {-\# LANGUAGE LambdaCase \#-} -- -- module Main where --+-- import Data.Void (Void) -- import Reactive.Banana -- import Reactive.Banana.Frameworks--- -- import qualified Termbox.Banana as Termbox -- -- main :: IO ()@@ -164,42 +78,94 @@ --   Termbox.'run' moment -- -- moment---   :: Event Termbox.'Termbox.Event'+--   :: (Void -> IO ())+--   -> Event (Termbox.'Event' Void) --   -> Behavior (Int, Int) --   -> MomentIO (Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor'), Event ())--- moment eEvent _bSize = do---   let---     eQuit :: Event ()---     eQuit =---       () <$ filterE isKeyEsc eEvent------   bLatestEvent :: Behavior (Maybe Termbox.'Termbox.Event') <----     stepper---       Nothing---       (Just \<$\> eEvent)------   let---     bCells :: Behavior Termbox.'Termbox.Cells'---     bCells =---       maybe mempty renderEvent \<$\> bLatestEvent------   let---     bScene :: Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor')---     bScene =---       (,)---         \<$\> bCells---         \<*\> pure Termbox.'Termbox.NoCursor'---+-- moment _fireUserEvent eEvent _bSize = do+--   let eQuit = () <$ filterE isKeyEsc eEvent+--   bLatestEvent <- stepper Nothing (Just \<$\> eEvent)+--   let bCells = maybe mempty renderEvent \<$\> bLatestEvent+--   let bScene = (,) \<$\> bCells \<*\> pure Termbox.'Termbox.NoCursor' --   pure (bScene, eQuit) ----- renderEvent :: Termbox.'Termbox.Event' -> Termbox.'Termbox.Cells'+-- renderEvent :: Show a => Termbox.'Event' a -> Termbox.'Termbox.Cells' -- renderEvent = --   foldMap (\\(i, c) -> Termbox.set i 0 (Termbox.'Termbox.Cell' c mempty mempty)) --     . zip [0..] --     . show ----- isKeyEsc :: Termbox.'Termbox.Event' -> Bool+-- isKeyEsc :: Termbox.'Event' a -> Bool -- isKeyEsc = \\case---   Termbox.'Termbox.EventKey' Termbox.'Termbox.KeyEsc' _ -> True+--   Termbox.'EventKey' Termbox.'Termbox.KeyEsc' -> True --   _ -> False -- @++-- | A key press, terminal resize, mouse click, or a user event.+data Event a+  = EventKey !Termbox.Key+  | EventResize !Int !Int+  | EventMouse !Termbox.Mouse !Int !Int+  | EventUser a+  deriving stock (Eq, Ord, Show)++type Program a b =+  -- | Callback that produces a user event.+  (a -> IO ()) ->+  -- | Event stream.+  Banana.Event (Event a) ->+  -- | Time-varying terminal size (width, then height).+  Banana.Behavior (Int, Int) ->+  -- | The time-varying scene to render, and an event stream of arbitrary values, only the first of which is relevant,+  -- which ends the @termbox@ program and returns from 'run'.+  Banana.MomentIO (Banana.Behavior (Termbox.Cells, Termbox.Cursor), Banana.Event b)++-- | Run a @termbox@ program.+run :: Program a b -> IO b+run program =+  Termbox.run $ \initialWidth initialHeight render poll -> do+    doneVar <- newEmptyMVar+    (eventAddHandler, fireEvent) <- Banana.newAddHandler+    (userEventAddHandler, fireUserEvent) <- Banana.newAddHandler++    network <-+      Banana.compile $ do+        eEvent <- Banana.fromAddHandler eventAddHandler+        eUserEvent <- Banana.fromAddHandler userEventAddHandler+        let eTermboxEvent =+              Banana.unionWith+                const+                ( ( \case+                      Termbox.EventKey key -> EventKey key+                      Termbox.EventResize width height -> EventResize width height+                      Termbox.EventMouse mouse col row -> EventMouse mouse col row+                  )+                    <$> eEvent+                )+                (EventUser <$> eUserEvent)++        let eResize :: Banana.Event (Int, Int)+            eResize =+              Banana.filterJust+                ( ( \case+                      Termbox.EventResize w h -> Just (w, h)+                      _ -> Nothing+                  )+                    <$> eEvent+                )++        bSize <- Banana.stepper (initialWidth, initialHeight) eResize+        (bScene, eDone) <- program fireUserEvent eTermboxEvent bSize+        let bRender = (\(cells, cursor) -> render cells cursor) <$> bScene+        eRender <- Banana.changes bRender+        do+          action <- Banana.valueB bRender+          liftIO action+        Banana.reactimate (putMVar doneVar <$> eDone)+        Banana.reactimate' eRender++    Banana.actuate network++    fix $ \loop -> do+      poll >>= fireEvent+      tryReadMVar doneVar >>= maybe loop pure

@@ -1,7 +1,7 @@ cabal-version: 2.4  name: termbox-banana-version: 0.3.1+version: 0.4.0 category: User Interfaces description:   A @reactive-banana@-based interface to writing @termbox@ programs.@@ -29,10 +29,11 @@  library   build-depends:-    base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16,+    base ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16,     reactive-banana ^>= 1.2 || ^>= 1.3,     termbox ^>= 0.3,   default-extensions:+    DerivingStrategies     GeneralizedNewtypeDeriving     InstanceSigs     LambdaCase@@ -50,4 +51,7 @@     ghc-options:       -Wno-missing-safe-haskell-mode       -Wno-prepositive-qualified-module+  if impl(ghc >= 9.2)+    ghc-options:+      -Wno-missing-kind-signatures   hs-source-dirs: src