From 88bf70dcd071585f5438223eeeeebd11bade1ee6 Mon Sep 17 00:00:00 2001 From: Jade Date: Sun, 16 Jun 2024 13:38:53 +0200 Subject: [PATCH] Fix warnings --- src/Network/MPD/Applicative/Internal.hs | 3 +-- src/Network/MPD/Commands/Query.hs | 14 +++++++------- src/Network/MPD/Core.hs | 22 +++++++--------------- tests/StringConn.hs | 1 + 4 files changed, 16 insertions(+), 24 deletions(-) diff --git a/src/Network/MPD/Applicative/Internal.hs b/src/Network/MPD/Applicative/Internal.hs index d281942..7a6c261 100644 --- a/src/Network/MPD/Applicative/Internal.hs +++ b/src/Network/MPD/Applicative/Internal.hs @@ -45,14 +45,13 @@ newtype Parser a deriving Functor instance Monad Parser where - return a = Parser $ \input -> Right (a, input) p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2) instance Fail.MonadFail Parser where fail = Prelude.fail instance Applicative Parser where - pure = return + pure a = Parser $ \input -> Right (a, input) (<*>) = ap -- | Convert a regular parser. diff --git a/src/Network/MPD/Commands/Query.hs b/src/Network/MPD/Commands/Query.hs index 98a9491..2cfcf94 100644 --- a/src/Network/MPD/Commands/Query.hs +++ b/src/Network/MPD/Commands/Query.hs @@ -77,15 +77,15 @@ toExpr (m:ms) = ExprAnd (Exact m) (toExpr ms) instance Monoid Query where mempty = Query [] - Query a `mappend` Query b = Query (a ++ b) - Query [] `mappend` Filter b = Filter b - Filter a `mappend` Query [] = Filter a - Query a `mappend` Filter b = Filter (ExprAnd (toExpr a) b) - Filter a `mappend` Query b = Filter (ExprAnd a (toExpr b)) - Filter a `mappend` Filter b = Filter (a <> b) instance Semigroup Query where - (<>) = mappend + Query a <> Query b = Query (a ++ b) + Query [] <> Filter b = Filter b + Filter a <> Query [] = Filter a + Query a <> Filter b = Filter (ExprAnd (toExpr a) b) + Filter a <> Query b = Filter (ExprAnd a (toExpr b)) + Filter a <> Filter b = Filter (a <> b) + instance Semigroup Expr where ex1 <> ex2 = ExprAnd ex1 ex2 diff --git a/src/Network/MPD/Core.hs b/src/Network/MPD/Core.hs index eb78bb6..58197b8 100644 --- a/src/Network/MPD/Core.hs +++ b/src/Network/MPD/Core.hs @@ -28,7 +28,7 @@ import Network.MPD.Core.Error import Data.Char (isDigit) import qualified Control.Exception as E import Control.Exception.Safe (catch, catchAny) -import Control.Monad (ap, unless) +import Control.Monad (unless) import Control.Monad.Except (ExceptT(..),runExceptT, MonadError(..)) import Control.Monad.Reader (ReaderT(..), ask) import Control.Monad.State (StateT, MonadIO(..), modify, gets, evalStateT) @@ -54,7 +54,6 @@ import System.IO.Error (isEOFError, tryIOError, ioeGetErrorType) import Text.Printf (printf) import qualified GHC.IO.Exception as GE -import qualified Prelude import Prelude hiding (break, drop, dropWhile, read) import Data.ByteString.Char8 (ByteString, isPrefixOf, break, drop, dropWhile) import qualified Data.ByteString.Char8 as B @@ -85,11 +84,7 @@ newtype MPD a = MPD { runMPD :: ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a - } deriving (Functor, Monad, MonadIO, MonadError MPDError) - -instance Applicative MPD where - (<*>) = ap - pure = return + } deriving (Functor, Applicative, Monad, MonadIO, MonadError MPDError) instance MonadMPD MPD where open = mpdOpen @@ -140,10 +135,9 @@ mpdOpen = MPD $ do `catchAny` const (return Nothing) checkConn = do singleMsg <- send "" - let [msg] = singleMsg - if "OK MPD" `isPrefixOf` msg - then MPD $ checkVersion $ parseVersion msg - else return False + case singleMsg of + [msg] | "OK MPD" `isPrefixOf` msg -> MPD $ checkVersion $ parseVersion msg + _ -> pure False checkVersion Nothing = throwError $ Custom "Couldn't determine MPD version" checkVersion (Just version) @@ -234,12 +228,10 @@ getResponse cmd = (send cmd >>= parseResponse) `catchError` sendpw -- Consume response and return a Response. parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString] -parseResponse xs - | null xs = throwError $ NoMPD +parseResponse [] = throwError $ NoMPD +parseResponse xs@(x : _) | "ACK" `isPrefixOf` x = throwError $ parseAck x | otherwise = return $ Prelude.takeWhile ("OK" /=) xs - where - x = head xs -- Turn MPD ACK into the corresponding 'MPDError' parseAck :: ByteString -> MPDError diff --git a/tests/StringConn.hs b/tests/StringConn.hs index a416628..1fe597b 100644 --- a/tests/StringConn.hs +++ b/tests/StringConn.hs @@ -14,6 +14,7 @@ module StringConn where import Control.Applicative import Prelude hiding (exp) import Control.Monad.Except +import Control.Monad import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State