Fix few hlint warnings, fix cabal check warning, improve haddocks

fold-debounce.cabal

@@ -9,7 +9,8 @@ description:            Fold multiple events that happen in a given period of ti
 category:               Control
 cabal-version:          2.0
 build-type:             Simple
-extra-source-files:     README.md, ChangeLog.md
+extra-source-files:     README.md
+extra-doc-files:        ChangeLog.md
 homepage:               https://github.com/debug-ito/fold-debounce
 bug-reports:            https://github.com/debug-ito/fold-debounce/issues
 

src/Control/FoldDebounce.hs

@@ -86,6 +86,7 @@
                                                writeTVar)
 import           Control.Concurrent.STM.Delay (cancelDelay, newDelay, waitDelay)
 import           Data.Default                 (Default (def))
+import           Data.Maybe                   (fromMaybe)
 import           Data.Time                    (UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
 
 -- | Mandatory parameters for 'new'.
@@ -95,9 +96,9 @@
         -- emitted. Note that this action is run in a different thread than
         -- the one calling 'send'.
         --
-        -- The callback should not throw any exception. In this case, the
+        -- The callback should not throw any exception. If it does, the
         -- 'Trigger' is abnormally closed, causing
-        -- 'UnexpectedClosedException' when 'close'.
+        -- 'UnexpectedClosedException' when 'close' is called.
         cb   :: o -> IO ()
         -- | The binary operation of left-fold. The left-fold is evaluated strictly.
       , fold :: o -> i -> o
@@ -139,7 +140,7 @@
 -- the last event is at the head of the list.
 forStack :: ([i] -> IO ()) -- ^ 'cb' field.
          -> Args i [i]
-forStack mycb = Args { cb = mycb, fold = (flip (:)),  init = []}
+forStack mycb = Args { cb = mycb, fold = flip (:),  init = []}
 
 -- | 'Args' for monoids. Input events are appended to the tail.
 forMonoid :: Monoid i
@@ -151,7 +152,7 @@
 -- folded, they still start the timer and activate the callback.
 forVoid :: IO () -- ^ 'cb' field.
         -> Args i ()
-forVoid mycb = Args { cb = const mycb, fold = (\_ _ -> ()), init = () }
+forVoid mycb = Args { cb = const mycb, fold = \_ _ -> (), init = () }
 
 type SendTime = UTCTime
 type ExpirationTime = UTCTime
@@ -211,7 +212,7 @@
 close :: Trigger i o -> IO ()
 close trig = do
   atomically $ whenOpen $ writeTChan (trigInput trig) TIFinish
-  atomically $ whenOpen $ retry -- wait for closing
+  atomically $ whenOpen retry -- wait for closing
   where
     whenOpen stm_action = do
       state <- getThreadState trig
@@ -224,7 +225,7 @@
 data OpException
   = AlreadyClosedException -- ^ You attempted to 'send' after the trigger is already 'close'd.
   | UnexpectedClosedException SomeException -- ^ The 'SomeException' is thrown in the background thread.
   deriving (Show, Typeable)
 
 instance Exception OpException
 
@@ -236,7 +237,7 @@
     mgot <- waitInput in_chan mexpiration
     case mgot of
       Nothing -> fireCallback args mout_event >> threadAction' Nothing Nothing
-      Just (TIFinish) -> fireCallback args mout_event
+      Just TIFinish -> fireCallback args mout_event
       Just (TIEvent in_event send_time) ->
         let next_out = doFold args mout_event in_event
             next_expiration = nextExpiration opts mexpiration send_time
@@ -252,7 +253,7 @@
     Just 0 -> return Nothing
     Nothing -> atomically readInputSTM
     Just dur -> bracket (newDelay dur) cancelDelay $ \timer -> do
-      atomically $ readInputSTM <|> (const Nothing <$> waitDelay timer)
+      atomically $ readInputSTM <|> (Nothing <$ waitDelay timer)
   where
     readInputSTM = Just <$> readTChan in_chan
 
@@ -261,11 +262,11 @@
 fireCallback args (Just out_event) = cb args out_event
 
 doFold :: Args i o -> Maybe o -> i -> o
-doFold args mcurrent in_event = let current = maybe (init args) id mcurrent
+doFold args mcurrent in_event = let current = fromMaybe (init args) mcurrent
                                 in fold args current in_event
 
 noNegative :: Int -> Int
-noNegative x = if x < 0 then 0 else x
+noNegative x = max x 0
 
 diffTimeUsec :: UTCTime -> UTCTime -> Int
 diffTimeUsec a b = noNegative $ round $ (* 1000000) $ toRational $ diffUTCTime a b
@@ -276,7 +277,7 @@
 nextExpiration :: Opts i o -> Maybe ExpirationTime -> SendTime -> ExpirationTime
 nextExpiration opts mlast_expiration send_time
   | alwaysResetTimer opts = fullDelayed
-  | otherwise = maybe fullDelayed id $ mlast_expiration
+  | otherwise = fromMaybe fullDelayed mlast_expiration
   where
     fullDelayed = (`addTimeUsec` delay opts) send_time
 

test/Control/FoldDebounceSpec.hs

@@ -17,21 +17,23 @@ main :: IO ()
 main = hspec spec
 
 forFIFO :: ([Int] -> IO ()) -> F.Args Int [Int]
-forFIFO cb = F.Args {
-  F.cb = cb, F.fold = (\l v -> l ++ [v]), F.init = []
+forFIFO cb = F.Args
+  { F.cb = cb
+  , F.fold = \l v -> l ++ [v]
+  , F.init = []
   }
 
 callbackToTChan :: TChan a -> a -> IO ()
 callbackToTChan output = atomically . writeTChan output
 
 fifoTrigger :: F.Opts Int [Int] -> IO (F.Trigger Int [Int], TChan [Int])
 fifoTrigger opts = do
-  output <- atomically $ newTChan
+  output <- atomically newTChan
   trig <- F.new (forFIFO $ callbackToTChan output) opts
   return (trig, output)
 
 repeatFor :: Integer -> IO () -> IO ()
-repeatFor duration_usec action = repeatUntil =<< (addUTCTime (fromRational (duration_usec % 1000000)) <$> getCurrentTime)
+repeatFor duration_usec action = repeatUntil . addUTCTime (fromRational (duration_usec % 1000000)) =<< getCurrentTime
   where
     repeatUntil goal_time = do
       action
@@ -122,7 +124,7 @@ spec = do
                                      F.UnexpectedClosedException _ -> True
                                      _                             -> False)
     it "folds input events strictly" $ do
-      output <- atomically $ newTChan
+      output <- atomically newTChan
       trig <- F.new F.Args { F.cb = callbackToTChan output, F.fold = (+), F.init = 0 }
                     F.def { F.delay = 100000 }
       F.send trig 10
@@ -134,7 +136,7 @@ spec = do
                                         F.UnexpectedClosedException _ -> True
                                         _                             -> False)
     it "emits output events even if input events are coming intensely" $ do
-      output <- atomically $ newTChan
+      output <- atomically newTChan
       trig <- F.new F.Args { F.cb = callbackToTChan output, F.fold = (\_ i -> i), F.init = "" }
                     F.def { F.delay = 500 }
       repeatFor 2000 $ F.send trig "abc"
@@ -143,7 +145,7 @@ spec = do
       output_events `shouldSatisfy` ((> 2) . length)
   describe "forStack" $ do
     it "creates a stacked FoldDebounce" $ do
-      output <- atomically $ newTChan
+      output <- atomically newTChan
       trig <- F.new (F.forStack $ callbackToTChan output)
                     F.def { F.delay = 50000 }
       F.send trig 10
@@ -153,7 +155,7 @@ spec = do
       F.close trig
   describe "forMonoid" $ do
     it "creates a FoldDebounce for Monoids" $ do
-      output <- atomically $ newTChan
+      output <- atomically newTChan
       trig <- F.new (F.forMonoid $ callbackToTChan output)
                     F.def { F.delay = 50000 }
       F.send trig [10]
@@ -163,7 +165,7 @@ spec = do
       F.close trig
   describe "forVoid" $ do
     it "discards input events, but starts the timer" $ do
-      output <- atomically $ newTChan
+      output <- atomically newTChan
       trig <- F.new (F.forVoid $ callbackToTChan output "hoge")
               F.def { F.delay = 50000 }
       F.send trig "foo1"