Clean hlint and cabal warnings

home-assistant-controller.cabal

@@ -52,7 +52,7 @@ extra-doc-files:    CHANGELOG.md
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -Wall -Werror
 
 library
     -- Import common warning flags.

src/AFRP.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE Arrows #-}
 
 module AFRP
   ( Mealy(..)
@@ -129,7 +128,7 @@ instance Monad m => Applicative (Auto m a) where
   pure a = Fun (\_req -> const a)
   fa <*> fb =
     case (fa,fb) of
-         (Fun af, Fun bf) -> Fun $ \req -> (af req <*> bf req)
+         (Fun af, Fun bf) -> Fun $ \req -> af req <*> bf req
          (Stateful codec s af, Fun bf) -> Stateful codec s
           (\s' req x -> do
            let a = bf req x
@@ -179,7 +178,7 @@ instance (Monad m, Monoid b) => Monoid (Auto m a b) where
 
 
 instance Monad m => Category (Auto m) where
-  id = Fun $ \_ -> id
+  id = Fun $ const id
   af . ag =
     case (af, ag) of
          (Fun f, Fun g) -> Fun (\req -> f req . g req)
@@ -272,8 +271,6 @@ instance Semigroup b => Semigroup (Mealy eff a b) where
 
 instance Monoid b => Monoid (Mealy eff a b) where
   mempty = Mealy mempty $ \_nt -> mempty
-    -- where
-    --   m = Mealy mempty $ \_ _ _ -> pure (Pair mempty m)
 
 eff :: (Request -> a -> eff b) -> Mealy eff a b
 eff f = Mealy mempty $ \nt -> do
@@ -288,7 +285,8 @@ withEntities :: S.Set T.Text -> Mealy eff a b -> Mealy eff a b
 withEntities es (Mealy _ f) = Mealy es f
 
 instance Category (Mealy eff) where
-  id = Mealy mempty (\_ -> id)
+  {- HLINT ignore "Use const" -}
+  id = Mealy mempty $ \_nt -> id
   (Mealy ast f) . (Mealy bst g) = Mealy (ast <> bst) $ \nt -> do
     f nt . g nt
 

src/HomeAssistant/Controller/Ruuvi.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedStrings #-}
 module HomeAssistant.Controller.Ruuvi
   ( Ruuvi(..)

src/HomeAssistant/Runtime/Connection.hs

@@ -36,10 +36,9 @@ import Data.UUID (toText)
 import AFRP (Request(..), Event(..))
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import HomeAssistant.Runtime.RateLimit (RateLimited, RateLimiter, runRateLimited)
-import Control.Monad.Catch (MonadCatch)
 import GHC.Stack (HasCallStack)
 import UnliftIO (MonadUnliftIO, race, withRunInIO)
-import Control.Monad.Catch (onException)
+import Control.Monad.Catch (MonadCatch, onException)
 
 -- | Connect, authenticate, subscribe, then receive and broadcast forever.
 -- Restarting this action reconnects. All setup sends happen before the

src/HomeAssistant/Runtime/Flags.hs

@@ -44,7 +44,7 @@ loadFlags rootPath allNames = do
   let path = rootPath </> "handlers.json"
   fileMap <- readFlagsFile path
   let defaults = M.fromList [(n, True) | n <- allNames]
-      initial = M.unionWith (\fileVal -> const fileVal) fileMap defaults
+      initial = M.unionWith const fileMap defaults
   tv <- liftIO $ newTVarIO initial
   lock <- liftIO $ newMVar ()
   pure Flags

src/HomeAssistant/Runtime/Graphing.hs

@@ -190,10 +190,10 @@ cfName = \case
 
 defArgs :: FilePath -> Series -> [String]
 defArgs rrdPath series =
-  [ "DEF:" ++ rawF ++ "=" ++ rrdPath ++ ":"
+  ( "DEF:" ++ rawF ++ "=" ++ rrdPath ++ ":"
       ++ srcDs source ++ ":" ++ cfName (srcCF source)
-  ]
+  )
-    ++ transformArgs
+    : transformArgs
   where
     source = serSource series
     alias = serAlias series

src/HttpServer.hs

@@ -43,7 +43,7 @@ data API mode = API
 
 
 getFlagsHandler :: Flags -> LoggingHandler (Map Text Bool)
-getFlagsHandler flags = allFlags flags
+getFlagsHandler = allFlags
 
 putFlagHandler :: Flags -> Text -> Bool -> LoggingHandler (Map Text Bool)
 putFlagHandler flags name val

test/AFRPLawsSpec.hs

@@ -12,6 +12,10 @@ import Support (fakeRequest)
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Hedgehog (forAll, forAllWith, hedgehog, (===))
 
+-- We are testing laws -> hlint warns about not using laws
+{-# ANN module "Hlint: ignore" #-}
+
+
 -- | Law tests for the Mealy instances. Two machines count as equal when
 -- they emit equal outputs on every input sequence, so each law runs both
 -- sides on generated inputs.

test/AFRPSpec.hs

@@ -19,6 +19,7 @@ import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 import Test.Hspec
 import Test.Hspec.Hedgehog
+import Data.Maybe (listToMaybe)
 
 fakeRequest :: Request
 fakeRequest = Request (sec 0) utc nil "test"
@@ -52,7 +53,7 @@ instance Functor St where
   fmap f (St g) = St $ \s -> let (a, s') = g s in (f a, s')
 
 instance Applicative St where
-  pure a = St (\s -> (a, s))
+  pure a = St (a,)
   St f <*> St x = St $ \s -> let (f', s') = f s; (a, s'') = x s' in (f' a, s'')
 
 instance Monad St where
@@ -165,7 +166,7 @@ lMergeSpec = describe "lMerge" $ do
 changesSpec :: Spec
 changesSpec = describe "changes" $ do
   it "first output is always Tick" $
-    runPure changes "hello" !! 0 `shouldBe` Tick
+    listToMaybe (runPure changes "hello") `shouldBe` Just Tick
 
   it "outputs Event only on value change" $
     runPure changes "aaaabbbcca"

test/BusSpec.hs

@@ -6,7 +6,7 @@ import AFRP (Request (..), Event (..))
 import Control.Concurrent.STM
   ( atomically
   , dupTChan
-  , isEmptyTChan
+
   , readTChan
   , writeTChan
   )
@@ -18,7 +18,6 @@ import HomeAssistant.Controller (HASSEff (..), Service (..), Target(..))
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Flags (loadFlags, setEnabled)
 import HomeAssistant.Runtime.Metrics (registerAppMetrics)
-import Control.Monad.IO.Class (liftIO)
 import Katip (Namespace (Namespace), runKatipContextT)
 import Katip.Monadic (runNoLoggingT)
 import Support (withTestLogEnv)

test/ConnectionSpec.hs

@@ -80,7 +80,5 @@ req n = Request (UTCTime (toEnum 0) (fromIntegral (0 :: Int))) utc
     uuid = "00000000-0000-0000-0000-" <> pad n
 
 lightOn :: [Target] -> Service
-lightOn targets = Service "light" "turn_on" Nothing targets
+lightOn = Service "light" "turn_on" Nothing
 
-lightOff :: [Target] -> Service
-lightOff targets = Service "light" "turn_off" Nothing targets

test/ControllerSpec.hs

@@ -4,7 +4,6 @@ import Test.Hspec
 import Data.Default (def)
 import HomeAssistant.Controller (Brightness(..), formatLightAttributes, LightAttributes(..))
 import Data.Aeson (object, (.=))
-import HomeAssistant.Controller ()
 
 
 spec :: Spec

test/FlagsSpec.hs

@@ -70,7 +70,7 @@ spec = describe "Flags" $ do
         n <- forAll $ Gen.int (Range.linear 1 50)
         liftIO $ withTempDirectory "/tmp" "flags-spec" $ \dir -> do
           flags <- runNoLoggingT (loadFlags dir ["x"])
-          mapConcurrently_ (\i -> setEnabled flags "x" (even i)) [1 .. n]
+          mapConcurrently_ (setEnabled flags "x" . even) [1 .. n]
           m <- allFlags flags
           decoded <- decodeFileStrict (dir <> "/handlers.json")
           (decoded :: Maybe (Map Text Bool)) `shouldBe` Just m

test/GraphingSpec.hs

@@ -7,6 +7,7 @@ import qualified Data.ByteString as BS
 import HomeAssistant.Runtime.Graphing
   ( GraphSpec (..)
   , Range (..)
+  , Graph(..)
   , buildGraphArgs
   , graphs
   , lookupGraph
@@ -21,7 +22,6 @@ import System.Exit (ExitCode (..))
 import System.Process (readProcessWithExitCode)
 import Test.Hspec
 import Servant.API (FromHttpApiData(..), ToHttpApiData (..))
-import HomeAssistant.Runtime.Graphing (Graph(..))
 
 traffic :: GraphSpec
 traffic = case lookupGraph graphs Traffic of

test/MetricsSpec.hs

@@ -147,7 +147,7 @@ spec = do
       parseInfoDs "step = 10\nrra[0].cf = \"AVERAGE\"\n" `shouldBe` []
 
   describe "schemaMatches" $ do
-    let ds name ty = DsSpec (T.pack name) name ty
+    let ds name = DsSpec (T.pack name) name
     it "is true for identical schemas regardless of order" $
       schemaMatches [ds "b" Gauge, ds "a" Derive] [("a", Derive), ("b", Gauge)]
         `shouldBe` True

test/Support.hs

@@ -36,7 +36,7 @@ instance Functor Acc where
   fmap f (Acc g) = Acc $ \s -> let (a, s') = g s in (f a, s')
 
 instance Applicative Acc where
-  pure a = Acc (\s -> (a, s))
+  pure a = Acc (a,)
   Acc f <*> Acc x = Acc $ \s -> let (f', s') = f s; (a, s'') = x s' in (f' a, s'')
 
 instance Monad Acc where
@@ -52,6 +52,7 @@ withTestLogEnv = bracket (initLogEnv "test" "test") closeScribes
 -- | Interpret `HASSEff` in `Acc`: record `CallService`, drop tracing/debug.
 interp :: HASSEff a -> Acc a
 interp (CallService _ svc) = Acc $ \s -> ((), s ++ [svc])
+interp (CallServices _ svc) = Acc $ \s -> ((), s ++ svc)
 interp (Debug _) = pure ()
 interp (Trace _ _) = pure ()