562a22e · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Remove LeadingAndTrailing

562a22eTom McLaughlin7 years ago

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

compare with master

unifiedsplit

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

11-- printString <- 'mkDebounce' 'defaultDebounceSettings'

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

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

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

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

15-- }

16-- @

17--

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

32 , DI.debounceFreq

33 , DI.debounceAction

34 , DI.debounceEdge

35− , DI.DebounceEdge(..)

35+ , leadingEdge

36+ , trailingEdge

36 -- * Creation

37 -- * Creation

37 , mkDebounce

38 , mkDebounce

38 ) where

39 ) where

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

47defaultDebounceSettings = DI.DebounceSettings

48defaultDebounceSettings = DI.DebounceSettings

48 { DI.debounceFreq = 1000000

49 { DI.debounceFreq = 1000000

49 , DI.debounceAction = return ()

50 , DI.debounceAction = return ()

50− , DI.debounceEdge = DI.Leading

51+ , DI.debounceEdge = leadingEdge

51 }

52 }

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

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

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

57mkDebounce settings = do

58mkDebounce settings = do

58 baton <- newEmptyMVar

59 baton <- newEmptyMVar

59 DI.mkDebounceInternal baton threadDelay settings

60 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

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

43 -- the timeout.

44 --

45− -- Default: Leading.

45+ -- Default: trailingEdge.

46 --

47 -- @since 0.1.6

48 }

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

54data DebounceEdge =

55 Leading

56 -- ^ 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

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

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.

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

63 | Trailing

59 | Trailing

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

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

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

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

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

71 takeMVar baton

67 takeMVar baton

72 case edge of

68 case edge of

73 Leading -> ignoreExc action >> runDelay

69 Leading -> ignoreExc action >> runDelay

74− LeadingAndTrailing -> ignoreExc action >> runDelay

75 Trailing -> runDelay

70 Trailing -> runDelay

77 return $ void $ tryPutMVar baton ()

72 return $ void $ tryPutMVar baton ()

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

87 Leading ->

82 Leading ->

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

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

89 return ()

84 return ()

90− LeadingAndTrailing -> do

91− firedDuringInterval <- isJust <$> tryTakeMVar baton

92− when firedDuringInterval $ ignoreExc action

94ignoreExc :: IO () -> IO ()

86ignoreExc :: IO () -> IO ()

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

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

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

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

15spec = describe "mkDebounce" $ do

16 describe "Leading edge" $ do

17 it "works for a single event" $ do

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

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

20 debounced

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

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

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

35 it "works for multiple events" $ do

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

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

38 debounced

39 waitForBatonToBeTaken baton

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

48 describe "Trailing edge" $ do

49 it "works for a single event" $ do

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

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

52 debounced

53 pause

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

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

67 it "works for multiple events" $ do

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

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

70 debounced

71 waitForBatonToBeTaken baton

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

76 returnFromWait

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

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−

110

111-- | Make a controllable delay function

80-- | Make a controllable delay function

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

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

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

117 return (waitAction, returnFromWait)

86 return (waitAction, returnFromWait)

118

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

88-- | 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 ())

121getDebounce edge = do

90getDebounce edge = do

122 ref :: IORef Int <- newIORef 0

91 ref :: IORef Int <- newIORef 0

123 let action = modifyIORef ref (+ 1)

92 let action = modifyIORef ref (+ 1)