From 53aced7714a58cfb3efc22478b7e44e722e6b0ac Mon Sep 17 00:00:00 2001 From: Stephan Barth Date: Mon, 23 Sep 2024 12:40:43 +0200 Subject: [PATCH] chore(versionbump): Removed redundant restrictions, fixed instances, ... --- src/Auth/Dummy.hs | 3 +-- src/Auth/LDAP.hs | 3 +-- src/Auth/PWHash.hs | 3 +-- src/Foundation/I18n/TH.hs | 8 ++++---- src/Handler/Utils/Files.hs | 4 ++-- src/Handler/Utils/Memcached.hs | 30 +++++++++++++++--------------- src/Utils/Exam/Correct.hs | 3 ++- 7 files changed, 26 insertions(+), 28 deletions(-) diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 06bf4985e..9f3c0cbc5 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -41,8 +41,7 @@ apDummy :: Text apDummy = "dummy" dummyLogin :: forall site. - ( YesodAuth site - , YesodPersist site + ( YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , RenderAFormSite site , RenderMessage site DummyMessage diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 329bb0a29..4b59c811e 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -197,8 +197,7 @@ apLdap :: Text apLdap = "LDAP" campusLogin :: forall site. - ( YesodAuth site - , RenderMessage site CampusMessage + ( RenderMessage site CampusMessage , RenderAFormSite site , RenderMessage site (ValueRequired site) , RenderMessage site ADInvalidCredentials diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index e857d8dcc..bde62bb5c 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -48,8 +48,7 @@ apHash :: Text apHash = "PWHash" hashLogin :: forall site. - ( YesodAuth site - , YesodPersist site + ( YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) , PersistRecordBackend User (YesodPersistBackend site) , RenderMessage site PWHashMessage diff --git a/src/Foundation/I18n/TH.hs b/src/Foundation/I18n/TH.hs index 66d3ac77a..e2349bf9a 100644 --- a/src/Foundation/I18n/TH.hs +++ b/src/Foundation/I18n/TH.hs @@ -88,7 +88,7 @@ disambiguateMsgFile MsgFile{..} | otherwise = Right $ MsgFile{ msgFileContent = fmap msgDefToSingletons <$> toSingletons msgFileContent, .. } where - toDuplicates :: forall k v. (Eq k, Hashable k) => InsOrdHashMap k (NonEmpty v) -> InsOrdHashSet k + toDuplicates :: forall k v. Hashable k => InsOrdHashMap k (NonEmpty v) -> InsOrdHashSet k toDuplicates = InsOrdHashSet.fromList . InsOrdHashMap.keys . InsOrdHashMap.filter (minLength 2) duplicateDefs = toDuplicates msgFileContent duplicateVars = InsOrdHashMap.mapMaybe (assertM' (not . InsOrdHashSet.null) . toDuplicates . msgDefVars . NonEmpty.head) msgFileContent @@ -120,17 +120,17 @@ ensureTypesMsgFile MsgFile{..} } -accumInsOrdHashMap :: (Foldable f, Eq k, Hashable k) +accumInsOrdHashMap :: (Foldable f, Hashable k) => f (k, v) -> InsOrdHashMap k (NonEmpty v) accumInsOrdHashMap = F.foldl' (\acc (k, v) -> InsOrdHashMap.insertWith (<>) k (pure v) acc) InsOrdHashMap.empty -unionsInsOrdHashMap :: (Foldable f, Eq k, Hashable k) +unionsInsOrdHashMap :: (Foldable f, Hashable k) => f (InsOrdHashMap k (NonEmpty v)) -> InsOrdHashMap k (NonEmpty v) unionsInsOrdHashMap = F.foldl' (InsOrdHashMap.unionWith (<>)) InsOrdHashMap.empty -insOrdHashMapKeysSet :: (Eq k, Hashable k) => InsOrdHashMap k v -> InsOrdHashSet k +insOrdHashMapKeysSet :: Hashable k => InsOrdHashMap k v -> InsOrdHashSet k insOrdHashMapKeysSet = InsOrdHashSet.fromList . map (view _1) . InsOrdHashMap.toList diff --git a/src/Handler/Utils/Files.hs b/src/Handler/Utils/Files.hs index 07b777643..5985a5ed1 100644 --- a/src/Handler/Utils/Files.hs +++ b/src/Handler/Utils/Files.hs @@ -271,8 +271,8 @@ respondFileConditional representationLastModified cType FileReference{..} = do ) | otherwise -> throwM SourceFilesContentUnavailable - | otherwise - -> return $ sendResponseStatus noContent204 () + {- | otherwise + -> return $ sendResponseStatus noContent204 ()*) -} -- rendundant, but only commented out in case that changes in the future where condInfo = RepresentationConditionalInformation { representationETag = review etagFileReference <$> fileReferenceContent diff --git a/src/Handler/Utils/Memcached.hs b/src/Handler/Utils/Memcached.hs index 706a56024..792d77107 100644 --- a/src/Handler/Utils/Memcached.hs +++ b/src/Handler/Utils/Memcached.hs @@ -398,7 +398,7 @@ memcachedByHere = do [e| \mExp k -> withMemcachedKeyedLoc (memcachedBy mExp (loc, k)) |] -data HashableDynamic = forall a. (Hashable a, Eq a) => HashableDynamic !(TypeRep a) !a +data HashableDynamic = forall a. Hashable a => HashableDynamic !(TypeRep a) !a instance Hashable HashableDynamic where hashWithSalt s (HashableDynamic tRep v) = s `hashWithSalt` tRep `hashWithSalt` v @@ -408,7 +408,7 @@ instance Eq HashableDynamic where Nothing -> False hashableDynamic :: forall a. - ( Typeable a, Hashable a, Eq a ) + ( Typeable a, Hashable a ) => a -> HashableDynamic hashableDynamic v = HashableDynamic (typeOf v) v @@ -418,7 +418,7 @@ memcachedLimit = unsafePerformIO . newTVarIO $ HashMap.empty memcachedLimitedWith :: ( MonadIO m , MonadLogger m - , Typeable k', Hashable k', Eq k' + , Typeable k', Hashable k' ) => (m (Maybe a), a -> m ()) -> (m a -> MaybeT m a) -- ^ Wrap execution on cache miss @@ -467,7 +467,7 @@ memcachedLimitedKey :: forall a k' m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , Typeable a, Binary a, NFData a - , Typeable k', Hashable k', Eq k' + , Typeable k', Hashable k' ) => k' -> Word64 -- ^ burst-size (tokens) @@ -497,7 +497,7 @@ memcachedLimitedKeyBy :: forall a k' k m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , Typeable a, Binary a, NFData a - , Typeable k', Hashable k', Eq k' + , Typeable k', Hashable k' , Binary k ) => k' @@ -612,7 +612,7 @@ liftAsyncTimeout :: forall k'' a m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadUnliftIO m , MonadThrow m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a ) => DiffTime @@ -665,7 +665,7 @@ liftAsyncTimeout dt (hashableDynamic -> cK) act = ifNotM memcachedAvailable (lif memcachedTimeoutWith :: ( MonadHandler m, HandlerSite m ~ UniWorX , MonadUnliftIO m , MonadThrow m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a ) => (m (Maybe a), a -> m ()) -> DiffTime -> k'' -> m a -> m (Maybe a) @@ -680,7 +680,7 @@ memcachedTimeoutWith (doGet, doSet) dt cK act = runMaybeT $ do memcachedTimeout :: ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a ) => Maybe Expiry -> DiffTime -> k'' -> m a -> m (Maybe a) @@ -689,7 +689,7 @@ memcachedTimeout mExp = memcachedTimeoutWith (memcachedGet, memcachedSet mExp) memcachedTimeoutBy :: ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a , Binary k ) @@ -710,7 +710,7 @@ memcachedLimitedTimeout :: forall a k'' m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a ) => Word64 -- ^ burst-size (tokens) @@ -727,9 +727,9 @@ memcachedLimitedKeyTimeout :: forall a k' k'' m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a - , Typeable k', Hashable k', Eq k' + , Typeable k', Hashable k' ) => k' -> Word64 -- ^ burst-size (tokens) @@ -746,7 +746,7 @@ memcachedLimitedTimeoutBy :: forall a k'' k m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a , Binary k ) @@ -765,9 +765,9 @@ memcachedLimitedKeyTimeoutBy :: forall a k' k'' k m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , MonadUnliftIO m - , Typeable k'', Hashable k'', Eq k'' + , Typeable k'', Hashable k'' , Typeable a, Binary a, NFData a - , Typeable k', Hashable k', Eq k' + , Typeable k', Hashable k' , Binary k ) => k' diff --git a/src/Utils/Exam/Correct.hs b/src/Utils/Exam/Correct.hs index ef9f52323..3a6b95433 100644 --- a/src/Utils/Exam/Correct.hs +++ b/src/Utils/Exam/Correct.hs @@ -11,6 +11,7 @@ module Utils.Exam.Correct import Import.NoFoundation import qualified Data.Aeson as JSON +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.HashMap.Strict as HashMap @@ -84,7 +85,7 @@ instance FromJSON CorrectInterfaceRequest where results <- o JSON..:? "results" ciqResults <- for results $ maybe (fail "Results may not be nullable") return . fromNullable ciqGrade <- if - | "grade" `HashMap.member` o + | "grade" `KeyMap.member` o -> Just <$> o JSON..: "grade" | otherwise -> pure Nothing