module Application.Helper.CrossHubPropagation where

import IHP.Prelude
import IHP.ModelSupport
import IHP.QueryBuilder
import IHP.Fetch
import Generated.Types
import Web.Routes ()
import Data.Time.Clock (addUTCTime, getCurrentTime)
import Data.Aeson (toJSON)
import qualified Data.List as List

-- | Detect cross-hub propagation patterns and insert CrossHubPropagation rows.
-- Idempotent: skips patterns for which an open/acknowledged record already exists.
detectPropagations
    :: (?modelContext :: ModelContext)
    => [Hub]
    -> [Annotation]    -- all annotations across all hubs, widget already resolved
    -> [Widget]        -- all widgets (to map widgetId → hubId)
    -> [FrictionScore] -- all friction scores
    -> IO [CrossHubPropagation]
detectPropagations hubs annotations widgets frictionScores = do
    now <- getCurrentTime
    let fourteenDaysAgo = addUTCTime (negate $ 14 * 86400) now

    existing <- query @CrossHubPropagation
        |> filterWhereSql (#status, "IN ('open','acknowledged')")
        |> fetch

    -- Helper: find hub for a widget
    let widgetHub wid = (.hubId) <$> find (\w -> w.id == wid) widgets

    -- Heuristic 1: annotation category clustering
    -- For each category, count distinct hubs with ≥3 annotations in last 14 days
    let recentAnnotations = filter (\a -> a.createdAt >= fourteenDaysAgo) annotations
        categories = List.nub (map (.category) recentAnnotations)
        clusterPropagations = do
            cat <- categories
            let catAnnots = filter (\a -> a.category == cat) recentAnnotations
                hubCounts = map (\hid -> (hid, length (filter (\a -> widgetHub a.widgetId == Just hid) catAnnots)))
                            (List.nub (mapMaybe (\a -> widgetHub a.widgetId) catAnnots))
                qualHubs  = [ hid | (hid, cnt) <- hubCounts, cnt >= 3 ]
            guard (length qualHubs >= 2)
            let srcHub = head qualHubs
                summary = "Annotation category '" <> cat <> "' concentrated in "
                        <> show (length qualHubs) <> " hubs"
            -- Skip if open/acknowledged record already exists with same summary
            guard (not (any (\p -> p.patternType == "annotation_cluster" && p.summary == summary) existing))
            pure (srcHub, qualHubs, "annotation_cluster", summary)

    -- Heuristic 2: widget type friction across hubs
    let widgetTypes = List.nub (map (.widgetType) widgets)
        frictionThreshold = 40 :: Int
        frictionPropagations = do
            wtype <- widgetTypes
            let typeWidgets = filter (\w -> w.widgetType == wtype) widgets
                hubsWithHighFriction =
                    List.nub
                    [ w.hubId
                    | w <- typeWidgets
                    , Just fs <- [find (\f -> f.widgetId == w.id) frictionScores]
                    , fs.score >= frictionThreshold
                    ]
            guard (length hubsWithHighFriction >= 2)
            let srcHub  = 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))
            pure (srcHub, hubsWithHighFriction, "widget_type_friction", summary)

    let allPatterns = clusterPropagations <> frictionPropagations

    mapM (\(srcHubId, affectedHubIds, ptype, summary) ->
        newRecord @CrossHubPropagation
            |> set #patternType    ptype
            |> set #sourceHubId   (Just srcHubId)
            |> set #affectedHubIds (toJSON (map show affectedHubIds))
            |> set #summary        summary
            |> set #status         "open"
            |> createRecord
        ) allPatterns