inter-hub-haskell/Web/Controller/AnnotationThreads.hs

module Web.Controller.AnnotationThreads where

import Web.Types
import Web.View.AnnotationThreads.Index
import Web.View.AnnotationThreads.New
import Web.View.AnnotationThreads.Show
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude

instance Controller AnnotationThreadsController where
    beforeAction = ensureIsUser

    action WidgetAnnotationThreadsAction { widgetId } = do
        widget  <- fetch widgetId
        threads <- query @AnnotationThread
            |> filterWhere (#widgetId, widgetId)
            |> orderByDesc #createdAt
            |> fetch
        -- Fetch annotation counts per thread
        allAnnotations <- query @Annotation
            |> filterWhere (#widgetId, widgetId)
            |> fetch
        render IndexView { widget, threads, allAnnotations }

    action ShowAnnotationThreadAction { annotationThreadId } = do
        thread      <- fetch annotationThreadId
        widget      <- fetch thread.widgetId
        annotations <- query @Annotation
            |> filterWhere (#threadId, Just annotationThreadId)
            |> orderByAsc #createdAt
            |> fetch
        render ShowView { widget, thread, annotations }

    action NewAnnotationThreadAction { widgetId } = do
        widget <- fetch widgetId
        let thread = newRecord @AnnotationThread
        render NewView { widget, thread }

    action CreateAnnotationThreadAction { widgetId } = do
        widget <- fetch widgetId
        let mUser  = currentUserOrNothing
        let createdBy = fmap (.id) mUser

        let thread = newRecord @AnnotationThread
        thread
            |> fill @'["title", "description"]
            |> set #widgetId widgetId
            |> set #createdBy createdBy
            |> validateField #title nonEmpty
            |> ifValid \case
                Left thread  -> render NewView { widget, thread }
                Right thread -> do
                    createRecord thread
                    setSuccessMessage "Thread created"
                    redirectTo WidgetAnnotationThreadsAction { widgetId }

    action AssignAnnotationToThreadAction { annotationId } = do
        annotation <- fetch annotationId
        let threadId = param @(Id AnnotationThread) "threadId"
        annotation
            |> set #threadId (Just threadId)
            |> updateRecord
        setSuccessMessage "Annotation added to thread"
        redirectTo ShowAnnotationThreadAction { annotationThreadId = threadId }