termbox 0.1.0 → 0.2.0

raw patch · 8 files changed

+399/−213 lines, 8 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .hlint.yaml +61/−0
• .travis.yml +113/−66
• CHANGELOG.md +15/−0
• README.md +4/−0
• Setup.hs +0/−2
• examples/Colors.hs +25/−11
• src/Termbox.hs +165/−128
• termbox.cabal +16/−6

@@ -0,0 +1,61 @@+# HLint configuration file+# https://github.com/ndmitchell/hlint+##########################++# This file contains a template configuration file, which is typically+# placed as .hlint.yaml in the root of your project+++# Specify additional command line arguments+#+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]+++# Control which extensions/flags/modules/functions can be used+#+# - extensions:+#   - default: false # all extension are banned by default+#   - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used+#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module+#+# - flags:+#   - {name: -w, within: []} # -w is allowed nowhere+#+# - modules:+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely+#+# - functions:+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules+++# Add custom hints for this project+#+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}+++# Turn on hints that are off by default+#+# Ban "module X(module X) where", to require a real export list+# - warn: {name: Use explicit module export list}+#+# Replace a $ b $ c with a . b $ c+# - group: {name: dollar, enabled: true}+#+# Generalise map to fmap, ++ to <>+# - group: {name: generalise, enabled: true}+++# Ignore some builtin hints+# - ignore: {name: Use let}+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules+- ignore: {name: Use String}+++# Define some custom infix operators+# - fixity: infixr 3 ~^#^~+++# To generate a suitable file for HLint do:+# $ hlint --default > .hlint.yaml

@@ -1,94 +1,141 @@ # This Travis job script has been generated by a script via #-#   runghc make_travis_yml_2.hs 'cabal.project'+#   haskell-ci 'termbox.cabal' #-# For more information, see https://github.com/hvr/multi-ghc-travis+# For more information, see https://github.com/haskell-CI/haskell-ci #+# version: 0.3.20190521+# language: c-sudo: false-+dist: xenial git:-  submodules: false  # whether to recursively clone submodules-+  # whether to recursively clone submodules+  submodules: false cache:   directories:     - $HOME/.cabal/packages     - $HOME/.cabal/store- before_cache:-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+  - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log   # remove files that are regenerated by 'cabal update'-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx--  - rm -rfv $HOME/.cabal/packages/head.hackage-+  - 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.0.2"-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}-    - compiler: "ghc-8.2.2"-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}-    - compiler: "ghc-8.4.3"-      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.3], sources: [hvr-ghc]}}-+    - 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"]}}+    - compiler: ghc-8.2.2+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}+    - compiler: ghc-8.0.2+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}} before_install:-  - HC=${CC}-  - HCPKG=${HC/ghc/ghc-pkg}+  - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')+  - HCPKG="$HC-pkg"   - unset CC-  - ROOTDIR=$(pwd)-  - mkdir -p $HOME/.local/bin-  - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"+  - 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+  - ${CABAL} --version   - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"-  - BENCH=${BENCH---enable-benchmarks}-  - TEST=${TEST---enable-tests}-  - HADDOCK=${HADDOCK-true}-  - INSTALLED=${INSTALLED-true}+  - TEST=--enable-tests+  - BENCH=--enable-benchmarks   - GHCHEAD=${GHCHEAD-false}-  - travis_retry cabal update -v-  - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"-  - rm -fv cabal.project cabal.project.local-  - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'-  - "printf 'packages: \".\"\\n' > cabal.project"-  - cat cabal.project-  - if [ -f "./configure.ac" ]; then-      (cd "." && autoreconf -i);-    fi-  - rm -f cabal.project.freeze-  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2-  - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2-  - rm -rf .ghc.environment.* "."/dist-  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)--# Here starts the actual work to be performed for the package under test;-# any command which exits with a non-zero exit code causes the build to fail.+  - 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)$' || 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:-  # test that source-distributions can be generated-  - (cd "." && cabal sdist)-  - mv "."/dist/termbox-*.tar.gz ${DISTDIR}/+  - 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 '{}' \;-  - "printf 'packages: termbox-*/*.cabal\\n' > cabal.project"-  - cat cabal.project+  # Generate cabal.project+  - rm -rf cabal.project cabal.project.local cabal.project.freeze+  - touch cabal.project+  - |+    echo 'packages: "termbox-*/*.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)$' || 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 new-build -w ${HC} --disable-tests --disable-benchmarks all--  # Build with installed constraints for packages in global-db-  - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi-+  - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output+  # Building with tests and benchmarks...   # build & run tests, build benchmarks-  - cabal new-build -w ${HC} ${TEST} ${BENCH} all--  # cabal check-  - (cd termbox-* && cabal check)+  - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+  # cabal check...+  - (cd termbox-* && ${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 ["cabal.project"]+# REGENDATA ["termbox.cabal"] # EOF

@@ -5,6 +5,21 @@ 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.2.0] - 2019-06-21++### Added+- `getCells` function+- `run` function++### Changed+- Renamed `size` to `getSize`+- Renamed `main` to `run_` and return errors as an `Either` instead of throwing.+- Made `Attr`'s `Semigroup` instance right-biased instead of left-biased.+- Made `Attr`'s `Num` instance total.++### Removed+- `buffer` function+ ## [0.1.0] - 2018-07-18  ### Added

@@ -0,0 +1,4 @@+# `termbox`++[![Build Status](https://travis-ci.org/mitchellwrosen/termbox.svg?branch=master)](https://travis-ci.org/mitchellwrosen/termbox)+![Hackage](https://img.shields.io/hackage/v/termbox.svg)

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,17 +1,13 @@ -- | Something like https://github.com/nsf/termbox/blob/8b72969ff4bba120d8b8e4a29bae07102ed71055/src/demo/output.c -{-# language LambdaCase #-}- import Control.Monad import Data.Foldable  import qualified Termbox as Tb -main :: IO ()-main = do-  Tb.main $ do-    clear-+main :: IO (Either Tb.InitError ())+main =+  Tb.run $ do     do       let         rectangles :: [(Int, Int, Int, Int)]@@ -85,22 +81,40 @@     Tb.flush     _ <- Tb.poll +    clear+    Tb.setOutputMode Tb.OutputMode256++    do+      let+        rectangles :: [(Int, Int, Int, Int)]+        rectangles = do+          y0 <- [0, 2..]+          x0 <- [0, 4 .. 48]+          pure (x0, y0, x0+3, y0+1)++      zipWithM_+        (\(x0, y0, x1, y1) n -> do+          rectangle x0 y0 x1 y1 (Tb.Cell ' ' mempty (fromInteger n))+          string x0 y0 2 (fromInteger n) (show n))+        rectangles+        [1..255]++    Tb.flush+    _ <- Tb.poll+     pure ()  clear :: IO () clear = do-  mode <- Tb.getOutputMode   Tb.setOutputMode Tb.OutputModeNormal   Tb.clear mempty mempty   Tb.flush-  Tb.setOutputMode mode  string :: Int -> Int -> Tb.Attr -> Tb.Attr -> [Char] -> IO ()-string x0 y fg bg cs =+string x0 y fg bg =   zipWithM_     (\x c -> Tb.set x y (Tb.Cell c fg bg))     [x0..]-    cs  rectangle :: Int -> Int -> Int -> Int -> Tb.Cell -> IO () rectangle x0 y0 x1 y1 c =

@@ -1,36 +1,79 @@ {-# language InstanceSigs        #-} {-# language LambdaCase          #-} {-# language RankNTypes          #-}-{-# language RecordWildCards     #-}+ {-# language ScopedTypeVariables #-} {-# language TypeFamilies        #-} {-# language UnicodeSyntax       #-} +-- |+-- A @termbox@ program is typically constructed as an infinite loop that:+--+-- 1. 'clear's the terminal backbuffer.+-- 2. Renders the program state by 'set'ting individual pixels.+-- 3. 'flush'es the backbuffer to the terminal.+-- 4. 'poll's for an event to update the program state.+--+-- For example, this progam simply displays the number of keys pressed, and+-- quits on @Esc@:+--+-- @+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Data.Foldable (for_)+-- import qualified Termbox+--+-- main :: IO ()+-- main =+--   Termbox.'run_' (loop 0)+--+-- loop :: Int -> IO ()+-- loop n = do+--   Termbox.'clear' mempty mempty+--   render n+--   Termbox.'flush'+--+--   Termbox.'poll' >>= \\case+--     Termbox.'EventKey' Termbox.'KeyEsc' _ ->+--       pure ()+--     _ ->+--       loop (n+1)+--+-- render :: Int -> IO ()+-- render n =+--   for_+--     (zip [0..] (show n))+--     (\\(i, c) ->+--       Termbox.'set' i 0 (Termbox.'Cell' c mempty mempty))+-- @+--+-- Other termbox features include cell attributes (style, color), cursor+-- display, and mouse click handling.+--+-- This module is intended to be imported qualified. module Termbox-  ( -- $intro--    -- * Initialization-    main+  ( -- * Initialization+    run+  , run_   , InitError(..)     -- * Terminal contents-  , Cell(..)   , set-  , buffer+  , getCells   , clear   , flush+  , Cell(..)     -- * Terminal size-  , size+  , getSize     -- * Cursor manipulation   , setCursor   , hideCursor     -- * Event handling+  , poll   , Event(..)   , Key(..)   , Mouse(..)-  , poll   , PollError(..)     -- * Attributes-  , Attr   , black   , red   , green@@ -42,14 +85,15 @@   , bold   , underline   , reverse+  , Attr     -- * Terminal modes-  , InputMode(..)-  , MouseMode(..)   , getInputMode   , setInputMode-  , OutputMode(..)+  , InputMode(..)+  , MouseMode(..)   , getOutputMode   , setOutputMode+  , OutputMode(..)   ) where  import Prelude hiding (mod, reverse)@@ -57,8 +101,8 @@ import qualified Termbox.Internal as Tb  import Control.Exception-import Control.Monad (join)-import Data.Array.Storable+import Control.Monad ((>=>), join)+import Data.Array (Array) import Data.Bits ((.|.), (.&.)) import Data.Functor (void) import Data.Semigroup (Semigroup(..))@@ -66,21 +110,16 @@ import Foreign (ForeignPtr, Ptr, newForeignPtr_) import Foreign.Marshal.Alloc (alloca) import Foreign.Storable+import GHC.Stack +import qualified Data.Array.Storable as Array (freeze) import qualified Data.Array.Storable.Internals as Array --- $intro--- This module is intended to be imported qualified.------ @--- import qualified Termbox--- @- -------------------------------------------------------------------------------- -- Initialization -------------------------------------------------------------------------------- --- | Initialization errors that can be thrown by 'main'.+-- | Termbox initialization errors that can be returned by 'run'. data InitError   = FailedToOpenTTY   | PipeTrapError@@ -89,33 +128,42 @@  instance Exception InitError --- | Run a @termbox@ program and restore the terminal state afterwards. May--- throw an 'InitError' exception.-main :: IO a -> IO a-main =-  bracket_-    (Tb.init >>= \case-      Tb.InitOk -> pure ()-      Tb.FailedToOpenTTY -> throwIO FailedToOpenTTY-      Tb.PipeTrapError -> throwIO PipeTrapError-      Tb.UnsupportedTerminal -> throwIO UnsupportedTerminal)-    Tb.shutdown+-- | Run a @termbox@ program and restore the terminal state afterwards.+run :: IO a -> IO (Either InitError a)+run action =+  mask $ \unmask ->+    Tb.init >>= \case+      Tb.InitOk -> do+        result <- unmask action `onException` Tb.shutdown+        Tb.shutdown+        pure (Right result) +      Tb.FailedToOpenTTY     -> pure (Left FailedToOpenTTY)+      Tb.PipeTrapError       -> pure (Left PipeTrapError)+      Tb.UnsupportedTerminal -> pure (Left UnsupportedTerminal)++-- | Like 'run', but throws 'InitError's as @IO@ exceptions.+run_ :: IO a -> IO a+run_ =+  run >=> either throwIO pure++ -------------------------------------------------------------------------------- -- Terminal size -------------------------------------------------------------------------------- --- | Get the terminal width and height.-size :: (width ~ Int, height ~ Int) => IO (width, height)-size =+-- | Get the terminal size (width, then height).+getSize :: IO (Int, Int)+getSize =   (,) <$> Tb.width <*> Tb.height + -------------------------------------------------------------------------------- -- Cursor -------------------------------------------------------------------------------- --- | Set the cursor coordinates.-setCursor :: (col ~ Int, row ~ Int) => col -> row -> IO ()+-- | Set the cursor coordinates (column, then row).+setCursor :: Int -> Int -> IO () setCursor =   Tb.setCursor @@ -124,6 +172,7 @@ hideCursor =   Tb.setCursor Tb._HIDE_CURSOR Tb._HIDE_CURSOR + -------------------------------------------------------------------------------- -- Terminal contents --------------------------------------------------------------------------------@@ -161,34 +210,32 @@     Tb.setCellFg ptr (attrToWord fg)     Tb.setCellBg ptr (attrToWord bg) --- | Set the 'Cell' at the given coordinates.-set :: (col ~ Int, row ~ Int) => col -> row -> Cell -> IO ()+-- | Set the cell at the given coordinates (column, then row).+set :: Int -> Int -> Cell -> IO () set x y (Cell ch fg bg) =   Tb.changeCell x y ch (attrToWord fg) (attrToWord bg) --- | Get the terminal's internal back buffer as a two-dimensional array of--- 'Cell's indexed by their coordinates.------ /Warning/: the data is only valid until the next call to 'clear' or--- 'flush'.-buffer :: (row ~ Int, col ~ Int) => IO (StorableArray (row, col) Cell)-buffer =+-- | Get the terminal's two-dimensional array of cells (indexed by row, then+-- column).+getCells :: IO (Array (Int, Int) Cell)+getCells =   join     (mkbuffer       <$> (tb_cell_buffer >>= newForeignPtr_)       <*> Tb.width       <*> Tb.height)- where-  mkbuffer-    :: ForeignPtr Cell-    -> Int-    -> Int-    -> IO (StorableArray (Int, Int) Cell)-  mkbuffer buff w h =-    Array.unsafeForeignPtrToStorableArray buff ((0, 0), (h-1, w-1))+  where+    mkbuffer+      :: ForeignPtr Cell+      -> Int+      -> Int+      -> IO (Array (Int, Int) Cell)+    mkbuffer buff w h =+      Array.freeze =<<+        Array.unsafeForeignPtrToStorableArray buff ((0, 0), (h-1, w-1))  -- | Clear the back buffer with the given foreground and background attributes.-clear :: (fg ~ Attr, bg ~ Attr) => fg -> bg -> IO ()+clear :: Attr -> Attr -> IO () clear fg bg = do   Tb.setClearAttributes (attrToWord fg) (attrToWord bg)   Tb.clear@@ -225,29 +272,29 @@   deriving (Eq, Ord, Show)  -- | Get the current input mode.-getInputMode :: IO InputMode+getInputMode :: HasCallStack => IO InputMode getInputMode =   f <$> Tb.selectInputMode Tb._INPUT_CURRENT- where-  f :: Int -> InputMode-  f = \case-    1 -> InputModeEsc MouseModeNo-    2 -> InputModeAlt MouseModeNo-    5 -> InputModeEsc MouseModeYes-    6 -> InputModeAlt MouseModeYes-    n -> error ("getInputMode: " ++ show n)+  where+    f :: Int -> InputMode+    f = \case+      1 -> InputModeEsc MouseModeNo+      2 -> InputModeAlt MouseModeNo+      5 -> InputModeEsc MouseModeYes+      6 -> InputModeAlt MouseModeYes+      n -> error (show n)  -- | Set the input mode. setInputMode :: InputMode -> IO () setInputMode =   void . Tb.selectInputMode . f- where-  f :: InputMode -> Int-  f = \case-    InputModeEsc MouseModeNo -> Tb._INPUT_ESC-    InputModeEsc MouseModeYes -> Tb._INPUT_ESC .|. Tb._INPUT_MOUSE-    InputModeAlt MouseModeNo -> Tb._INPUT_ALT-    InputModeAlt MouseModeYes -> Tb._INPUT_ALT .|. Tb._INPUT_MOUSE+  where+    f :: InputMode -> Int+    f = \case+      InputModeEsc MouseModeNo -> Tb._INPUT_ESC+      InputModeEsc MouseModeYes -> Tb._INPUT_ESC .|. Tb._INPUT_MOUSE+      InputModeAlt MouseModeNo -> Tb._INPUT_ALT+      InputModeAlt MouseModeYes -> Tb._INPUT_ALT .|. Tb._INPUT_MOUSE  -- | The output modes. --@@ -267,29 +314,29 @@   deriving (Eq, Ord, Show)  -- | Get the current output mode.-getOutputMode :: IO OutputMode+getOutputMode :: HasCallStack => IO OutputMode getOutputMode =   f <$> Tb.selectOutputMode Tb.OutputModeCurrent- where-  f :: Tb.OutputMode -> OutputMode-  f = \case-    Tb.OutputModeNormal -> OutputModeNormal-    Tb.OutputMode256 -> OutputMode256-    Tb.OutputMode216 -> OutputMode216-    Tb.OutputModeGrayscale -> OutputModeGrayscale-    Tb.OutputModeCurrent -> error "getOutputMode: OutputModeCurrent"+  where+    f :: Tb.OutputMode -> OutputMode+    f = \case+      Tb.OutputModeNormal -> OutputModeNormal+      Tb.OutputMode256 -> OutputMode256+      Tb.OutputMode216 -> OutputMode216+      Tb.OutputModeGrayscale -> OutputModeGrayscale+      Tb.OutputModeCurrent -> error "OutputModeCurrent"  -- | Set the output mode. setOutputMode :: OutputMode -> IO () setOutputMode =   void . Tb.selectOutputMode . f- where-  f :: OutputMode -> Tb.OutputMode-  f = \case-    OutputModeNormal -> Tb.OutputModeNormal-    OutputMode256 -> Tb.OutputMode256-    OutputMode216 -> Tb.OutputMode216-    OutputModeGrayscale -> Tb.OutputModeGrayscale+  where+    f :: OutputMode -> Tb.OutputMode+    f = \case+      OutputModeNormal -> Tb.OutputModeNormal+      OutputMode256 -> Tb.OutputMode256+      OutputMode216 -> Tb.OutputMode216+      OutputModeGrayscale -> Tb.OutputModeGrayscale  -------------------------------------------------------------------------------- -- Event handling@@ -394,8 +441,7 @@ -- @threaded@ runtime, or simply writing event-handling code that is responsive -- to intuitive "quit" keys like @q@ and @Esc@. ----- This function may throw a 'PollError' exception under mysterious--- circumstances that are not well-documented in the original C codebase.+-- /Throws/: 'PollError' poll :: IO Event poll =   alloca $ \ptr ->@@ -405,7 +451,8 @@       _ ->         parseEvent <$> peek ptr --- | An error occurred when 'poll'ing.+-- | An error occurred when 'poll'ing, due to mysterious circumstances that are+-- not well-documented in the original C codebase. data PollError   = PollError   deriving Show@@ -426,21 +473,21 @@ parseEventKey :: Tb.Mod -> Tb.Key -> Char -> Event parseEventKey mod key ch =   EventKey key' alt- where-  key' :: Key-  key' =-    case ch of-      '\0' -> parseKey key-      _ -> KeyChar ch+  where+    key' :: Key+    key' =+      case ch of+        '\0' -> parseKey key+        _ -> KeyChar ch -  alt :: Bool-  alt =-    case mod of-      Tb.ModAlt -> True-      _ -> False+    alt :: Bool+    alt =+      case mod of+        Tb.ModAlt -> True+        _ -> False  -- | Parse a 'Key' from a 'Tb.Key'.-parseKey :: Tb.Key -> Key+parseKey :: HasCallStack => Tb.Key -> Key parseKey = \case   Tb.KeyArrowDown -> KeyArrowDown   Tb.KeyArrowLeft -> KeyArrowLeft@@ -509,10 +556,10 @@   Tb.KeyPageUp -> KeyPageUp   Tb.KeySpace -> KeySpace   Tb.KeyTab -> KeyTab-  key -> error ("parseKey: " ++ show key)+  key -> error (show key)  -- | Parse a 'Mouse' from a 'Tb.Key'.-parseMouse :: Tb.Key -> Mouse+parseMouse :: HasCallStack => Tb.Key -> Mouse parseMouse = \case   Tb.KeyMouseLeft -> MouseLeft   Tb.KeyMouseMiddle -> MouseMiddle@@ -520,7 +567,7 @@   Tb.KeyMouseRight -> MouseRight   Tb.KeyMouseWheelDown -> MouseWheelDown   Tb.KeyMouseWheelUp -> MouseWheelUp-  key -> error ("parseMouse: " ++ show key)+  key -> error (show key)  -------------------------------------------------------------------------------- -- Attributes@@ -530,15 +577,8 @@ -- bold, underlined, and/or reversed. -- -- A cell can only have one color, but may be (for example) bold /and/--- underlined. The 'Monoid' instance combines 'Attr's this way, with a left--- bias. That is,------ @--- red <> bold <> black <> underline = red <> bold <> underline--- @------ /Warning/: the 'Num' instance is /very partial/! It only includes an--- implementation of 'fromInteger', for numeric literals.+-- underlined. The 'Monoid' instance combines 'Attr's this way, with a right+-- bias. data Attr   = Attr !Word16 {- color -} !Word16 {- attr -}   deriving (Eq)@@ -552,27 +592,24 @@   mappend =     (<>) --- | Only 'fromInteger' is defined.+-- | Provided for numeric literals. instance Num Attr where   fromInteger :: Integer -> Attr-  fromInteger n-    | n >= 0 && n < 256 =-        Attr (fromIntegral n) 0-    | otherwise =-        error ("Attr.fromInteger: " ++ show n ++ " out of range [0..255]")+  fromInteger n =+    Attr (fromIntegral (n `rem` 256)) 0 -  (+) = error ("Attr.(+): not defined")-  (*) = error ("Attr.(*): not defined")-  (-) = error ("Attr.(-): not defined")-  abs = error ("Attr.abs: not defined")-  signum = error ("Attr.signum: not defined")+  (+) = (<>)+  (*) = (<>)+  (-) = (<>)+  abs = id+  signum = id  -- | Left-biased color; attributes are merged. instance Semigroup Attr where   (<>) :: Attr -> Attr -> Attr   Attr  0 ax <> Attr cy ay = Attr cy (ax .|. ay)   Attr cx ax <> Attr  0 ay = Attr cx (ax .|. ay)-  Attr cx ax <> Attr  _ ay = Attr cx (ax .|. ay)+  Attr  _ ax <> Attr cy ay = Attr cy (ax .|. ay)  wordToAttr :: Word16 -> Attr wordToAttr w =

@@ -1,7 +1,7 @@-cabal-version: 2.0+cabal-version: 2.4  name: termbox-version: 0.1.0+version: 0.2.0 category: User Interfaces description:   This package provides a thin wrapper around @termbox v1.1.2@, a simple C@@ -14,22 +14,32 @@ maintainer: Mitchell Rosen <mitchellwrosen@gmail.com> homepage: https://github.com/mitchellwrosen/termbox bug-reports: https://github.com/mitchellwrosen/termbox/issues-copyright: (c) 2018, Mitchell Rosen-license: BSD3+copyright: (c) 2018-2019, Mitchell Rosen+license: BSD-3-Clause license-file: LICENSE build-type: Simple-tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+tested-with:+    GHC == 8.0.2+  , GHC == 8.2.2+  , GHC == 8.4.4+  , GHC == 8.6.5  extra-source-files:+  .hlint.yaml   .travis.yml   cbits/LICENSE   CHANGELOG.md   include/termbox.h+  README.md +source-repository head+  type: git+  location: git://github.com/mitchellwrosen/termbox.git+ library   build-depends:       array-    , base ^>= 4.9 || ^>= 4.10 || ^>= 4.11+    , base ^>= 4.9 || ^>= 4.10 || ^>= 4.11 || ^>= 4.12   build-tool-depends:     c2hs:c2hs   c-sources: