termbox-banana 0.2.0 → 0.3.0

raw patch · 6 files changed

+273/−508 lines, 6 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

• .travis.yml +0/−137
• CHANGELOG.md +9/−0
• examples/Echo.hs +20/−27
• examples/Hoogle.hs +121/−135
• src/Termbox/Banana.hs +82/−148
• termbox-banana.cabal +41/−61

@@ -1,137 +0,0 @@-# This Travis job script has been generated by a script via-#-#   haskell-ci 'termbox-banana.cabal'-#-# For more information, see https://github.com/haskell-CI/haskell-ci-#-# version: 0.3.20190521-#-language: c-dist: xenial-git:-  # whether to recursively clone submodules-  submodules: false-cache:-  directories:-    - $HOME/.cabal/packages-    - $HOME/.cabal/store-before_cache:-  - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log-  # remove files that are regenerated by 'cabal update'-  - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*-  - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json-  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache-  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar-  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx-  - rm -rfv $CABALHOME/packages/head.hackage-matrix:-  include:-    - compiler: ghc-8.6.5-      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}-    - compiler: ghc-8.4.4-      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}-before_install:-  - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')-  - HCPKG="$HC-pkg"-  - unset CC-  - CABAL=/opt/ghc/bin/cabal-  - CABALHOME=$HOME/.cabal-  - export PATH="$CABALHOME/bin:$PATH"-  - TOP=$(pwd)-  - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))-  - echo $HCNUMVER-  - CABAL="$CABAL -vnormal+nowrap+markoutput"-  - set -o pipefail-  - |-    echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }'           >> .colorful.awk-    echo 'BEGIN { state = "output"; }'                                     >> .colorful.awk-    echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }'            >> .colorful.awk-    echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }'             >> .colorful.awk-    echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk-    echo '  if (state == "cabal") {'                                       >> .colorful.awk-    echo '    print blue($0)'                                              >> .colorful.awk-    echo '  } else {'                                                      >> .colorful.awk-    echo '    print $0'                                                    >> .colorful.awk-    echo '  }'                                                             >> .colorful.awk-    echo '}'                                                               >> .colorful.awk-  - cat .colorful.awk-  - |-    color_cabal_output () {-      awk -f $TOP/.colorful.awk-    }-  - echo text | color_cabal_output-install:-  - ${CABAL} --version-  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"-  - TEST=--enable-tests-  - BENCH=--enable-benchmarks-  - GHCHEAD=${GHCHEAD-false}-  - rm -f $CABALHOME/config-  - |-    echo "verbose: normal +nowrap +markoutput"          >> $CABALHOME/config-    echo "remote-build-reporting: anonymous"            >> $CABALHOME/config-    echo "remote-repo-cache: $CABALHOME/packages"       >> $CABALHOME/config-    echo "logs-dir:          $CABALHOME/logs"           >> $CABALHOME/config-    echo "world-file:        $CABALHOME/world"          >> $CABALHOME/config-    echo "extra-prog-path:   $CABALHOME/bin"            >> $CABALHOME/config-    echo "symlink-bindir:    $CABALHOME/bin"            >> $CABALHOME/config-    echo "installdir:        $CABALHOME/bin"            >> $CABALHOME/config-    echo "build-summary:     $CABALHOME/logs/build.log" >> $CABALHOME/config-    echo "store-dir:         $CABALHOME/store"          >> $CABALHOME/config-    echo "install-dirs user"                            >> $CABALHOME/config-    echo "  prefix: $CABALHOME"                         >> $CABALHOME/config-    echo "repository hackage.haskell.org"               >> $CABALHOME/config-    echo "  url: http://hackage.haskell.org/"           >> $CABALHOME/config-  - cat $CABALHOME/config-  - rm -fv cabal.project cabal.project.local cabal.project.freeze-  - travis_retry ${CABAL} v2-update -v-  # Generate cabal.project-  - rm -rf cabal.project cabal.project.local cabal.project.freeze-  - touch cabal.project-  - |-    echo 'packages: "."' >> cabal.project-  - |-    echo "write-ghc-environment-files: always" >> cabal.project-  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(termbox-banana)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"-  - cat cabal.project || true-  - cat cabal.project.local || true-  - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi-  - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output-  - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"-  - rm  cabal.project.freeze-  - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output-  - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output-script:-  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)-  # Packaging...-  - ${CABAL} v2-sdist all | color_cabal_output-  # Unpacking...-  - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/-  - cd ${DISTDIR} || false-  - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;-  # Generate cabal.project-  - rm -rf cabal.project cabal.project.local cabal.project.freeze-  - touch cabal.project-  - |-    echo 'packages: "termbox-banana-*/*.cabal"' >> cabal.project-  - |-    echo "write-ghc-environment-files: always" >> cabal.project-  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(termbox-banana)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"-  - cat cabal.project || true-  - cat cabal.project.local || true-  # Building...-  # this builds all libraries and executables (without tests/benchmarks)-  - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output-  # Building with tests and benchmarks...-  # build & run tests, build benchmarks-  - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output-  # cabal check...-  - (cd termbox-banana-* && ${CABAL} -vnormal check)-  # haddock...-  - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output-  # Building without installed constraints for packages in global-db...-  - rm -f cabal.project.local-  - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output--# REGENDATA ["termbox-banana.cabal"]-# EOF

@@ -5,6 +5,15 @@ 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/). +## [0.3.0] - 2020-09-20++### Changed+- Support GHC 8.8, GHC 8.10+- Depend on `termbox ==0.3`++### Removed+- Removed `Scene`+ ## [0.2.0] - 2019-06-28  ### Added

@@ -1,56 +1,49 @@-{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -module Main where+module Main (main) where  import Reactive.Banana import Reactive.Banana.Frameworks- import qualified Termbox.Banana as Termbox  main :: IO () main =-  Termbox.run_-    (Termbox.InputModeEsc Termbox.MouseModeNo)-    Termbox.OutputModeNormal-    moment+  Termbox.run moment -moment-  :: Event Termbox.Event-  -> Behavior (Int, Int)-  -> MomentIO (Behavior Termbox.Scene, Event ())+moment ::+  Event Termbox.Event ->+  Behavior (Int, Int) ->+  MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event ()) moment eEvent _bSize = do-  let-    eQuit :: Event ()-    eQuit =-      () <$ filterE isKeyEsc eEvent+  let eQuit :: Event ()+      eQuit =+        () <$ filterE isKeyEsc eEvent    bLatestEvent :: Behavior (Maybe Termbox.Event) <-     stepper       Nothing       (Just <$> eEvent) -  let-    bCells :: Behavior Termbox.Cells-    bCells =-      maybe mempty renderEvent <$> bLatestEvent+  let bCells :: Behavior Termbox.Cells+      bCells =+        maybe mempty renderEvent <$> bLatestEvent -  let-    bScene :: Behavior Termbox.Scene-    bScene =-      Termbox.Scene-        <$> bCells-        <*> pure Termbox.NoCursor+  let bScene :: Behavior (Termbox.Cells, Termbox.Cursor)+      bScene =+        (,)+          <$> bCells+          <*> pure Termbox.NoCursor    pure (bScene, eQuit)  renderEvent :: Termbox.Event -> Termbox.Cells renderEvent =   foldMap (\(i, c) -> Termbox.set i 0 (Termbox.Cell c mempty mempty))-    . zip [0..]+    . zip [0 ..]     . show  isKeyEsc :: Termbox.Event -> Bool isKeyEsc = \case-  Termbox.EventKey Termbox.KeyEsc _ -> True+  Termbox.EventKey Termbox.KeyEsc -> True   _ -> False

@@ -1,7 +1,7 @@-{-# language LambdaCase          #-}-{-# language OverloadedStrings   #-}-{-# language RecursiveDo         #-}-{-# language ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Main where @@ -22,21 +22,17 @@ import Network.HTTP.Simple import Reactive.Banana import Reactive.Banana.Frameworks-import Text.HTML.TagSoup- import qualified Termbox.Banana as Termbox+import Text.HTML.TagSoup  main :: IO () main =-  Termbox.run_-    (Termbox.InputModeEsc Termbox.MouseModeNo)-    Termbox.OutputModeNormal-    moment+  Termbox.run moment -moment-  :: Event Termbox.Event-  -> Behavior (Int, Int)-  -> MomentIO (Behavior Termbox.Scene, Event ())+moment ::+  Event Termbox.Event ->+  Behavior (Int, Int) ->+  MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event ()) moment eEvent bSize = mdo   eTick :: Event () <-     makeTickEvent@@ -47,13 +43,11 @@   eSearchBox :: Event String <-     makeSearchBoxEvent eKey -  reactimate-    ((atomically . writeTQueue requestQueue . reverse) <$> eSearchBox)+  reactimate ((atomically . writeTQueue requestQueue . reverse) <$> eSearchBox) -  let-    eEmptySearchBox :: Event String-    eEmptySearchBox =-      filterE null eSearchBox+  let eEmptySearchBox :: Event String+      eEmptySearchBox =+        filterE null eSearchBox    bSearchBox :: Behavior String <-     stepper "" eSearchBox@@ -69,53 +63,54 @@   bSearchResults :: Behavior (Either SomeException [Value]) <-     stepper       (Right [])-      (unionWith-        const-        (Right [] <$ eEmptySearchBox)-        eSearchResults)+      ( unionWith+          const+          (Right [] <$ eEmptySearchBox)+          eSearchResults+      )    bSpinnerFrame :: Behavior (Maybe Int) <--    accumB Nothing (unions-      [ ((\query ->-            if null query-              then const Nothing-              else const (Just 1))-          <$> eSearchBox)-      , const Nothing <$ eSearchResults-      , const Nothing <$ eEmptySearchBox-      , fmap (+1) <$ whenE (isJust <$> bSpinnerFrame) eTick-      ])+    accumB+      Nothing+      ( unions+          [ ( ( \query ->+                  if null query+                    then const Nothing+                    else const (Just 1)+              )+                <$> eSearchBox+            ),+            const Nothing <$ eSearchResults,+            const Nothing <$ eEmptySearchBox,+            fmap (+ 1) <$ whenE (isJust <$> bSpinnerFrame) eTick+          ]+      ) -  let-    bCells :: Behavior Termbox.Cells-    bCells =-      render-        <$> bHeight-        <*> bSearchBox-        <*> bSearchResults-        <*> bSpinnerFrame+  let bCells :: Behavior Termbox.Cells+      bCells =+        render+          <$> bHeight+          <*> bSearchBox+          <*> bSearchResults+          <*> bSpinnerFrame -  let-    bCursor :: Behavior Termbox.Cursor-    bCursor =-      (\height searchBox -> Termbox.Cursor (length searchBox + 2) height)-        <$> bHeight-        <*> bSearchBox+  let bCursor :: Behavior Termbox.Cursor+      bCursor =+        (\height searchBox -> Termbox.Cursor (length searchBox + 2) height)+          <$> bHeight+          <*> bSearchBox -  let-    bScene :: Behavior Termbox.Scene-    bScene =-      Termbox.Scene-        <$> bCells-        <*> bCursor+  let bScene :: Behavior (Termbox.Cells, Termbox.Cursor)+      bScene =+        (,)+          <$> bCells+          <*> bCursor    pure (bScene, () <$ filterE (== Termbox.KeyEsc) eKey)-   where     eKey :: Event Termbox.Key     eKey =       filterJust (eventAsKey <$> eEvent)-     bHeight :: Behavior Int     bHeight =       snd <$> bSize@@ -128,56 +123,59 @@     threadDelay 100000   pure e -makeSearchBoxEvent-  :: MonadMoment m-  => Event Termbox.Key-  -> m (Event String)+makeSearchBoxEvent ::+  MonadMoment m =>+  Event Termbox.Key ->+  m (Event String) makeSearchBoxEvent eKey =   accumE     ""-    (unions-      [ (:) <$> filterJust (keyAsChar <$> eKey)-      , (' ' :) <$  filterE (== Termbox.KeySpace) eKey-      , safeTail <$ filterE (== Termbox.KeyBackspace2) eKey-      ])+    ( unions+        [ (:) <$> filterJust (keyAsChar <$> eKey),+          (' ' :) <$ filterE (== Termbox.KeySpace) eKey,+          safeTail <$ filterE (== Termbox.KeyCtrl8) eKey+        ]+    ) -runHttpRequestThread-  :: TQueue String -- ^ Request queue-  -> (Either SomeException [Value] -> IO ()) -- ^ Response callback-  -> IO ()+runHttpRequestThread ::+  -- | Request queue+  TQueue String ->+  -- | Response callback+  (Either SomeException [Value] -> IO ()) ->+  IO () runHttpRequestThread requestQueue respond =   loop Nothing   where     loop :: Maybe (Async [Value]) -> IO ()     loop maybeInFlightRequest =       join . atomically $-        (do-          query <- readTQueue requestQueue-          pure $ do-            for_ maybeInFlightRequest $ \inFlightRequest ->-              forkIO (cancel inFlightRequest)-            if null query-              then-                loop Nothing-              else do-                inFlightRequest <- async (performHoogleSearch query)-                loop (Just inFlightRequest))-        <|>-        (case maybeInFlightRequest of-          Nothing ->-            retry-          Just inFlightRequest -> do-            response <- waitCatchSTM inFlightRequest+        ( do+            query <- readTQueue requestQueue             pure $ do-              respond response-              loop Nothing)+              for_ maybeInFlightRequest $ \inFlightRequest ->+                forkIO (cancel inFlightRequest)+              if null query+                then loop Nothing+                else do+                  inFlightRequest <- async (performHoogleSearch query)+                  loop (Just inFlightRequest)+        )+          <|> ( case maybeInFlightRequest of+                  Nothing ->+                    retry+                  Just inFlightRequest -> do+                    response <- waitCatchSTM inFlightRequest+                    pure $ do+                      respond response+                      loop Nothing+              ) -render-  :: Int-  -> String-  -> Either SomeException [Value]-  -> Maybe Int-  -> Termbox.Cells+render ::+  Int ->+  String ->+  Either SomeException [Value] ->+  Maybe Int ->+  Termbox.Cells render height searchBox searchResults spinnerFrame =   fold     [ case searchResults of@@ -186,56 +184,52 @@         Right results ->           renderSearchResults height results             & execWriterT-            & (`evalState` 0)-    , renderSearchBox height searchBox spinnerFrame+            & (`evalState` 0),+      renderSearchBox height searchBox spinnerFrame     ]  renderSearchBox :: Int -> String -> Maybe Int -> Termbox.Cells renderSearchBox height searchBox spinnerFrame =-  renderString 0 (height-1) (promptChar : ' ' : reverse searchBox)+  renderString 0 (height -1) (promptChar : ' ' : reverse searchBox)   where     promptChar :: Char     promptChar =       case spinnerFrame of         Nothing ->           'λ'-        Just n  ->-          let-            cs =-              "⣧⣏⡟⠿⢻⣹⣼⣶"-          in-            cs !! (n `mod` length cs)+        Just n ->+          let cs =+                "⣧⣏⡟⠿⢻⣹⣼⣶"+           in cs !! (n `mod` length cs) -renderSearchResults-  :: Int-  -> [Value]-  -> WriterT Termbox.Cells (State Int) ()+renderSearchResults ::+  Int ->+  [Value] ->+  WriterT Termbox.Cells (State Int) () renderSearchResults height = \case   [] ->     pure ()-   result : results -> do     row <- get -    let-      ss = searchResultToLines result+    let ss = searchResultToLines result -    when (row + length ss < height-1) $ do-      for_ (zip [row..] ss) $ \(r, s) ->+    when (row + length ss < height -1) $ do+      for_ (zip [row ..] ss) $ \(r, s) ->         tell (renderString 0 r s)       modify' (+ (length ss + 1))       renderSearchResults height results -renderSearchResultsError-  :: Int-  -> SomeException-  -> Termbox.Cells+renderSearchResultsError ::+  Int ->+  SomeException ->+  Termbox.Cells renderSearchResultsError height ex =   ex     & show     & lines     & take height-    & zip [0..]+    & zip [0 ..]     & foldMap (\(row, line) -> renderString 0 row line)  searchResultToLines :: Value -> [String]@@ -243,23 +237,20 @@   case result ^?! key "type" of     "" ->       unwords-        [ "[" ++ resultPackage result ++ "]"-        , "[" ++ resultModule result ++ "]"-        , resultItem result+        [ "[" ++ resultPackage result ++ "]",+          "[" ++ resultModule result ++ "]",+          resultItem result         ]         : map ("  " ++) (resultDocs result)-     "module" ->       unwords-        [ "[" ++ resultPackage result ++ "]"-        , "[" ++ drop 7 (resultItem result) ++ "]"+        [ "[" ++ resultPackage result ++ "]",+          "[" ++ drop 7 (resultItem result) ++ "]"         ]         : map ("  " ++) (resultDocs result)-     "package" ->       ("[" ++ drop 8 (resultItem result) ++ "]")         : map ("  " ++) (resultDocs result)-     _ ->       error (show result) @@ -296,21 +287,17 @@       . to htmlToText       . to lines       . to collapseLines-   where     collapseLines :: [String] -> [String]     collapseLines = \case       [] ->         []-       [""] ->         []-       "" : ss ->         case collapseLines ss of           "" : ts -> "" : ts-          ts      -> "" : ts-+          ts -> "" : ts       s : ss ->         s : collapseLines ss @@ -320,11 +307,10 @@     TagText text <- parseTags html     pure text - renderString :: Int -> Int -> String -> Termbox.Cells renderString col row =-  foldMap (\(i, c) -> Termbox.set i row (Termbox.Cell c mempty mempty)) .-    zip [col..]+  foldMap (\(i, c) -> Termbox.set i row (Termbox.Cell c mempty mempty))+    . zip [col ..]  performHoogleSearch :: String -> IO [Value] performHoogleSearch query =@@ -336,7 +322,7 @@  eventAsKey :: Termbox.Event -> Maybe Termbox.Key eventAsKey = \case-  Termbox.EventKey k _ -> Just k+  Termbox.EventKey k -> Just k   _ -> Nothing  keyAsChar :: Termbox.Key -> Maybe Char@@ -347,4 +333,4 @@ safeTail :: [a] -> [a] safeTail = \case   [] -> []-  _:xs -> xs+  _ : xs -> xs

@@ -1,62 +1,58 @@-{-# language DerivingStrategies         #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language LambdaCase                 #-}-{-# language ScopedTypeVariables        #-}-{-# language TypeFamilies               #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Termbox.Banana   ( -- $intro-    TermboxEvent-  , run-  , run_-  , set-  , Scene(..)-  , Cells-  , Cursor(..)+    TermboxEvent,+    run,+     -- * Re-exports-  , Termbox.black-  , Termbox.red-  , Termbox.green-  , Termbox.yellow-  , Termbox.blue-  , Termbox.magenta-  , Termbox.cyan-  , Termbox.white-  , Termbox.bold-  , Termbox.underline-  , Termbox.reverse-  , Termbox.Attr-  , Termbox.Cell(..)-  , Termbox.Event(..)-  , Termbox.InitError(..)-  , Termbox.InputMode(..)-  , Termbox.Key(..)-  , Termbox.Mouse(..)-  , Termbox.MouseMode(..)-  , Termbox.OutputMode(..)+    Termbox.black,+    Termbox.blue,+    Termbox.bold,+    Termbox.cyan,+    Termbox.green,+    Termbox.magenta,+    Termbox.red,+    Termbox.reverse,+    Termbox.underline,+    Termbox.white,+    Termbox.yellow,+    Termbox.set,+    Termbox.Attr,+    Termbox.Cell (..),+    Termbox.Cells,+    Termbox.Cursor (..),+    Termbox.Event (..),+    Termbox.InitError (..),+    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 (..),+     -- * Example     -- $example-  ) where+  )+where  import Control.Concurrent.MVar-import Control.Exception (throwIO) import Data.Function (fix) import Reactive.Banana import Reactive.Banana.Frameworks- import qualified Termbox - -- $intro -- See the bottom of this module for a simple, runnable example to get started. ----- Here's how to run the examples with @cabal@:------ @--- cabal v2-run --constraint "termbox-banana +build-examples" termbox-banana-example-echo--- cabal v2-run --constraint "termbox-banana +build-examples" termbox-banana-example-hoogle--- @--- -- This module is intended to be imported qualified. -- -- @@@ -68,42 +64,11 @@ -- -- * @Event@ for @reactive-banana@ events -- * @Termbox.Event@ for @termbox@ events------ @since 0.1.0-type TermboxEvent-  = Termbox.Event---- | A scene to render; a grid of cells and a cursor.------ @since 0.1.0-data Scene-  = Scene !Cells !Cursor---- | A grid of cells.------ Create a 'Cells' with 'set' or 'mempty' and combine them with ('<>').------ @since 0.1.0-newtype Cells-  = Cells (IO ())-  deriving newtype (Monoid, Semigroup)---- | A cursor.------ @since 0.1.0-data Cursor-  = Cursor !Int !Int -- ^ Column, then row-  | NoCursor---- | Set a single cell's value (column, then row).------ @since 0.1.0-set :: Int -> Int -> Termbox.Cell -> Cells-set x y z =-  Cells (Termbox.set x y z)+type TermboxEvent =+  Termbox.Event -type EventSource a-  = (AddHandler a, a -> IO ())+type EventSource a =+  (AddHandler a, a -> IO ())  -- | Run a @termbox@ program with the specified input and output modes. --@@ -117,20 +82,14 @@ -- * 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.------ @since 0.2.0-run-  :: Termbox.InputMode -- ^-  -> Termbox.OutputMode -- ^-  -> (  Event TermboxEvent-     -> Behavior (Int, Int)-     -> MomentIO (Behavior Scene, Event a))-  -> IO (Either Termbox.InitError a)-run imode omode program =-  Termbox.run $ do-    Termbox.setInputMode imode-    Termbox.setOutputMode omode-+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 @@ -142,69 +101,47 @@         eEvent :: Event TermboxEvent <-           fromAddHandler eventAddHandler -        let-          eResize :: Event (Int, Int)-          eResize =-            filterJust-              ((\case-                Termbox.EventResize w h -> Just (w, h)-                _ -> Nothing)-              <$> eEvent)+        let eResize :: Event (Int, Int)+            eResize =+              filterJust+                ( ( \case+                      Termbox.EventResize w h -> Just (w, h)+                      _ -> Nothing+                  )+                    <$> eEvent+                )          bSize :: Behavior (Int, Int) <--          flip stepper eResize =<<-            liftIO Termbox.getSize+          flip stepper eResize (width, height) -        moment program eEvent bSize (putMVar doneVar)+        moment (uncurry render) program eEvent bSize (putMVar doneVar)      actuate network      fix $ \loop -> do-      Termbox.poll >>= fireEvent-      tryReadMVar doneVar >>=-        maybe loop pure---- | Like 'run', but throws 'Termbox.InitError's as @IO@ exceptions.------ @since 0.2.0-run_-  :: Termbox.InputMode -- ^-  -> Termbox.OutputMode -- ^-  -> (  Event TermboxEvent-     -> Behavior (Int, Int)-     -> MomentIO (Behavior Scene, Event a))-  -> IO a-run_ imode omode program =-  run imode omode program >>= either throwIO pure+      poll >>= fireEvent+      tryReadMVar doneVar >>= maybe loop pure -moment-  :: (  Event TermboxEvent-     -> Behavior (Int, Int)-     -> MomentIO (Behavior Scene, Event a))-  -> Event TermboxEvent-  -> Behavior (Int, Int)-  -> (a -> IO ())-  -> MomentIO ()-moment program eEvent bSize abort = do-  (bScene, eDone) :: (Behavior Scene, Event a) <-+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 Scene) <-+  eScene :: Event (Future (Termbox.Cells, Termbox.Cursor)) <-     changes bScene -  let-    render :: Scene -> IO ()-    render (Scene (Cells cells) cursor) = do-      Termbox.clear mempty mempty-      cells-      case cursor of-        Cursor c r -> Termbox.setCursor c r-        NoCursor -> Termbox.hideCursor-      Termbox.flush-   liftIO . render =<< valueB bScene   reactimate (abort <$> eDone)-  reactimate' ((fmap.fmap) render eScene)+  reactimate' ((fmap . fmap) render eScene)  -- $example --@@ -224,15 +161,12 @@ -- -- main :: IO () -- main =---   Termbox.'run_'---     (Termbox.'Termbox.InputModeEsc' Termbox.'Termbox.MouseModeNo')---     Termbox.'Termbox.OutputModeNormal'---     moment+--   Termbox.'run' moment -- -- moment --   :: Event Termbox.'Termbox.Event' --   -> Behavior (Int, Int)---   -> MomentIO (Behavior Termbox.'Termbox.Scene', Event ())+--   -> MomentIO (Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor'), Event ()) -- moment eEvent _bSize = do --   let --     eQuit :: Event ()@@ -250,9 +184,9 @@ --       maybe mempty renderEvent \<$\> bLatestEvent -- --   let---     bScene :: Behavior Termbox.'Termbox.Scene'+--     bScene :: Behavior (Termbox.'Termbox.Cells', Termbox.'Termbox.Cursor') --     bScene =---       Termbox.'Termbox.Scene'+--       (,) --         \<$\> bCells --         \<*\> pure Termbox.'Termbox.NoCursor' --

@@ -1,7 +1,7 @@ cabal-version: 2.4  name: termbox-banana-version: 0.2.0+version: 0.3.0 category: User Interfaces description:   A @reactive-banana@-based interface to writing @termbox@ programs.@@ -23,99 +23,79 @@ maintainer: Mitchell Rosen <mitchellwrosen@gmail.com> homepage: https://github.com/mitchellwrosen/termbox-banana bug-reports: https://github.com/mitchellwrosen/termbox-banana/issues-copyright: (c) 2018-2019, Mitchell Rosen+copyright: (c) 2018-2020, Mitchell Rosen license: BSD-3-Clause license-file: LICENSE build-type: Simple-tested-with: GHC == 8.4.4, GHC == 8.6.5  extra-source-files:-  .travis.yml   CHANGELOG.md   README.md +source-repository head+  type: git+  location: git://github.com/mitchellwrosen/termbox-banana.git+ flag build-examples   description: Build example executables   default: False   manual: True -library-  build-depends:-      base ^>= 4.10 || ^>= 4.11 || ^>= 4.12-    , reactive-banana ^>= 1.2-    , termbox ^>= 0.2--  default-language:-    Haskell2010--  exposed-modules:-    Termbox.Banana-+common component+  default-extensions:+    GeneralizedNewtypeDeriving+    InstanceSigs+    LambdaCase+  default-language: Haskell2010   ghc-options:-    -Wall-    -Wcompat-    -Widentities-    -Wincomplete-record-updates-    -Wincomplete-uni-patterns-    -Wmissing-export-lists-    -Wnoncanonical-monad-instances-    -Wnoncanonical-monadfail-instances-    -Wpartial-fields-    -Wredundant-constraints-    -fprint-expanded-synonyms-    -fprint-explicit-foralls-    -fprint-explicit-kinds-    -fprint-unicode-syntax--  hs-source-dirs:-    src+    -Weverything+    -Wno-implicit-prelude+    -Wno-missing-import-lists+    -Wno-missing-local-signatures+    -Wno-monomorphism-restriction+    -Wno-safe+    -Wno-unsafe+  if impl(ghc >= 8.10)+    ghc-options:+      -Wno-missing-safe-haskell-mode+      -Wno-prepositive-qualified-module -executable termbox-banana-example-echo+common example-executable+  import: component   if !flag(build-examples)     buildable: False-   build-depends:     base,     reactive-banana,     termbox-banana,--  default-language:-    Haskell2010--  ghc-options:-    -Wall -threaded "-with-rtsopts=-N"+  ghc-options: -Wall -threaded "-with-rtsopts=-N"+  hs-source-dirs: examples -  hs-source-dirs:-    examples+library+  import: component+  build-depends:+      base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14+    , reactive-banana ^>= 1.2+    , termbox ^>= 0.3+  exposed-modules: Termbox.Banana+  hs-source-dirs: src -  main-is:-    Echo.hs+executable termbox-banana-example-echo+  import: example-executable+  ghc-options: -Wall -threaded "-with-rtsopts=-N"+  main-is: Echo.hs  executable termbox-banana-example-hoogle+  import: example-executable   if !flag(build-examples)     buildable: False-   build-depends:     aeson,     async,-    base,     http-conduit,     lens,     lens-aeson,     mtl,-    reactive-banana,     stm,     tagsoup,-    termbox-banana,--  default-language:-    Haskell2010--  ghc-options:-    -Wall -threaded "-with-rtsopts=-N"--  hs-source-dirs:-    examples--  main-is:-    Hoogle.hs+  main-is: Hoogle.hs