@@ -1,5 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE RecursiveDo #-}
7{-# LANGUAGE RecursiveDo #-}
@@ -24,12 +26,14 @@ import Control.Monad
24import Control.Monad.Fix
26import Control.Monad.Fix
25import Control.Monad.IO.Class
27import Control.Monad.IO.Class
26import Data.Align
28import Data.Align
29+import Data.Data (Data)
27import Data.Fixed
30import Data.Fixed
28import Data.Sequence (Seq, (|>))
31import Data.Sequence (Seq, (|>))
29import qualified Data.Sequence as Seq
32import qualified Data.Sequence as Seq
30import Data.These
33import Data.These
31import Data.Time.Clock
34import Data.Time.Clock
32import Data.Typeable
35import Data.Typeable
36+import GHC.Generics (Generic)
33import System.Random
37import System.Random
35data TickInfo
39data TickInfo
@@ -269,16 +273,20 @@ throttle t e = do
269data ThrottleState b
273data ThrottleState b
270 = Immediate
274 = Immediate
271 | Buffered (ThrottleBuffer b)
275 | Buffered (ThrottleBuffer b)
276+ deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic, Data, Typeable)
273data ThrottleBuffer b
278data ThrottleBuffer b
274 = BEmpty -- Empty conflicts with lens, and hiding it would require turning
279 = BEmpty -- Empty conflicts with lens, and hiding it would require turning
275 -- on PatternSynonyms
280 -- on PatternSynonyms
282+ deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic, Data, Typeable)
278instance Semigroup b => Semigroup (ThrottleBuffer b) where
284instance Semigroup b => Semigroup (ThrottleBuffer b) where
279− BEmpty <> x = x
285+ x <> y = case x of
287+ Full b1 -> case y of
280− x@(Full _) <> BEmpty = x
288+ BEmpty -> x
281− Full b1 <> Full b2 = Full $ b1 <> b2
289+ Full b2 -> Full $ b1 <> b2
282 {-# INLINE (<>) #-}
290 {-# INLINE (<>) #-}
284instance Semigroup b => Monoid (ThrottleBuffer b) where
292instance Semigroup b => Monoid (ThrottleBuffer b) where