termbox-banana 0.3.0 → 0.3.1
raw patch · 5 files changed
+17/−452 lines, 5 filesdep −aesondep −asyncdep −http-conduitdep ~basedep ~reactive-bananaPVP ok
version bump matches the API change (PVP)
Dependencies removed: aeson, async, http-conduit, lens, lens-aeson, mtl, stm, tagsoup, termbox-banana
Dependency ranges changed: base, reactive-banana
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−8
- README.md +4/−2
- examples/Echo.hs +0/−49
- examples/Hoogle.hs +0/−336
- termbox-banana.cabal +9/−57
CHANGELOG.md view
@@ -5,31 +5,27 @@ 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.1] - 2022-04-02++- Removed example executables+ ## [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 - Added `run`--### Changed - Renamed `main` to `run_` - Bumped `termbox` lower bound ## [0.1.1] - 2019-04-19 -### Changed - Removed unnecessary `stm` dependency - Bumped `base` upper bound ## [0.1.0] - 2018-07-22 -### Added - Initial release
README.md view
@@ -1,4 +1,6 @@ # `termbox-banana` -[](https://travis-ci.org/mitchellwrosen/termbox-banana)-+[](https://github.com/mitchellwrosen/termbox-banana/actions)+[](https://hackage.haskell.org/package/termbox-banana)+[](https://www.stackage.org/lts/package/termbox-banana)+[](https://www.stackage.org/nightly/package/termbox-banana)
− examples/Echo.hs
@@ -1,49 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Reactive.Banana-import Reactive.Banana.Frameworks-import qualified Termbox.Banana as Termbox--main :: IO ()-main =- Termbox.run moment--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-- bLatestEvent :: Behavior (Maybe Termbox.Event) <-- stepper- Nothing- (Just <$> eEvent)-- let bCells :: Behavior Termbox.Cells- bCells =- maybe mempty renderEvent <$> bLatestEvent-- 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 ..]- . show--isKeyEsc :: Termbox.Event -> Bool-isKeyEsc = \case- Termbox.EventKey Termbox.KeyEsc -> True- _ -> False
− examples/Hoogle.hs
@@ -1,336 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecursiveDo #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main where--import Control.Concurrent-import Control.Concurrent.Async-import Control.Concurrent.STM-import Control.Exception (SomeException)-import Control.Lens-import Control.Monad-import Control.Monad.State.Strict-import Control.Monad.Writer.Strict-import Data.Aeson (Value)-import Data.Aeson.Lens-import Data.Foldable (fold, for_)-import Data.Maybe-import Data.String (fromString)-import Data.Text.Lens (unpacked)-import Network.HTTP.Simple-import Reactive.Banana-import Reactive.Banana.Frameworks-import qualified Termbox.Banana as Termbox-import Text.HTML.TagSoup--main :: IO ()-main =- Termbox.run moment--moment ::- Event Termbox.Event ->- Behavior (Int, Int) ->- MomentIO (Behavior (Termbox.Cells, Termbox.Cursor), Event ())-moment eEvent bSize = mdo- eTick :: Event () <-- makeTickEvent-- requestQueue :: TQueue String <-- liftIO newTQueueIO-- eSearchBox :: Event String <-- makeSearchBoxEvent eKey-- reactimate ((atomically . writeTQueue requestQueue . reverse) <$> eSearchBox)-- let eEmptySearchBox :: Event String- eEmptySearchBox =- filterE null eSearchBox-- bSearchBox :: Behavior String <-- stepper "" eSearchBox-- (eSearchResults, fireSearchResults) <-- newEvent-- liftIO . void . forkIO $- runHttpRequestThread- requestQueue- fireSearchResults-- bSearchResults :: Behavior (Either SomeException [Value]) <-- stepper- (Right [])- ( 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- ]- )-- 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 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--makeTickEvent :: MomentIO (Event ())-makeTickEvent = do- (e, f) <- newEvent- liftIO . void . forkIO . forever $ do- f ()- threadDelay 100000- pure e--makeSearchBoxEvent ::- MonadMoment m =>- Event Termbox.Key ->- m (Event String)-makeSearchBoxEvent eKey =- accumE- ""- ( unions- [ (:) <$> filterJust (keyAsChar <$> eKey),- (' ' :) <$ filterE (== Termbox.KeySpace) eKey,- safeTail <$ filterE (== Termbox.KeyCtrl8) eKey- ]- )--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- pure $ do- respond response- loop Nothing- )--render ::- Int ->- String ->- Either SomeException [Value] ->- Maybe Int ->- Termbox.Cells-render height searchBox searchResults spinnerFrame =- fold- [ case searchResults of- Left ex ->- renderSearchResultsError height ex- Right results ->- renderSearchResults height results- & execWriterT- & (`evalState` 0),- renderSearchBox height searchBox spinnerFrame- ]--renderSearchBox :: Int -> String -> Maybe Int -> Termbox.Cells-renderSearchBox height searchBox spinnerFrame =- 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)--renderSearchResults ::- Int ->- [Value] ->- WriterT Termbox.Cells (State Int) ()-renderSearchResults height = \case- [] ->- pure ()- result : results -> do- row <- get-- let ss = searchResultToLines result-- 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 height ex =- ex- & show- & lines- & take height- & zip [0 ..]- & foldMap (\(row, line) -> renderString 0 row line)--searchResultToLines :: Value -> [String]-searchResultToLines result =- case result ^?! key "type" of- "" ->- unwords- [ "[" ++ resultPackage result ++ "]",- "[" ++ resultModule result ++ "]",- resultItem result- ]- : map (" " ++) (resultDocs result)- "module" ->- unwords- [ "[" ++ resultPackage result ++ "]",- "[" ++ drop 7 (resultItem result) ++ "]"- ]- : map (" " ++) (resultDocs result)- "package" ->- ("[" ++ drop 8 (resultItem result) ++ "]")- : map (" " ++) (resultDocs result)- _ ->- error (show result)--resultPackage :: Value -> String-resultPackage result =- result- ^?! key "package"- . key "name"- . _String- . unpacked--resultModule :: Value -> String-resultModule result =- result- ^?! key "module"- . key "name"- . _String- . unpacked--resultItem :: Value -> String-resultItem result =- result- ^?! key "item"- . _String- . unpacked- . to htmlToText--resultDocs :: Value -> [String]-resultDocs result =- result- ^?! key "docs"- . _String- . unpacked- . to htmlToText- . to lines- . to collapseLines- where- collapseLines :: [String] -> [String]- collapseLines = \case- [] ->- []- [""] ->- []- "" : ss ->- case collapseLines ss of- "" : ts -> "" : ts- ts -> "" : ts- s : ss ->- s : collapseLines ss--htmlToText :: String -> String-htmlToText html =- concat $ do- 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 ..]--performHoogleSearch :: String -> IO [Value]-performHoogleSearch query =- getResponseBody <$> httpJSON (fromString searchUrl)- where- searchUrl :: String- searchUrl =- "https://hoogle.haskell.org?mode=json&count=10&hoogle=" ++ query--eventAsKey :: Termbox.Event -> Maybe Termbox.Key-eventAsKey = \case- Termbox.EventKey k -> Just k- _ -> Nothing--keyAsChar :: Termbox.Key -> Maybe Char-keyAsChar = \case- Termbox.KeyChar c -> Just c- _ -> Nothing--safeTail :: [a] -> [a]-safeTail = \case- [] -> []- _ : xs -> xs
termbox-banana.cabal view
@@ -1,32 +1,23 @@ cabal-version: 2.4 name: termbox-banana-version: 0.3.0+version: 0.3.1 category: User Interfaces description: A @reactive-banana@-based interface to writing @termbox@ programs. . See also the <https://hackage.haskell.org/termbox termbox> package for a lower-level, imperative interface.- .- __/NOTE/__: The dependencies listed on Hackage are misleading! Most are only- used in the examples provided, which are built only if the @build-examples@- flag is explicitly enabled.- .- The actual dependencies of the @termbox-banana@ library are only:- .- * base- * reactive-banana- * termbox synopsis: reactive-banana + termbox author: Mitchell Rosen 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-2020, Mitchell Rosen+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 extra-source-files: CHANGELOG.md@@ -36,17 +27,17 @@ type: git location: git://github.com/mitchellwrosen/termbox-banana.git -flag build-examples- description: Build example executables- default: False- manual: True--common component+library+ build-depends:+ base ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16,+ reactive-banana ^>= 1.2 || ^>= 1.3,+ termbox ^>= 0.3, default-extensions: GeneralizedNewtypeDeriving InstanceSigs LambdaCase default-language: Haskell2010+ exposed-modules: Termbox.Banana ghc-options: -Weverything -Wno-implicit-prelude@@ -59,43 +50,4 @@ ghc-options: -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module--common example-executable- import: component- if !flag(build-examples)- buildable: False- build-depends:- base,- reactive-banana,- termbox-banana,- ghc-options: -Wall -threaded "-with-rtsopts=-N"- 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--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,- http-conduit,- lens,- lens-aeson,- mtl,- stm,- tagsoup,- main-is: Hoogle.hs