wild-bind 0.1.2.8 → 0.1.2.9
raw patch · 14 files changed
+299/−310 lines, 14 filesdep ~basesetup-changed
Dependency ranges changed: base
Files
- ChangeLog.md +4/−0
- Setup.hs +1/−1
- src/WildBind.hs +10/−10
- src/WildBind/Binding.hs +29/−26
- src/WildBind/Description.hs +4/−4
- src/WildBind/Exec.hs +34/−41
- src/WildBind/FrontEnd.hs +20/−19
- src/WildBind/Input/NumPad.hs +49/−71
- src/WildBind/Seq.hs +22/−22
- test/WildBind/BindingSpec.hs +34/−28
- test/WildBind/ExecSpec.hs +29/−19
- test/WildBind/ForTest.hs +38/−33
- test/WildBind/SeqSpec.hs +23/−34
- wild-bind.cabal +2/−2
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for wild-bind +## 0.1.2.9 -- 2022-11-28++* Confirm test with ghc-9.2.5.+ ## 0.1.2.8 -- 2021-11-23 * Confirm test with `semigroups-0.20`.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
src/WildBind.hs view
@@ -3,20 +3,20 @@ -- Description: WildBind main module -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- module WildBind ( module WildBind.Binding, -- | Defines 'Binding' and many functions to build it.- + module WildBind.FrontEnd, -- | Defines 'FrontEnd', an interface between 'Binding' and a -- desktop environment.- + module WildBind.Exec, -- | Defines functions to combine 'Binding' and 'FrontEnd' -- into an executable action. You can customize its behavior -- via 'Option'.- + module WildBind.Description, -- | Defines 'ActionDescription'. @@ -25,7 +25,7 @@ -- * Support modules ----- +-- -- | The following modules are not re-exported from this module. -- -- - "WildBind.Seq": support module to build a binding to key@@ -33,8 +33,8 @@ ) where -import WildBind.Description-import WildBind.Binding-import WildBind.FrontEnd-import WildBind.Exec-import WildBind.Input.NumPad+import WildBind.Binding+import WildBind.Description+import WildBind.Exec+import WildBind.FrontEnd+import WildBind.Input.NumPad
src/WildBind/Binding.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} -- | -- Module: WildBind.Binding -- Description: Functions to build Binding@@ -6,20 +8,20 @@ -- -- This module exports functions to build and manipulate 'Binding', an -- object binding input symbols to actions.--- +-- module WildBind.Binding ( -- * Types Action(Action,actDescription,actDo), Binding, Binding',- + -- * Construction -- | Functions to create fundamental 'Binding's. -- -- To create complex 'Binding's, use <#Condition Condition> functions -- described below and 'mappend' them together.- + noBinding, Binder, binds,@@ -33,9 +35,9 @@ binding', bindingF, bindingF',- + -- * Condition- + -- | #Condition# With these functions, you can create -- 'Binding's that behave differently for different front-end -- and/or back-end states.@@ -73,23 +75,25 @@ boundInputs' ) where -import Control.Applicative (Applicative, (<*), (*>))-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT(..), withReaderT)-import Control.Monad.Trans.State (StateT(..), runStateT, mapStateT)-import Control.Monad.Trans.Writer (Writer, tell, execWriter, mapWriter)-import qualified Data.Map as M-import Data.Monoid (Monoid(..), Endo(Endo, appEndo))-import Data.Semigroup (Semigroup(..))+import Control.Applicative (Applicative, (*>), (<*))+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT (..), withReaderT)+import Control.Monad.Trans.State (StateT (..), mapStateT, runStateT)+import Control.Monad.Trans.Writer (Writer, execWriter, mapWriter, tell)+import qualified Data.Map as M+import Data.Monoid (Endo (Endo, appEndo), Monoid (..))+import Data.Semigroup (Semigroup (..)) -import WildBind.Description (ActionDescription)+import WildBind.Description (ActionDescription) -- | Action done by WildBind-data Action m a =- Action- { actDescription :: ActionDescription, -- ^ Human-readable description of the action.- actDo :: m a -- ^ The actual job.- }+data Action m a+ = Action+ { actDescription :: ActionDescription+ -- ^ Human-readable description of the action.+ , actDo :: m a+ -- ^ The actual job.+ } instance Show (Action m a) where show a = "Action " ++ show (actDescription a)@@ -134,10 +138,8 @@ -- -- You can make the explicit state @bs@ implicit by 'startFrom' -- function.-newtype Binding' bs fs i =- Binding'- { unBinding' :: bs -> fs -> M.Map i (Action (SRIM bs fs) (Binding' bs fs i))- }+newtype Binding' bs fs i+ = Binding' { unBinding' :: bs -> fs -> M.Map i (Action (SRIM bs fs) (Binding' bs fs i)) } runSRIM :: bs -> fs -> SRIM bs fs a -> IO (a, bs) runSRIM bs fs m = flip runReaderT fs $ flip runStateT bs m@@ -218,8 +220,9 @@ -- | A monad to construct 'Binding''. @i@ is the input symbol, and @v@ -- is supposed to be the 'Action' bound to @i@.-newtype Binder i v a = Binder { unBinder :: Writer (Endo [(i, v)]) a }- deriving (Monad,Applicative,Functor)+newtype Binder i v a+ = Binder { unBinder :: Writer (Endo [(i, v)]) a }+ deriving (Applicative, Functor, Monad) runBinder :: Binder i v a -> [(i, v)] -> [(i, v)] runBinder = appEndo . execWriter . unBinder
src/WildBind/Description.hs view
@@ -4,11 +4,11 @@ -- Maintainer: Toshio Ito <debug.ito@gmail.com> -- module WildBind.Description- ( ActionDescription,- Describable(..)- ) where+ ( ActionDescription+ , Describable (..)+ ) where -import Data.Text (Text)+import Data.Text (Text) -- | Human-readable description of an action. 'ActionDescription' is -- used to describe the current binding to the user.
src/WildBind/Exec.hs view
@@ -2,40 +2,33 @@ -- Module: WildBind.Exec -- Description: Functions to create executable actions. -- Maintainer: Toshio Ito <debug.ito@gmail.com>--- +-- module WildBind.Exec- ( -- * Functions to build executable action- wildBind,- wildBind',- -- * Option for executable- Option,- defOption,- -- ** Accessor functions for 'Option'- optBindingHook,- optCatch- ) where+ ( -- * Functions to build executable action+ wildBind+ , wildBind'+ -- * Option for executable+ , Option+ , defOption+ -- ** Accessor functions for 'Option'+ , optBindingHook+ , optCatch+ ) where -import Control.Applicative ((<$>))-import Control.Exception (SomeException, catch)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Class (lift)+import Control.Applicative ((<$>))+import Control.Exception (SomeException, catch)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Reader as Reader-import qualified Control.Monad.Trans.State as State-import Data.List ((\\))-import System.IO (hPutStrLn, stderr)+import qualified Control.Monad.Trans.State as State+import Data.List ((\\))+import System.IO (hPutStrLn, stderr) -import WildBind.Description (ActionDescription)-import WildBind.FrontEnd- ( FrontEvent(FEChange,FEInput),- FrontEnd(frontSetGrab, frontUnsetGrab, frontNextEvent)- )-import WildBind.Binding- ( Action(actDo, actDescription),- Binding,- boundAction,- boundInputs,- boundActions- )+import WildBind.Binding (Action (actDescription, actDo), Binding, boundAction,+ boundActions, boundInputs)+import WildBind.Description (ActionDescription)+import WildBind.FrontEnd (FrontEnd (frontNextEvent, frontSetGrab, frontUnsetGrab),+ FrontEvent (FEChange, FEInput)) type GrabSet i = [i] @@ -57,16 +50,16 @@ -- -- You can get the default value of 'Option' by 'defOption' funcion, -- and modify its members via accessor functions listed below.-data Option s i =- Option { optBindingHook :: [(i, ActionDescription)] -> IO (),- -- ^ An action executed when current binding may be- -- changed. Default: do nothing.-- optCatch :: s -> i -> SomeException -> IO ()- -- ^ the handler for exceptions thrown from bound- -- actions. Default: just print the 'SomeException' to- -- 'stderr' and ignore it.- }+data Option s i+ = Option+ { optBindingHook :: [(i, ActionDescription)] -> IO ()+ -- ^ An action executed when current binding may be+ -- changed. Default: do nothing.+ , optCatch :: s -> i -> SomeException -> IO ()+ -- ^ the handler for exceptions thrown from bound+ -- actions. Default: just print the 'SomeException' to+ -- 'stderr' and ignore it.+ } defOption :: Option s i defOption = Option { optBindingHook = const $ return (),@@ -103,7 +96,7 @@ updateBinding front after_binding = do (_, mstate) <- State.get case mstate of- Nothing -> return ()+ Nothing -> return () Just state -> updateWBState front after_binding state wildBindInContext :: (Ord i) => FrontEnd s i -> WBContext s i ()
src/WildBind/FrontEnd.hs view
@@ -4,31 +4,32 @@ -- Maintainer: Toshio Ito <debug.ito@gmail.com> -- -- Data types and type classes about front-ends.--- +-- -- You have to look at this module if you want to create a front-end -- implementation. module WildBind.FrontEnd- ( FrontEvent(..),- FrontEnd(..)- ) where+ ( FrontEvent (..)+ , FrontEnd (..)+ ) where -import WildBind.Description (ActionDescription)+import WildBind.Description (ActionDescription) -- | Event from the front-end. @s@ is the state of the front-end. @i@ is the input.-data FrontEvent s i = FEInput i -- ^ An event that a new input is made.- | FEChange s -- ^ An event that the front-end state is changed.- deriving (Show,Eq,Ord)+data FrontEvent s i+ = FEInput i -- ^ An event that a new input is made.+ | FEChange s -- ^ An event that the front-end state is changed.+ deriving (Eq, Ord, Show) -- | Interface to the front-end. @s@ is the state of the front-end, -- @i@ is the input.-data FrontEnd s i =- FrontEnd- { frontDefaultDescription :: i -> ActionDescription,- -- ^ Default 'ActionDescription' for inputs- frontSetGrab :: i -> IO (),- -- ^ Action to grab (or capture) the specified input symbol on the device. - frontUnsetGrab :: i -> IO (),- -- ^ Action to release the grab for the input symbol.- frontNextEvent :: IO (FrontEvent s i)- -- ^ Action to retrieve the next event. It should block if no event is queued.- }+data FrontEnd s i+ = FrontEnd+ { frontDefaultDescription :: i -> ActionDescription+ -- ^ Default 'ActionDescription' for inputs+ , frontSetGrab :: i -> IO ()+ -- ^ Action to grab (or capture) the specified input symbol on the device.+ , frontUnsetGrab :: i -> IO ()+ -- ^ Action to release the grab for the input symbol.+ , frontNextEvent :: IO (FrontEvent s i)+ -- ^ Action to retrieve the next event. It should block if no event is queued.+ }
src/WildBind/Input/NumPad.hs view
@@ -6,90 +6,68 @@ -- -- Input types for number pad keys. module WildBind.Input.NumPad- ( -- * NumLock disabled- NumPadUnlocked(..),- -- * NumLock enabled- NumPadLocked(..),- ) where+ ( -- * NumLock disabled+ NumPadUnlocked (..)+ -- * NumLock enabled+ , NumPadLocked (..)+ ) where -import WildBind.Description (Describable(describe))+import WildBind.Description (Describable (describe)) -- | Number pad key input with NumLock disabled.-data NumPadUnlocked- = NumInsert- | NumEnd- | NumDown- | NumPageDown- | NumLeft- | NumCenter- | NumRight- | NumHome- | NumUp- | NumPageUp- | NumDivide- | NumMulti- | NumMinus- | NumPlus- | NumEnter- | NumDelete- deriving (Eq,Ord,Show,Bounded,Enum)+data NumPadUnlocked = NumInsert | NumEnd | NumDown | NumPageDown | NumLeft | NumCenter | NumRight | NumHome | NumUp | NumPageUp | NumDivide | NumMulti | NumMinus | NumPlus | NumEnter | NumDelete deriving+ ( Bounded+ , Enum+ , Eq+ , Ord+ , Show+ ) instance Describable NumPadUnlocked where describe input = case input of- NumHome -> "Home"- NumUp -> "↑"- NumPageUp -> "PageUp"- NumLeft -> "←"- NumCenter -> ""- NumRight -> "→"- NumEnd -> "End"- NumDown -> "↓"+ NumHome -> "Home"+ NumUp -> "↑"+ NumPageUp -> "PageUp"+ NumLeft -> "←"+ NumCenter -> ""+ NumRight -> "→"+ NumEnd -> "End"+ NumDown -> "↓" NumPageDown -> "PageDown"- NumDivide -> "/"- NumMulti -> "*"- NumMinus -> "-"- NumPlus -> "+"- NumEnter -> "Enter"- NumInsert -> "Insert"- NumDelete -> "Delete"+ NumDivide -> "/"+ NumMulti -> "*"+ NumMinus -> "-"+ NumPlus -> "+"+ NumEnter -> "Enter"+ NumInsert -> "Insert"+ NumDelete -> "Delete" -- | Number pad key input with NumLock enabled.-data NumPadLocked- = NumL0- | NumL1- | NumL2- | NumL3- | NumL4- | NumL5- | NumL6- | NumL7- | NumL8- | NumL9- | NumLDivide- | NumLMulti- | NumLMinus- | NumLPlus- | NumLEnter- | NumLPeriod- deriving (Eq,Ord,Show,Bounded,Enum)+data NumPadLocked = NumL0 | NumL1 | NumL2 | NumL3 | NumL4 | NumL5 | NumL6 | NumL7 | NumL8 | NumL9 | NumLDivide | NumLMulti | NumLMinus | NumLPlus | NumLEnter | NumLPeriod deriving+ ( Bounded+ , Enum+ , Eq+ , Ord+ , Show+ ) instance Describable NumPadLocked where describe input = case input of- NumL0 -> "0"- NumL1 -> "1"- NumL2 -> "2"- NumL3 -> "3"- NumL4 -> "4"- NumL5 -> "5"- NumL6 -> "6"- NumL7 -> "7"- NumL8 -> "8"- NumL9 -> "9"+ NumL0 -> "0"+ NumL1 -> "1"+ NumL2 -> "2"+ NumL3 -> "3"+ NumL4 -> "4"+ NumL5 -> "5"+ NumL6 -> "6"+ NumL7 -> "7"+ NumL8 -> "8"+ NumL9 -> "9" NumLDivide -> "/"- NumLMulti -> "*"- NumLMinus -> "-"- NumLPlus -> "+"- NumLEnter -> "Enter"+ NumLMulti -> "*"+ NumLMinus -> "-"+ NumLPlus -> "+"+ NumLEnter -> "Enter" NumLPeriod -> "."
src/WildBind/Seq.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} -- | -- Module: WildBind.Seq -- Description: Support for binding sequence of input events.@@ -12,32 +13,31 @@ -- -- @since 0.1.1.0 --- + module WildBind.Seq- ( -- * Simple API- prefix,- -- * Advanced API- SeqBinding,- toSeq,- fromSeq,- withPrefix,- withCancel,- reviseSeq- ) where+ ( -- * Simple API+ prefix+ -- * Advanced API+ , SeqBinding+ , toSeq+ , fromSeq+ , withPrefix+ , withCancel+ , reviseSeq+ ) where -import Control.Monad.Trans.State (State)+import Control.Monad.Trans.State (State) import qualified Control.Monad.Trans.State as State-import Data.Monoid (Monoid(..), mconcat)-import Data.Semigroup (Semigroup(..))+import Data.Monoid (Monoid (..), mconcat)+import Data.Semigroup (Semigroup (..)) -import WildBind.Binding- ( Binding, Binding', binds', whenBack, on, as, run, extend,- startFrom, revise', justBefore, revise,- Action- )+import WildBind.Binding (Action, Binding, Binding', as, binds', extend,+ justBefore, on, revise, revise', run, startFrom,+ whenBack) -- | Intermediate type of building a 'Binding' for key sequences.-newtype SeqBinding fs i = SeqBinding ([i] -> Binding' [i] fs i)+newtype SeqBinding fs i+ = SeqBinding ([i] -> Binding' [i] fs i) -- | Follows the same rule as 'Binding'. instance Ord i => Semigroup (SeqBinding fs i) where@@ -61,7 +61,7 @@ withPrefix ps sb = foldr withPrefixSingle sb ps withPrefixSingle :: Ord i => i -> SeqBinding fs i -> SeqBinding fs i-withPrefixSingle p (SeqBinding fb) = +withPrefixSingle p (SeqBinding fb) = SeqBinding $ \cur_prefix -> nextBinding cur_prefix <> prefixBinding cur_prefix where prefixBinding cur_prefix = whenBack (== cur_prefix) $ binds' $ do
test/WildBind/BindingSpec.hs view
@@ -1,32 +1,38 @@-{-# LANGUAGE RankNTypes, OverloadedStrings #-}-module WildBind.BindingSpec (main, spec) where+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+module WildBind.BindingSpec+ ( main+ , spec+ ) where -import Control.Applicative ((<$>), (<*>), pure)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class (lift)+import Control.Applicative (pure, (<$>), (<*>))+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Reader as Reader-import qualified Control.Monad.Trans.State as State-import Data.Maybe (isNothing, fromJust)-import Data.Monoid (mempty, (<>), mconcat)-import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)-import qualified Lens.Micro as Lens-import Test.Hspec-import Test.QuickCheck (Gen, Arbitrary(arbitrary), property, listOf, sample')+import qualified Control.Monad.Trans.State as State+import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)+import Data.Maybe (fromJust, isNothing)+import Data.Monoid (mconcat, mempty, (<>))+import qualified Lens.Micro as Lens+import Test.Hspec+import Test.QuickCheck (Arbitrary (arbitrary), Gen, listOf, property, sample') -import qualified WildBind.Binding as WB-import WildBind.ForTest- ( SampleInput(..), SampleState(..), SampleBackState(..),- inputAll, execAll, evalStateEmpty, boundDescs, boundDescs',- checkBoundDescs,- withRefChecker- )+import qualified WildBind.Binding as WB+import WildBind.ForTest (SampleBackState (..), SampleInput (..),+ SampleState (..), boundDescs, boundDescs',+ checkBoundDescs, evalStateEmpty, execAll, inputAll,+ withRefChecker) main :: IO () main = hspec spec -data BiggerSampleBackState = BSB { _lSB :: SampleBackState, _rSB :: SampleBackState }- deriving (Show, Eq, Ord)+data BiggerSampleBackState+ = BSB+ { _lSB :: SampleBackState+ , _rSB :: SampleBackState+ }+ deriving (Eq, Ord, Show) lSB :: Lens.Lens' BiggerSampleBackState SampleBackState lSB = Lens.lens _lSB (\bsb sb -> bsb { _lSB = sb })@@ -59,7 +65,7 @@ outputRandomElem = do out_elem <- arbitrary return $ modifyIORef out_list (out_elem :)- + generate :: Gen a -> IO a generate = fmap head . sample' @@ -342,8 +348,8 @@ checkInputsS' [SIa, SIb] execAll' [SIa, SIb] checkOut "0231413"- + spec_stateful :: Spec spec_stateful = do describe "binding'" $ do@@ -405,7 +411,7 @@ execAll (SS "") [SIc] checkOut "ADAbC" checkInputsS (SS "") [SIa]- + describe "ifBack" $ do it "chooses from unconditional bindings" $ withStrRef $ \out checkOut -> do let b = WB.ifBack (\(SB sb) -> sb < 5)@@ -525,7 +531,7 @@ checkInputsS (SS "hoge") [SIa, SIb] checkInputsS (SS "fooo") [SIc] checkInputsS (SS "foooo") [SIb]- + describe "whenBoth" $ do let incr' out ret = outOnS out SIa ret (\(SB num) -> SB (num + 1)) decr' out ret = outOnS out SIb ret (\(SB num) -> SB (num - 1))@@ -571,7 +577,7 @@ checkInputsS (SS "1") [SIa, SIb] execAll (SS "1") [SIb] checkOut "+p-mm"- + spec_monadic :: Spec spec_monadic = describe "Monadic construction of Binding" $ do describe "binds" $ do@@ -775,4 +781,4 @@ checkBoundDescs (SS "") [(SIa, "a")] execAll (SS "") [SIa] checkBoundDescs (SS "") [(SIa, "a"), (SIb, "b")]- +
test/WildBind/ExecSpec.hs view
@@ -1,27 +1,37 @@ {-# LANGUAGE OverloadedStrings #-}-module WildBind.ExecSpec (main, spec) where+module WildBind.ExecSpec+ ( main+ , spec+ ) where -import Control.Applicative ((<$>))-import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)-import Control.Concurrent.STM (atomically, TChan, readTChan, tryReadTChan, writeTChan, newTChanIO)-import Control.Exception (bracket, throw, fromException)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Applicative ((<$>))+import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)+import Control.Concurrent.STM (TChan, atomically, newTChanIO, readTChan, tryReadTChan,+ writeTChan)+import Control.Exception (bracket, fromException, throw)+import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Control.Monad.Trans.State as State-import Data.Monoid ((<>))-import System.IO.Error (userError)-import Test.Hspec+import Data.Monoid ((<>))+import System.IO.Error (userError)+import Test.Hspec -import qualified WildBind.Binding as WBB-import qualified WildBind.Exec as WBE-import qualified WildBind.FrontEnd as WBF+import qualified WildBind.Binding as WBB+import qualified WildBind.Exec as WBE+import qualified WildBind.FrontEnd as WBF -import WildBind.ForTest (SampleInput(..), SampleState(..), SampleBackState(..))+import WildBind.ForTest (SampleBackState (..), SampleInput (..),+ SampleState (..)) -newtype EventChan s i = EventChan { unEventChan :: TChan (WBF.FrontEvent s i) }+newtype EventChan s i+ = EventChan { unEventChan :: TChan (WBF.FrontEvent s i) } -data GrabHistory i = GSet i | GUnset i deriving (Show, Eq, Ord)+data GrabHistory i+ = GSet i+ | GUnset i+ deriving (Eq, Ord, Show) -newtype GrabChan i = GrabChan { unGrabChan :: TChan (GrabHistory i) }+newtype GrabChan i+ = GrabChan { unGrabChan :: TChan (GrabHistory i) } frontEnd :: EventChan s i -> GrabChan i -> WBF.FrontEnd s i frontEnd echan gchan = WBF.FrontEnd@@ -48,7 +58,7 @@ gchan <- GrabChan <$> newTChanIO let spawnWildBind = forkIOWithUnmask $ \umask -> umask $ exec (frontEnd echan gchan) bracket spawnWildBind killThread (\_ -> action echan gchan)- + withWildBind :: Ord i => WBB.Binding s i -> (EventChan s i -> GrabChan i -> IO ()) -> IO () withWildBind binding action = withWildBind' (WBE.wildBind binding) action @@ -63,7 +73,7 @@ readAll' acc = do mret <- tryReadTChan chan case mret of- Nothing -> return (reverse acc)+ Nothing -> return (reverse acc) Just ret -> readAll' (ret : acc) shouldNowMatch :: (Show a, Eq a) => TChan a -> [a] -> IO ()@@ -232,4 +242,4 @@ got_state `shouldBe` SS "front state" got_input `shouldBe` SIa fromException got_exception `shouldBe` Just (userError "BOOM!")- +
test/WildBind/ForTest.hs view
@@ -1,49 +1,54 @@ module WildBind.ForTest- ( SampleInput(..),- SampleState(..),- SampleBackState(..),- inputAll,- execAll,- evalStateEmpty,- boundDescs,- boundDescs',- curBoundInputs,- curBoundDescs,- curBoundDesc,- checkBoundInputs,- checkBoundDescs,- checkBoundDesc,- withRefChecker- ) where+ ( SampleInput (..)+ , SampleState (..)+ , SampleBackState (..)+ , inputAll+ , execAll+ , evalStateEmpty+ , boundDescs+ , boundDescs'+ , curBoundInputs+ , curBoundDescs+ , curBoundDesc+ , checkBoundInputs+ , checkBoundDescs+ , checkBoundDesc+ , withRefChecker+ ) where -import Control.Applicative ((<$>), (<*>), pure)-import Control.Monad (join)-import Control.Monad.IO.Class (liftIO, MonadIO)+import Control.Applicative (pure, (<$>), (<*>))+import Control.Monad (join)+import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Control.Monad.Trans.State as State-import Data.IORef (IORef, newIORef, readIORef)-import Data.Monoid (mempty)-import Test.QuickCheck (Arbitrary(arbitrary,shrink), arbitraryBoundedEnum)-import Test.Hspec (shouldReturn, shouldMatchList, shouldBe)+import Data.IORef (IORef, newIORef, readIORef)+import Data.Monoid (mempty)+import Test.Hspec (shouldBe, shouldMatchList, shouldReturn)+import Test.QuickCheck (Arbitrary (arbitrary, shrink), arbitraryBoundedEnum) -import qualified WildBind.Binding as WB-import qualified WildBind.Description as WBD+import qualified WildBind.Binding as WB+import qualified WildBind.Description as WBD -data SampleInput = SIa | SIb | SIc- deriving (Show, Eq, Ord, Enum, Bounded)+data SampleInput = SIa | SIb | SIc deriving (Bounded, Enum, Eq, Ord, Show) instance Arbitrary SampleInput where arbitrary = arbitraryBoundedEnum -data SampleState = SS { unSS :: String }- deriving (Show, Eq, Ord)+data SampleState+ = SS+ { unSS :: String+ }+ deriving (Eq, Ord, Show) instance Arbitrary SampleState where arbitrary = SS <$> arbitrary shrink (SS s) = SS <$> shrink s -data SampleBackState = SB { unSB :: Int }- deriving (Show, Eq, Ord)+data SampleBackState+ = SB+ { unSB :: Int+ }+ deriving (Eq, Ord, Show) instance Enum SampleBackState where toEnum = SB@@ -53,7 +58,7 @@ inputAll :: Ord i => WB.Binding s i -> s -> [i] -> IO (WB.Binding s i) inputAll b _ [] = return b inputAll binding state (i:rest) = case WB.boundAction binding state i of- Nothing -> inputAll binding state rest+ Nothing -> inputAll binding state rest Just act -> join $ inputAll <$> WB.actDo act <*> return state <*> return rest execAll :: Ord i => s -> [i] -> State.StateT (WB.Binding s i) IO ()@@ -91,7 +96,7 @@ checkBoundDesc :: (Ord i) => s -> i -> WBD.ActionDescription -> State.StateT (WB.Binding s i) IO () checkBoundDesc fs input expected = liftIO . (`shouldBe` Just expected) =<< curBoundDesc fs input- + withRefChecker :: (Eq a, Show a, MonadIO m) => a -> (IORef a -> (a -> m ()) -> m ())
test/WildBind/SeqSpec.hs view
@@ -1,38 +1,27 @@ {-# LANGUAGE OverloadedStrings #-}-module WildBind.SeqSpec (main,spec) where+module WildBind.SeqSpec+ ( main+ , spec+ ) where -import Control.Applicative ((<*>))-import Control.Monad (forM_)-import Control.Monad.IO.Class (liftIO)+import Control.Applicative ((<*>))+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO) import qualified Control.Monad.Trans.State as State-import Data.Monoid ((<>))-import Data.IORef (modifyIORef, newIORef, readIORef)-import Test.Hspec+import Data.IORef (modifyIORef, newIORef, readIORef)+import Data.Monoid ((<>))+import Test.Hspec -import WildBind.Binding- ( binds, on, run, as,- boundActions, actDescription,- boundInputs,- Binding,- justBefore- )-import WildBind.Description (ActionDescription)-import WildBind.Seq- ( prefix,- toSeq, fromSeq,- withPrefix, withCancel,- reviseSeq- )+import WildBind.Binding (Binding, actDescription, as, binds, boundActions,+ boundInputs, justBefore, on, run)+import WildBind.Description (ActionDescription)+import WildBind.Seq (fromSeq, prefix, reviseSeq, toSeq, withCancel,+ withPrefix) -import WildBind.ForTest- ( SampleInput(..), SampleState(..),- evalStateEmpty, execAll,- boundDescs, curBoundInputs, curBoundDescs, curBoundDesc,- checkBoundInputs,- checkBoundDescs,- checkBoundDesc,- withRefChecker- )+import WildBind.ForTest (SampleInput (..), SampleState (..), boundDescs,+ checkBoundDesc, checkBoundDescs, checkBoundInputs,+ curBoundDesc, curBoundDescs, curBoundInputs,+ evalStateEmpty, execAll, withRefChecker) main :: IO () main = hspec spec@@ -57,7 +46,7 @@ specify "one prefix" $ evalStateEmpty $ do State.put $ prefix [] [SIc] base_b checkBoundInputs (SS "") [SIc]- execAll (SS "") [SIc] + execAll (SS "") [SIc] checkBoundDescs (SS "") [(SIa, "a"), (SIb, "b")] execAll (SS "") [SIc] checkBoundDescs (SS "") [(SIa, "a"), (SIb, "b")]@@ -150,7 +139,7 @@ checkBoundDescs (SS "") [(SIa, "cancel"), (SIb, "b"), (SIc, "cancel")] execAll (SS "") [SIb] checkPrefixOne- + spec_reviseSeq :: Spec spec_reviseSeq = describe "reviseSeq" $ do it "should allow access to prefix keys input so far" $ evalStateEmpty $ withRefChecker [] $ \out checkOut -> do@@ -189,5 +178,5 @@ checkBoundDescs (SS "") [(SIb, "b on aa")] -- SIc should be canceled execAll (SS "") [SIb] checkBoundInputs (SS "") [SIa]- - ++
wild-bind.cabal view
@@ -1,5 +1,5 @@ name: wild-bind-version: 0.1.2.8+version: 0.1.2.9 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -26,7 +26,7 @@ WildBind.Input.NumPad, WildBind.Seq -- other-modules: - build-depends: base >=4.6 && <4.16,+ build-depends: base >=4.6 && <4.17, text >=1.2.0 && <1.3, containers >=0.5.0 && <0.7, transformers >=0.3.0 && <0.6,