inter-hub-haskell/Web/Controller/Api/V2/Learning.hs

module Web.Controller.Api.V2.Learning where

-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T08)

import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (object, (.=))
import Web.Controller.Api.V2.Auth (requireApiConsumer, paginatedResponse, getPageParams)
import IHP.ModelSupport (sqlQuery)

instance Controller ApiV2LearningController where

    action ApiV2IndexOutcomeCorrelationsAction = do
        _consumer <- requireApiConsumer
        let mHubId    = paramOrNothing @(Id Hub) "hub_id"
            mCat      = paramOrNothing @Text "category"
        (page, perPage) <- getPageParams
        let off = (page - 1) * perPage
        baseQuery <- pure $ query @OutcomeCorrelation
        filtered  <- pure $ case mHubId of
            Nothing  -> baseQuery
            Just hid -> baseQuery |> filterWhere (#hubId, hid)
        filteredCat <- pure $ case mCat of
            Nothing  -> filtered
            Just cat -> filtered |> filterWhere (#annotationCategory, cat)
        total <- filteredCat |> fetchCount
        rows  <- filteredCat |> orderByDesc #correlationScore |> limit perPage |> offset off |> fetch
        renderJson $ paginatedResponse (map correlationToJson rows) page perPage total

    action ApiV2IndexPatternPerformanceAction = do
        _consumer <- requireApiConsumer
        (page, perPage) <- getPageParams
        let off = (page - 1) * perPage
        total <- query @PatternPerformanceRecord |> fetchCount
        rows  <- query @PatternPerformanceRecord
            |> orderByAsc #outcomeRank
            |> limit perPage
            |> offset off
            |> fetch
        renderJson $ paginatedResponse (map patternPerfToJson rows) page perPage total

    action ApiV2IndexKnowledgeBaseAction = do
        _consumer <- requireApiConsumer
        let mQ        = paramOrNothing @Text "q"
        (page, perPage) <- getPageParams
        let off = (page - 1) * perPage
        rows <- case mQ of
            Nothing -> query @InstitutionalKnowledgeEntry
                |> orderByDesc #createdAt
                |> limit perPage
                |> offset off
                |> fetch
            Just q  -> sqlQuery
                "SELECT * FROM institutional_knowledge_entries \
                \ WHERE summary_tsv @@ plainto_tsquery('english', ?) \
                \ ORDER BY ts_rank(summary_tsv, plainto_tsquery('english', ?)) DESC \
                \ LIMIT ? OFFSET ?"
                (q, q, perPage, off)
        renderJson (map knowledgeToJson rows)

    action ApiV2ShowKnowledgeBaseAction { knowledgeEntryId } = do
        _consumer <- requireApiConsumer
        entry <- fetch knowledgeEntryId
        renderJson (knowledgeToJson entry)

correlationToJson :: OutcomeCorrelation -> Value
correlationToJson c = object
    [ "id"                 .= c.id
    , "hubId"              .= c.hubId
    , "annotationCategory" .= c.annotationCategory
    , "correlationType"    .= c.correlationType
    , "correlationScore"   .= c.correlationScore
    , "sampleCount"        .= c.sampleCount
    , "computedAt"         .= c.computedAt
    ]

patternPerfToJson :: PatternPerformanceRecord -> Value
patternPerfToJson r =
    let positiveRate = if r.totalOutcomeCount > 0
            then fromIntegral r.positiveOutcomeCount / fromIntegral r.totalOutcomeCount :: Double
            else 0.0
    in object
        [ "id"                  .= r.id
        , "widgetPatternId"     .= r.widgetPatternId
        , "hubId"               .= r.hubId
        , "adoptionCount"       .= r.adoptionCount
        , "positiveOutcomeCount" .= r.positiveOutcomeCount
        , "totalOutcomeCount"   .= r.totalOutcomeCount
        , "positiveOutcomeRate" .= positiveRate
        , "meanOutcomeValue"    .= r.meanOutcomeValue
        , "outcomeRank"         .= r.outcomeRank
        , "calibratedAt"        .= r.calibratedAt
        ]

knowledgeToJson :: InstitutionalKnowledgeEntry -> Value
knowledgeToJson e = object
    [ "id"               .= e.id
    , "hubId"            .= e.hubId
    , "decisionRecordId" .= e.decisionRecordId
    , "summary"          .= e.summary
    , "tags"             .= e.tags
    , "createdAt"        .= e.createdAt
    , "updatedAt"        .= e.updatedAt
    ]