From 58cad3104269a3751e53165aaebabe27dae8b5af Mon Sep 17 00:00:00 2001 From: Bernd Worsch Date: Sat, 11 Apr 2026 08:37:04 +0000 Subject: [PATCH] fix(WP-0017/E1): Layer 2 + Sessions fixes - CrossHubPropagation: IHP.Prelude.head returns Maybe a; use List.head (Data.List.head, already imported qualified) for non-empty-guarded lists - Sessions: currentUserOrNothing is pure Maybe, not IO; use case...of instead of >>= Co-Authored-By: Claude Sonnet 4.6 --- Application/Helper/CrossHubPropagation.hs | 4 ++-- Web/Controller/Sessions.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Application/Helper/CrossHubPropagation.hs b/Application/Helper/CrossHubPropagation.hs index 5477978..17c589a 100644 --- a/Application/Helper/CrossHubPropagation.hs +++ b/Application/Helper/CrossHubPropagation.hs @@ -42,7 +42,7 @@ detectPropagations hubs annotations widgets frictionScores = do (List.nub (mapMaybe (\a -> widgetHub a.widgetId) catAnnots)) qualHubs = [ hid | (hid, cnt) <- hubCounts, cnt >= 3 ] guard (length qualHubs >= 2) - let srcHub = head qualHubs + let srcHub = List.head qualHubs summary = "Annotation category '" <> cat <> "' concentrated in " <> show (length qualHubs) <> " hubs" -- Skip if open/acknowledged record already exists with same summary @@ -63,7 +63,7 @@ detectPropagations hubs annotations widgets frictionScores = do , fs.score >= frictionThreshold ] guard (length hubsWithHighFriction >= 2) - let srcHub = head hubsWithHighFriction + let srcHub = List.head hubsWithHighFriction summary = "Widget type '" <> wtype <> "' has high friction in " <> show (length hubsWithHighFriction) <> " hubs" guard (not (any (\p -> p.patternType == "widget_type_friction" && p.summary == summary) existing)) diff --git a/Web/Controller/Sessions.hs b/Web/Controller/Sessions.hs index ce8b45f..26463ac 100644 --- a/Web/Controller/Sessions.hs +++ b/Web/Controller/Sessions.hs @@ -27,7 +27,7 @@ instance Controller SessionsController where redirectTo NewSessionAction action DeleteSessionAction = do - currentUserOrNothing @User >>= \case + case currentUserOrNothing @User of Just user -> logout user >> redirectTo NewSessionAction Nothing -> redirectTo NewSessionAction