module Web.Controller.Widgets where import Web.Types import Web.View.Widgets.Index import Web.View.Widgets.Show import Web.View.Widgets.New import Web.View.Widgets.Edit import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (toJSON, object, (.=)) instance Controller WidgetsController where beforeAction = ensureIsUser action WidgetsAction = do widgets <- query @Widget |> orderByAsc #name |> fetch hubs <- query @Hub |> fetch render IndexView { widgets, hubs } action NewWidgetAction = do let widget = newRecord @Widget hubs <- query @Hub |> fetch render NewView { widget, hubs } action ShowWidgetAction { widgetId } = do widget <- fetch widgetId hub <- fetch widget.hubId versions <- query @WidgetVersion |> filterWhere (#widgetId, widgetId) |> orderByDesc #version |> fetch events <- query @InteractionEvent |> filterWhere (#widgetId, widgetId) |> orderByDesc #occurredAt |> limit 20 |> fetch annotations <- query @Annotation |> filterWhere (#widgetId, widgetId) |> orderByAsc #createdAt |> fetch render ShowView { widget, hub, versions, events, annotations } action CreateWidgetAction = do let widget = newRecord @Widget hubs <- query @Hub |> fetch widget |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status"] |> validateField #name nonEmpty |> validateField #widgetType nonEmpty |> ifValid \case Left widget -> render NewView { widget, hubs } Right widget -> do widget <- createRecord widget let snapshot = object [ "name" .= widget.name , "widget_type" .= widget.widgetType , "hub_id" .= widget.hubId , "capability_ref" .= widget.capabilityRef , "view_context" .= widget.viewContext , "policy_scope" .= widget.policyScope , "status" .= widget.status , "version" .= widget.version ] newRecord @WidgetVersion |> set #widgetId widget.id |> set #version 1 |> set #schemaSnapshot snapshot |> createRecord setSuccessMessage "Widget registered" redirectTo ShowWidgetAction { widgetId = widget.id } action EditWidgetAction { widgetId } = do widget <- fetch widgetId hubs <- query @Hub |> fetch render EditView { widget, hubs } action UpdateWidgetAction { widgetId } = do widget <- fetch widgetId hubs <- query @Hub |> fetch widget |> fill @'["name", "widgetType", "hubId", "capabilityRef", "viewContext", "policyScope", "status"] |> validateField #name nonEmpty |> validateField #widgetType nonEmpty |> ifValid \case Left widget -> render EditView { widget, hubs } Right widget -> do let newVersion = widget.version + 1 widget <- widget |> set #version newVersion |> updateRecord let snapshot = object [ "name" .= widget.name , "widget_type" .= widget.widgetType , "hub_id" .= widget.hubId , "capability_ref" .= widget.capabilityRef , "view_context" .= widget.viewContext , "policy_scope" .= widget.policyScope , "status" .= widget.status , "version" .= newVersion ] newRecord @WidgetVersion |> set #widgetId widget.id |> set #version newVersion |> set #schemaSnapshot snapshot |> createRecord setSuccessMessage "Widget updated" redirectTo ShowWidgetAction { widgetId = widget.id }