inter-hub/Web/Controller/Annotations.hs

module Web.Controller.Annotations where

import Web.Types
import Web.View.Annotations.Index
import Web.View.Annotations.New
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude

validCategories :: [Text]
validCategories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"]

instance Controller AnnotationsController where
    beforeAction = ensureIsUser

    action WidgetAnnotationsAction { widgetId } = do
        widget      <- fetch widgetId
        annotations <- query @Annotation
            |> filterWhere (#widgetId, widgetId)
            |> orderByAsc #createdAt
            |> fetch
        render IndexView { widget, annotations }

    action NewAnnotationAction { widgetId } = do
        widget <- fetch widgetId
        let annotation = newRecord @Annotation
        render NewView { widget, annotation }

    action CreateAnnotationAction { widgetId } = do
        widget  <- fetch widgetId
        mUser   <- currentUserOrNothing
        let actorId   = fmap (.id) mUser
            actorType = maybe "anonymous" (const "user") mUser

        let annotation = newRecord @Annotation
        annotation
            |> fill @'["body", "category", "parentId", "widgetStateRef"]
            |> set #widgetId  widgetId
            |> set #actorId   (fmap (Id . unId) actorId)
            |> set #actorType actorType
            |> validateField #body nonEmpty
            |> validateField #category (`elem` validCategories)
            |> ifValid \case
                Left annotation -> render NewView { widget, annotation }
                Right annotation -> do
                    createRecord annotation
                    setSuccessMessage "Annotation added"
                    redirectTo WidgetAnnotationsAction { widgetId }