eve-cli (empty) → 0.2.0.0

raw patch · 11 files changed

+428/−0 lines, 11 filesdep +basedep +bytestringdep +evesetup-changed

Dependencies added: base, bytestring, eve, eve-cli, lens, mtl, text, vty

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +52/−0
• Setup.hs +2/−0
• app/Main.hs +16/−0
• eve-cli.cabal +83/−0
• src/Eve/CLI.hs +34/−0
• src/Eve/CLI/Internal/Events.hs +148/−0
• src/Eve/CLI/Internal/Render.hs +30/−0
• src/Eve/CLI/Internal/State.hs +28/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for eve-cli++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Chris Penner (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Penner nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,52 @@+Eve.CLI+=======++Eve.CLI provides [`eve`](https://github.com/ChrisPenner/eve) compatible helpers for building CLI apps.+It allows you to:+- Respond to Keyboard, Mouse, and Resize Events+- Render text/images to your terminal++Here's what it looks like:++```haskell+module Main where++import Eve (eve_, App, exit)+import Eve.CLI (initCLI, onKeypress_, renderImage, Keypress(..))+import qualified Data.Text.Lazy as T+import qualified Graphics.Vty as V+import Control.Monad (void)++main :: IO ()+main = eve_ $ do+  initCLI+  onKeypress_ showKeypress+    where+      -- | Display the last key combination that you pressed on screen+      showKeypress :: Keypress -> App ()+      showKeypress (Keypress V.KEsc _) = exit+      showKeypress keypress = void . renderImage $ V.text V.defAttr . T.pack . show $ keypress+```++Events+------++Eve.CLI is a small wrapper on top of [vty](https://github.com/jtdaugherty/vty); so you'll also need to import+`Graphics.Vty` in order to interact with most events. The following event listeners are provided:++- onEvent+- onKeypress+- onMouseDown+- onMouseUp+- onResize+- onPaste++See the hackage docs for more in depth API documentation.++Rendering+---------++Currently Eve.CLI supports only rendering a+[`Vty.Image`](http://hackage.haskell.org/package/vty-5.21/docs/Graphics-Vty-Image.html);+this means you can use any of `Vty`'s image building combinators, then simply+call `renderImage` with the image you've built.

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

@@ -0,0 +1,16 @@+module Main where++import Eve (eve_, App, exit)+import Eve.CLI (initCLI, onKeypress_, renderImage, Keypress(..))+import qualified Data.Text.Lazy as T+import qualified Graphics.Vty as V+import Control.Monad (void)++main :: IO ()+main = eve_ $ do+  initCLI+  onKeypress_ showKeypress+    where+      showKeypress :: Keypress -> App ()+      showKeypress (Keypress V.KEsc _) = exit+      showKeypress keypress = void . renderImage $ V.text V.defAttr . T.pack . show $ keypress

@@ -0,0 +1,83 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: d5599eb2bd91230335953cf4092cb54e0ce10c0e1636369bb65cb11dd29e551d++name:           eve-cli+version:        0.2.0.0+description:    Please see the README on Github at <https://github.com/ChrisPenner/eve-cli#readme>+homepage:       https://github.com/ChrisPenner/eve-cli#readme+bug-reports:    https://github.com/ChrisPenner/eve-cli/issues+author:         Chris Penner+maintainer:     christopher.penner@gmail.com+copyright:      Chris Penner+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/ChrisPenner/eve-cli++library+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10 && <0.11+    , eve >=0.1 && <0.2+    , lens >=4.16 && <4.17+    , mtl >=2.2 && <2.3+    , text >=1.2 && <1.3+    , vty >=5.20 && <6+  exposed-modules:+      Eve.CLI+      Eve.CLI.Internal.Events+      Eve.CLI.Internal.Render+      Eve.CLI.Internal.State+  other-modules:+      Paths_eve_cli+  default-language: Haskell2010++executable eve-cli-exe+  main-is: Main.hs+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10 && <0.11+    , eve >=0.1 && <0.2+    , eve-cli+    , lens >=4.16 && <4.17+    , mtl >=2.2 && <2.3+    , text >=1.2 && <1.3+    , vty >=5.20 && <6+  other-modules:+      Paths_eve_cli+  default-language: Haskell2010++test-suite eve-cli-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10 && <0.11+    , eve >=0.1 && <0.2+    , eve-cli+    , lens >=4.16 && <4.17+    , mtl >=2.2 && <2.3+    , text >=1.2 && <1.3+    , vty >=5.20 && <6+  other-modules:+      Paths_eve_cli+  default-language: Haskell2010

@@ -0,0 +1,34 @@+module Eve.CLI +  (+  -- * Events+    initCLI+  , onEvent+  , onKeypress+  , onMouseDown+  , onMouseUp+  , onResize+  , onPaste+  , onEvent_+  , onKeypress_+  , onMouseDown_+  , onMouseUp_+  , onResize_+  , onPaste_+  , Keypress(..)+  , MouseDown(..)+  , MouseUp(..)+  , Resize(..)+  , Paste(..)+  , LostFocus(..)+  , GainedFocus(..)++  -- * Rendering+  , renderImage+  , getSize++  , Width+  , Height+  ) where++import Eve.CLI.Internal.Events+import Eve.CLI.Internal.Render

@@ -0,0 +1,148 @@+{-# language RankNTypes #-}+module Eve.CLI.Internal.Events+  ( initCLI+  , onEvent+  , onKeypress+  , onMouseDown+  , onMouseUp+  , onResize+  , onPaste+  , onEvent_+  , onKeypress_+  , onMouseDown_+  , onMouseUp_+  , onResize_+  , onPaste_+  , Keypress(..)+  , MouseDown(..)+  , MouseUp(..)+  , Resize(..)+  , Paste(..)+  , LostFocus(..)+  , GainedFocus(..)+  ) where++import Eve+import Eve.CLI.Internal.State+import Data.ByteString++import Control.Monad+import Control.Monad.Trans+import Data.Typeable++import qualified Graphics.Vty as V++-- | Place initCLI first in your eve initialization block. It registers+-- listeners for terminal events and sets up the renderer+--+-- > main :: IO ()+-- > eve_ $ do+-- >   initCLI+-- >   -- add listeners here+initCLI :: HasEvents s => AppT s IO ()+initCLI = do+  vtyTerminalEvents+  onExit shutdown++-- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states)+shutdown :: HasEvents s => AppT s IO ()+shutdown = do+  v <- getVty+  liftIO $ V.shutdown v++vtyTerminalEvents :: (Typeable m, Typeable m, MonadIO m, HasEvents s) => AppT s m ()+vtyTerminalEvents = do+  v <- getVty+  asyncEventProvider $ dispatchVtyEvents v++dispatchVtyEvents ::  V.Vty -> EventDispatcher -> IO ()+dispatchVtyEvents v dispatch = forever $ do+  evt <- V.nextEvent v+  dispatch evt+  case evt of+    V.EvKey k m -> dispatch (Keypress k m)+    V.EvMouseDown x y button mods -> dispatch (MouseDown x y button mods)+    V.EvMouseUp x y button -> dispatch (MouseUp x y button)+    V.EvResize width height -> dispatch (Resize width height)+    V.EvPaste bytes -> dispatch (Paste bytes)+    V.EvLostFocus ->  dispatch LostFocus+    V.EvGainedFocus ->  dispatch GainedFocus++-- | Type for terminal keypress events+data Keypress = Keypress V.Key [V.Modifier]+  deriving (Eq, Show)++-- | Type for terminal mouse down events+data MouseDown = MouseDown Int Int V.Button [V.Modifier]+  deriving (Eq, Show)++-- | Type for terminal mouse up events+data MouseUp = MouseUp Int Int (Maybe V.Button)+  deriving (Eq, Show)++-- | Type for terminal resize events+data Resize = Resize Int Int+  deriving (Eq, Show)++-- | Type for terminal paste events+data Paste = Paste ByteString+  deriving (Eq, Show)++-- | Type for terminal blur events+data LostFocus = LostFocus+  deriving (Eq, Show)++-- | Type for terminal focus events+data GainedFocus = GainedFocus+  deriving (Eq, Show)++genericListener :: (Typeable evt, Typeable m, MonadIO m, HasEvents s) => (evt -> AppT s m result) -> AppT s m ListenerId+genericListener actionF = addListener (void <$> actionF)++-- | React to terminal events Event+onEvent :: (Typeable m, MonadIO m, HasEvents s) => (V.Event -> AppT s m result) -> AppT s m ListenerId+onEvent = genericListener++-- | React to a Keypress+onKeypress :: (Typeable m, MonadIO m, HasEvents s) => (Keypress -> AppT s m result) -> AppT s m ListenerId+onKeypress = genericListener++-- | React to a Mouse Down+onMouseDown :: (Typeable m, MonadIO m, HasEvents s) => (MouseDown -> AppT s m result) -> AppT s m ListenerId+onMouseDown = genericListener++-- | React to a Mouse Up+onMouseUp :: (Typeable m, MonadIO m, HasEvents s) => (MouseUp -> AppT s m result) -> AppT s m ListenerId+onMouseUp = genericListener++-- | React to a Terminal Resize+onResize :: (Typeable m, MonadIO m, HasEvents s) => (Resize -> AppT s m result) -> AppT s m ListenerId+onResize = genericListener++-- | React to a Paste+onPaste :: (Typeable m, MonadIO m, HasEvents s) => (Paste -> AppT s m result) -> AppT s m ListenerId+onPaste = genericListener++-- | React to a Event+onEvent_ :: (Typeable m, MonadIO m, HasEvents s) => (V.Event -> AppT s m result) -> AppT s m ()+onEvent_ = void . genericListener++-- | React to a Keypress+onKeypress_ :: (Typeable m, MonadIO m, HasEvents s) => (Keypress -> AppT s m result) -> AppT s m ()+onKeypress_ = void . genericListener++-- | React to a Mouse Down+onMouseDown_ :: (Typeable m, MonadIO m, HasEvents s) => (MouseDown -> AppT s m result) -> AppT s m ()+onMouseDown_ = void . genericListener++-- | React to a Mouse Up+onMouseUp_ :: (Typeable m, MonadIO m, HasEvents s) => (MouseUp -> AppT s m result) -> AppT s m ()+onMouseUp_ = void . genericListener++-- | React to a Terminal Resize+onResize_ :: (Typeable m, MonadIO m, HasEvents s) => (Resize -> AppT s m result) -> AppT s m ()+onResize_ = void . genericListener++-- | React to a Paste+onPaste_ :: (Typeable m, MonadIO m, HasEvents s) => (Paste -> AppT s m result) -> AppT s m ()+onPaste_ = void . genericListener

@@ -0,0 +1,30 @@+module Eve.CLI.Internal.Render+  ( renderImage+  , Width+  , Height+  , getSize+  ) where++import Eve+import Eve.CLI.Internal.State+import Graphics.Vty as V+import Control.Monad.Trans++-- | Render the provided 'V.image' to screen+renderImage :: (MonadIO m, HasStates s) => V.Image -> AppT s m ()+renderImage img = do+  v <- getVty+  liftIO $ V.update v (V.picForImage img)++-- | Terminal width in columns+type Width = Int+-- | Terminal height in rows+type Height = Int+++-- | Get the current terminal size.+-- Also see 'onResize'+getSize :: (MonadIO m, HasStates s) => AppT s m (Width, Height)+getSize = do+  v <- getVty+  liftIO $ V.displayBounds $ V.outputIface v

@@ -0,0 +1,28 @@+module Eve.CLI.Internal.State+  ( getVty+  ) where++import Eve+import Control.Lens+import qualified Graphics.Vty as V++import Control.Monad.Trans++-- | Store 'V.Vty' state globally+newtype VTY = VTY V.Vty++-- | V.Vty must be initialized inside IO+initUi :: (MonadIO m, HasStates s) => AppT s m V.Vty+initUi = do+  cfg <- liftIO V.standardIOConfig+  v <- liftIO $ V.mkVty cfg+  stateLens .= Just (VTY v)+  return v++-- | Gets vty by checking if it has been initialized yet, if not it runs the initialization.+getVty :: (MonadIO m, HasStates s) => AppT s m V.Vty+getVty = do+  v <- use stateLens+  case v of+    Just (VTY v') -> return v'+    Nothing -> initUi

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"