562a22e · typeable/wai

git.iko.soy/typeable/wai

Remove LeadingAndTrailing

commit562a22e4639735d8813d1ba114009656dbcd9d67 authorTom McLaughlin <pyro777@gmail.com> dateFri 5 Jul 2019, 15:13 (7 years ago) parent7d681cc

3 files changed+23−50

compare with master

unifiedsplit

auto-update/Control/Debounce.hs+15−3 auto-update/Control/Debounce/Internal.hs+3−11 auto-update/test/Control/DebounceSpec.hs+5−36

auto-update/Control/Debounce.hs+15−3

@@ -11,7 +11,7 @@

1111-- printString <- 'mkDebounce' 'defaultDebounceSettings'

1212-- { 'debounceAction' = putStrLn "Running action"

1313-- , 'debounceFreq' = 5000000 -- 5 seconds

14−-- , 'debounceEdge' = 'Trailing' -- Trigger on the trailing edge

14+-- , 'debounceEdge' = 'trailingEdge' -- Trigger on the trailing edge

1515-- }

1616-- @

1717--

@@ -32,7 +32,8 @@ module Control.Debounce

3232 , DI.debounceFreq

3333 , DI.debounceAction

3434 , DI.debounceEdge

35− , DI.DebounceEdge(..)

35+ , leadingEdge

36+ , trailingEdge

3637 -- * Creation

3738 , mkDebounce

3839 ) where

@@ -47,7 +48,7 @@ defaultDebounceSettings :: DI.DebounceSettings

4748defaultDebounceSettings = DI.DebounceSettings

4849 { DI.debounceFreq = 1000000

4950 , DI.debounceAction = return ()

50− , DI.debounceEdge = DI.Leading

51+ , DI.debounceEdge = leadingEdge

5152 }

5253

5354-- | Generate an action which will trigger the debounced action to be performed.

@@ -57,3 +58,14 @@ mkDebounce :: DI.DebounceSettings -> IO (IO ())

5758mkDebounce settings = do

5859 baton <- newEmptyMVar

5960 DI.mkDebounceInternal baton threadDelay settings

61+

62+-- | Perform the action immediately, and then begin a cooldown period.

63+-- If the trigger happens again during the cooldown, wait until the end of the cooldown

64+-- and then perform the action again, then enter a new cooldown period.

65+leadingEdge :: DI.DebounceEdge

66+leadingEdge = DI.Leading

67+

68+-- | Start a cooldown period and perform the action when the period ends. If another trigger

69+-- happens during the cooldown, it has no effect.

70+trailingEdge :: DI.DebounceEdge

71+trailingEdge = DI.Trailing

auto-update/Control/Debounce/Internal.hs+3−11

@@ -42,7 +42,7 @@ data DebounceSettings = DebounceSettings

4242 -- ^ Whether to perform the action on the leading edge or trailing edge of

4343 -- the timeout.

4444 --

45− -- Default: Leading.

45+ -- Default: trailingEdge.

4646 --

4747 -- @since 0.1.6

4848 }

@@ -54,12 +54,8 @@ data DebounceSettings = DebounceSettings

5454data DebounceEdge =

5555 Leading

5656 -- ^ Perform the action immediately, and then begin a cooldown period.

57− -- If trigger happens again during the cooldown, wait until the end of the cooldown and then

58− -- perform the action again /plus/ enter a new cooldown period.

59− | LeadingAndTrailing

60− -- ^ Perform the action immediately, and then begin a cooldown period.

61− -- If trigger happens again during the cooldown, wait until the end of the cooldown and then

62− -- perform the action again but /do not/ enter a new cooldown period.

57+ -- If the trigger happens again during the cooldown, wait until the end of the cooldown

58+ -- and then perform the action again, then enter a new cooldown period.

6359 | Trailing

6460 -- ^ Start a cooldown period and perform the action when the period ends. If another trigger

6561 -- happens during the cooldown, it has no effect.

@@ -71,7 +67,6 @@ mkDebounceInternal baton delayFn (DebounceSettings freq action edge) = do

7167 takeMVar baton

7268 case edge of

7369 Leading -> ignoreExc action >> runDelay

74− LeadingAndTrailing -> ignoreExc action >> runDelay

7570 Trailing -> runDelay

7671

7772 return $ void $ tryPutMVar baton ()

@@ -87,9 +82,6 @@ mkDebounceInternal baton delayFn (DebounceSettings freq action edge) = do

8782 Leading ->

8883 -- We already fired at the beginning of the interval so do nothing

8984 return ()

90− LeadingAndTrailing -> do

91− firedDuringInterval <- isJust <$> tryTakeMVar baton

92− when firedDuringInterval $ ignoreExc action

9385

9486ignoreExc :: IO () -> IO ()

9587ignoreExc = handle $ \(_ :: SomeException) -> return ()

auto-update/test/Control/DebounceSpec.hs+5−36

@@ -15,7 +15,7 @@ spec :: Spec

1515spec = describe "mkDebounce" $ do

1616 describe "Leading edge" $ do

1717 it "works for a single event" $ do

18− (ref, debounced, baton, returnFromWait) <- getDebounce Leading

18+ (ref, debounced, baton, returnFromWait) <- getDebounce leadingEdge

1919

2020 debounced

2121 waitUntil 5 $ readIORef ref >>= (`shouldBe` 1)

@@ -33,7 +33,7 @@ spec = describe "mkDebounce" $ do

3333 readIORef ref >>= (`shouldBe` 2)

3434

3535 it "works for multiple events" $ do

36− (ref, debounced, baton, returnFromWait) <- getDebounce Leading

36+ (ref, debounced, baton, returnFromWait) <- getDebounce leadingEdge

3737

3838 debounced

3939 waitForBatonToBeTaken baton

@@ -47,7 +47,7 @@ spec = describe "mkDebounce" $ do

4747

4848 describe "Trailing edge" $ do

4949 it "works for a single event" $ do

50− (ref, debounced, baton, returnFromWait) <- getDebounce Trailing

50+ (ref, debounced, baton, returnFromWait) <- getDebounce trailingEdge

5151

5252 debounced

5353 pause

@@ -65,7 +65,7 @@ spec = describe "mkDebounce" $ do

6565 waitUntil 5 $ readIORef ref >>= (`shouldBe` 2)

6666

6767 it "works for multiple events" $ do

68− (ref, debounced, baton, returnFromWait) <- getDebounce Trailing

68+ (ref, debounced, baton, returnFromWait) <- getDebounce trailingEdge

6969

7070 debounced

7171 waitForBatonToBeTaken baton

@@ -76,37 +76,6 @@ spec = describe "mkDebounce" $ do

7676 returnFromWait

7777 waitUntil 5 $ readIORef ref >>= (`shouldBe` 1)

7878

79− describe "Leading or trailing edge" $ do

80− it "works for a single event" $ do

81− (ref, debounced, baton, returnFromWait) <- getDebounce LeadingAndTrailing

82−

83− debounced

84− waitUntil 5 $ readIORef ref >>= (`shouldBe` 1)

85−

86− returnFromWait

87− pause

88− readIORef ref >>= (`shouldBe` 1)

89−

90− -- Try another round

91− debounced

92− waitUntil 5 $ readIORef ref >>= (`shouldBe` 2)

93−

94− returnFromWait

95− pause

96− readIORef ref >>= (`shouldBe` 2)

97−

98− it "works for multiple events" $ do

99− (ref, debounced, baton, returnFromWait) <- getDebounce LeadingAndTrailing

100−

101− debounced

102− waitForBatonToBeTaken baton

103− debounced

104−

105− waitUntil 5 $ readIORef ref >>= (`shouldBe` 1)

106−

107− returnFromWait

108− waitUntil 5 $ readIORef ref >>= (`shouldBe` 2)

109−

11079

11180-- | Make a controllable delay function

11281getWaitAction :: IO (p -> IO (), IO ())

@@ -117,7 +86,7 @@ getWaitAction = do

11786 return (waitAction, returnFromWait)

11887

11988-- | Get a debounce system with access to the internals for testing

120−getDebounce :: DebounceEdge -> IO (IORef Int, IO (), MVar (), IO ())

89+getDebounce :: DI.DebounceEdge -> IO (IORef Int, IO (), MVar (), IO ())

12190getDebounce edge = do

12291 ref :: IORef Int <- newIORef 0

12392 let action = modifyIORef ref (+ 1)