termbox-banana 0.4.0 → 1.0.0

raw patch · 5 files changed

+199/−166 lines, 5 filesdep ~basedep ~reactive-bananadep ~termboxPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, reactive-banana, termbox

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• LICENSE +1/−1
• README.md +0/−6
• src/Termbox/Banana.hs +174/−143
• termbox-banana.cabal +19/−16

@@ -1,3 +1,8 @@+## [1.0.0] - 2022-11-03++- Rework `run` type+- Bump to `termbox-1.1.0`, whose API changes are visible here, too+ ## [0.4.0] - 2022-07-16  - Parameterize `TermboxEvent` (now `Event`) by user event

@@ -1,4 +1,4 @@-Copyright 2018 Mitchell Rosen+Copyright 2018-2022 Mitchell Rosen  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 

@@ -1,6 +0,0 @@-# `termbox-banana`--[![GitHub CI](https://github.com/mitchellwrosen/termbox-banana/workflows/CI/badge.svg)](https://github.com/mitchellwrosen/termbox-banana/actions)-[![Hackage](https://img.shields.io/hackage/v/termbox-banana.svg)](https://hackage.haskell.org/package/termbox-banana)-[![Stackage LTS](https://stackage.org/package/termbox-banana/badge/lts)](https://www.stackage.org/lts/package/termbox-banana)-[![Stackage Nightly](https://stackage.org/package/termbox-banana/badge/nightly)](https://www.stackage.org/nightly/package/termbox-banana)

@@ -1,171 +1,202 @@-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-+-- |+-- This module provides a @reactive-banana@ FRP interface to @termbox@, a simple C library for writing text-based user+-- interfaces: <https://github.com/termbox/termbox>+--+-- See also:+--+-- * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@, an Elm Architecture interface.+--+-- This module is intended to be imported qualified.+--+-- ==== __👉 Quick start example__+--+-- This @termbox@ program displays the number of keys pressed.+--+-- @+-- {-\# LANGUAGE DuplicateRecordFields \#-}+-- {-\# LANGUAGE ImportQualifiedPost \#-}+-- {-\# LANGUAGE LambdaCase \#-}+-- {-\# LANGUAGE OverloadedRecordDot \#-}+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE NoFieldSelectors \#-}+--+-- import Data.Foldable (fold)+-- import Reactive.Banana ((\<\@\>))+-- import Reactive.Banana qualified as Banana+-- import Termbox.Banana qualified as Termbox+--+-- main :: IO ()+-- main =+--   Termbox.'run' network \>\>= \\case+--     Left err -\> putStrLn (\"Termbox program failed to initialize: \" ++ show err)+--     Right n -\> putStrLn (\"Pressed \" ++ show n ++ \" keys.\")+--+-- network :: Banana.MonadMoment m =\> Termbox.'Inputs' -\> m (Termbox.'Outputs' Int)+-- network inputs = do+--   keysPressed <- Banana.accumB 0 ((+ 1) \<$ inputs.keys)+--   pure+--     Termbox.'Outputs'+--       { scene = render \<$\> keysPressed,+--         done = Banana.filterJust (isDone \<$\> keysPressed \<\@\> inputs.keys)+--       }+--   where+--     isDone :: Int -\> Termbox.'Termbox.Banana.Key' -\> Maybe Int+--     isDone n = \\case+--       Termbox.'Termbox.Banana.KeyEsc' -\> Just n+--       _ -\> Nothing+--+-- render :: Int -\> Termbox.'Termbox.Banana.Scene'+-- render keysPressed =+--   fold+--     [ string+--         Termbox.'Termbox.Banana.Pos' {row = 2, col = 4}+--         (\"Number of keys pressed: \" ++ map Termbox.'Termbox.Banana.char' (show keysPressed)),+--       string+--         Termbox.'Termbox.Banana.Pos' {row = 4, col = 4}+--         (\"Press \" ++ map (Termbox.'Termbox.Banana.bold' . Termbox.'Termbox.Banana.char') \"Esc\" ++ \" to quit.\")+--     ]+--+-- string :: Termbox.'Termbox.Banana.Pos' -\> [Termbox.'Termbox.Banana.Cell'] -\> Termbox.'Termbox.Banana.Scene'+-- string pos cells =+--   foldMap (\\(i, cell) -\> Termbox.'Termbox.Banana.cell' (Termbox.'Termbox.Banana.posRight' i pos) cell) (zip [0 ..] cells)+-- @ module Termbox.Banana-  ( -- * Introduction-    -- $intro--    -- * Core API-    Event (..),-    Program,+  ( -- * Main+    Inputs (..),+    Outputs (..),     run,+    Termbox.InitError (..), -    -- * Re-exports from @termbox@-    Termbox.black,-    Termbox.blue,+    -- * Terminal contents++    -- ** Scene+    Termbox.Scene,+    Termbox.cell,+    Termbox.fill,+    Termbox.cursor,++    -- ** Cell+    Termbox.Cell,+    Termbox.char,+    Termbox.fg,+    Termbox.bg,     Termbox.bold,-    Termbox.cyan,+    Termbox.underline,+    Termbox.blink,++    -- ** Colors+    Termbox.Color,++    -- *** Basic colors+    Termbox.defaultColor,+    Termbox.red,     Termbox.green,+    Termbox.yellow,+    Termbox.blue,     Termbox.magenta,-    Termbox.red,-    Termbox.reverse,-    Termbox.underline,+    Termbox.cyan,     Termbox.white,-    Termbox.yellow,-    Termbox.set,-    Termbox.Attr,-    Termbox.Cell (..),-    Termbox.Cells,-    Termbox.Cursor (..),-    Termbox.InitError (..),+    Termbox.bright,++    -- *** 216 miscellaneous colors+    Termbox.color,++    -- *** 24 monochrome colors+    Termbox.gray,++    -- * Event handling     Termbox.Key (..),-    pattern Termbox.KeyCtrl2,-    pattern Termbox.KeyCtrl3,-    pattern Termbox.KeyCtrl4,-    pattern Termbox.KeyCtrl5,-    pattern Termbox.KeyCtrl7,-    pattern Termbox.KeyCtrlH,-    pattern Termbox.KeyCtrlI,-    pattern Termbox.KeyCtrlLsqBracket,-    pattern Termbox.KeyCtrlM,-    pattern Termbox.KeyCtrlUnderscore,     Termbox.Mouse (..),-    Termbox.PollError (..),+    Termbox.MouseButton (..),++    -- * Miscellaneous types+    Termbox.Pos (..),+    Termbox.posUp,+    Termbox.posDown,+    Termbox.posLeft,+    Termbox.posRight,+    Termbox.Size (..),   ) where  import Control.Concurrent.MVar import Control.Monad.IO.Class (liftIO)-import Data.Function (fix)+import Data.Void (Void) import qualified Reactive.Banana as Banana import qualified Reactive.Banana.Frameworks as Banana import qualified Termbox --- $intro------ This module is intended to be imported qualified:------ @--- import qualified Termbox.Banana as Termbox--- @------ ==== __👉 Quick start example__------ This is a program that displays the last key pressed, and quits on @Esc@:------ @--- {-\# LANGUAGE LambdaCase \#-}------ module Main where------ import Data.Void (Void)--- import Reactive.Banana--- import Reactive.Banana.Frameworks--- import qualified Termbox.Banana as Termbox------ main :: IO ()--- main =---   Termbox.'run' moment------ moment---   :: (Void -> IO ())---   -> Event (Termbox.'Event' Void)---   -> Behavior (Int, Int)---   -> MomentIO (Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor'), Event ())--- 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)+-- | The inputs to a @termbox@ FRP network.+data Inputs = Inputs+  { -- | The initial terminal size.+    initialSize :: !Termbox.Size,+    -- | Key events.+    keys :: !(Banana.Event Termbox.Key),+    -- | Resize events.+    resizes :: !(Banana.Event Termbox.Size),+    -- | Mouse events.+    mouses :: !(Banana.Event Termbox.Mouse)+  }++-- | The outputs from a @termbox@ FRP network.+data Outputs a = Outputs+  { -- | The scene to render.+    scene :: !(Banana.Behavior Termbox.Scene),+    -- | The events of arbitrary values, on the first of which is relevant, which causes 'run' to return.+    --+    -- /Note/: Wrapping this event in 'Banana.once' is not necessary, as this library does so internally.+    done :: !(Banana.Event a)+  }++-- | Run a @termbox@ FRP network. ----- 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+-- @run@ either: ----- isKeyEsc :: Termbox.'Event' a -> Bool--- isKeyEsc = \\case---   Termbox.'EventKey' Termbox.'Termbox.KeyEsc' -> True---   _ -> False--- @+--   * Returns immediately with an 'InitError'.+--   * Returns the first value emitted by @done@.+run ::+  -- | The FRP network.+  (Inputs -> Banana.MomentIO (Outputs a)) ->+  -- | The result of the FRP network.+  IO (Either Termbox.InitError a)+run program =+  Termbox.run (run_ program) --- | 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)+run_ :: (Inputs -> Banana.MomentIO (Outputs a)) -> IO a+run_ program = do+  initialSize <- Termbox.getSize -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)+  doneVar <- newEmptyMVar+  (keysAddHandler, fireKey) <- Banana.newAddHandler+  (resizesAddHandler, fireResize) <- Banana.newAddHandler+  (mousesAddHandler, fireMouse) <- Banana.newAddHandler --- | 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+      keys <- Banana.fromAddHandler keysAddHandler+      resizes <- Banana.fromAddHandler resizesAddHandler+      mouses <- Banana.fromAddHandler mousesAddHandler -    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)+      Outputs {scene, done} <- program Inputs {initialSize, keys, resizes, mouses}+      let render = Termbox.render <$> scene -        let eResize :: Banana.Event (Int, Int)-            eResize =-              Banana.filterJust-                ( ( \case-                      Termbox.EventResize w h -> Just (w, h)-                      _ -> Nothing-                  )-                    <$> eEvent-                )+      -- Render the first scene, and again every time it changes.+      liftIO =<< Banana.valueB render+      Banana.reactimate' =<< Banana.changes render -        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+      -- Smuggle `done` values out via `doneVar` (only the first matters)+      done1 <- Banana.once done+      Banana.reactimate (putMVar doneVar <$> done1) -    Banana.actuate network+  Banana.actuate network -    fix $ \loop -> do-      poll >>= fireEvent-      tryReadMVar doneVar >>= maybe loop pure+  let loop = do+        Termbox.poll @Void >>= \case+          Termbox.EventKey key -> fireKey key+          Termbox.EventResize size -> fireResize size+          Termbox.EventMouse mouse -> fireMouse mouse+        tryReadMVar doneVar >>= \case+          Nothing -> loop+          Just result -> pure result++  loop

@@ -1,27 +1,27 @@ cabal-version: 2.4 -name: termbox-banana-version: 0.4.0+author: Mitchell Rosen+bug-reports: https://github.com/mitchellwrosen/termbox-banana/issues+build-type: Simple category: User Interfaces+copyright: (c) 2018-2022, Mitchell Rosen description:-  A @reactive-banana@-based interface to writing @termbox@ programs.+  This package provides a @reactive-banana@ FRP interface to @termbox@ programs.   .-  See also the <https://hackage.haskell.org/termbox termbox> package for a-  lower-level, imperative interface.-synopsis: reactive-banana + termbox-author: Mitchell Rosen-maintainer: Mitchell Rosen <mitchellwrosen@gmail.com>+  See also:+  .+  * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@ for an Elm Architecture interface. homepage: https://github.com/mitchellwrosen/termbox-banana-bug-reports: https://github.com/mitchellwrosen/termbox-banana/issues-copyright: (c) 2018-2022, Mitchell Rosen license: BSD-3-Clause license-file: LICENSE-build-type: Simple-tested-with: GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.1+maintainer: Mitchell Rosen <mitchellwrosen@gmail.com>+name: termbox-banana+synopsis: termbox + reactive-banana+tested-with: GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2+version: 1.0.0  extra-source-files:   CHANGELOG.md-  README.md  source-repository head   type: git@@ -29,14 +29,17 @@  library   build-depends:-    base ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16,-    reactive-banana ^>= 1.2 || ^>= 1.3,-    termbox ^>= 0.3,+    base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17,+    reactive-banana ^>= 1.3,+    termbox ^>= 1.1.0,   default-extensions:+    BlockArguments     DerivingStrategies     GeneralizedNewtypeDeriving     InstanceSigs     LambdaCase+    NamedFieldPuns+    TypeApplications   default-language: Haskell2010   exposed-modules: Termbox.Banana   ghc-options: