module Web.Controller.TypeRegistries where import Web.Types import Web.View.TypeRegistries.WidgetTypes import Web.View.TypeRegistries.EventTypes import Web.View.TypeRegistries.AnnotationCategories import Web.View.TypeRegistries.PolicyScopes import Generated.Types import IHP.Prelude import IHP.ControllerPrelude instance Controller TypeRegistriesController where beforeAction = ensureIsUser -- ── Widget Types ───────────────────────────────────────────────────────── action WidgetTypeRegistryAction = do entries <- query @WidgetTypeRegistry |> orderByAsc #label |> fetch hubs <- query @Hub |> fetch render WidgetTypesView { entries, hubs } action ShowWidgetTypeAction { widgetTypeRegistryId } = do entry <- fetch widgetTypeRegistryId mOwner <- case entry.ownerHubId of Nothing -> pure Nothing Just hid -> fmap Just (fetch hid) render ShowWidgetTypeView { entry, mOwner } action NewWidgetTypeAction = do let entry = newRecord @WidgetTypeRegistry hubs <- query @Hub |> fetch render NewWidgetTypeView { entry, hubs } action CreateWidgetTypeAction = do let entry = newRecord @WidgetTypeRegistry hubs <- query @Hub |> fetch entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty |> validateField #label nonEmpty |> ifValid \case Left entry -> render NewWidgetTypeView { entry, hubs } Right entry -> do createRecord entry setSuccessMessage ("Widget type '" <> entry.name <> "' registered") redirectTo WidgetTypeRegistryAction action EditWidgetTypeAction { widgetTypeRegistryId } = do entry <- fetch widgetTypeRegistryId hubs <- query @Hub |> fetch render EditWidgetTypeView { entry, hubs } action UpdateWidgetTypeAction { widgetTypeRegistryId } = do entry <- fetch widgetTypeRegistryId hubs <- query @Hub |> fetch -- name is immutable after creation entry |> fill @'["label", "description", "ownerHubId"] |> validateField #label nonEmpty |> ifValid \case Left entry -> render EditWidgetTypeView { entry, hubs } Right entry -> do updateRecord entry setSuccessMessage "Widget type updated" redirectTo WidgetTypeRegistryAction action DeprecateWidgetTypeAction { widgetTypeRegistryId } = do entry <- fetch widgetTypeRegistryId replacedBy <- param @Text "deprecated_in_favour_of" when (null replacedBy) do setErrorMessage "You must specify the replacement type name" redirectTo WidgetTypeRegistryAction entry |> set #status "deprecated" |> set #deprecatedInFavourOf (Just replacedBy) |> updateRecord setSuccessMessage ("Widget type '" <> entry.name <> "' deprecated") redirectTo WidgetTypeRegistryAction -- ── Event Types ────────────────────────────────────────────────────────── action EventTypeRegistryAction = do entries <- query @EventTypeRegistry |> orderByAsc #label |> fetch hubs <- query @Hub |> fetch render EventTypesView { entries, hubs } action ShowEventTypeAction { eventTypeRegistryId } = do entry <- fetch eventTypeRegistryId mOwner <- case entry.ownerHubId of Nothing -> pure Nothing Just hid -> fmap Just (fetch hid) render ShowEventTypeView { entry, mOwner } action NewEventTypeAction = do let entry = newRecord @EventTypeRegistry hubs <- query @Hub |> fetch render NewEventTypeView { entry, hubs } action CreateEventTypeAction = do let entry = newRecord @EventTypeRegistry hubs <- query @Hub |> fetch entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty |> validateField #label nonEmpty |> ifValid \case Left entry -> render NewEventTypeView { entry, hubs } Right entry -> do createRecord entry setSuccessMessage ("Event type '" <> entry.name <> "' registered") redirectTo EventTypeRegistryAction action EditEventTypeAction { eventTypeRegistryId } = do entry <- fetch eventTypeRegistryId hubs <- query @Hub |> fetch render EditEventTypeView { entry, hubs } action UpdateEventTypeAction { eventTypeRegistryId } = do entry <- fetch eventTypeRegistryId hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] |> validateField #label nonEmpty |> ifValid \case Left entry -> render EditEventTypeView { entry, hubs } Right entry -> do updateRecord entry setSuccessMessage "Event type updated" redirectTo EventTypeRegistryAction action DeprecateEventTypeAction { eventTypeRegistryId } = do entry <- fetch eventTypeRegistryId replacedBy <- param @Text "deprecated_in_favour_of" when (null replacedBy) do setErrorMessage "You must specify the replacement type name" redirectTo EventTypeRegistryAction entry |> set #status "deprecated" |> set #deprecatedInFavourOf (Just replacedBy) |> updateRecord setSuccessMessage ("Event type '" <> entry.name <> "' deprecated") redirectTo EventTypeRegistryAction -- ── Annotation Categories ──────────────────────────────────────────────── action AnnotationCategoryRegistryAction = do entries <- query @AnnotationCategoryRegistry |> orderByAsc #label |> fetch hubs <- query @Hub |> fetch render AnnotationCategoriesView { entries, hubs } action ShowAnnotationCategoryAction { annotationCategoryRegistryId } = do entry <- fetch annotationCategoryRegistryId mOwner <- case entry.ownerHubId of Nothing -> pure Nothing Just hid -> fmap Just (fetch hid) render ShowAnnotationCategoryView { entry, mOwner } action NewAnnotationCategoryAction = do let entry = newRecord @AnnotationCategoryRegistry hubs <- query @Hub |> fetch render NewAnnotationCategoryView { entry, hubs } action CreateAnnotationCategoryAction = do let entry = newRecord @AnnotationCategoryRegistry hubs <- query @Hub |> fetch entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty |> validateField #label nonEmpty |> ifValid \case Left entry -> render NewAnnotationCategoryView { entry, hubs } Right entry -> do createRecord entry setSuccessMessage ("Annotation category '" <> entry.name <> "' registered") redirectTo AnnotationCategoryRegistryAction action EditAnnotationCategoryAction { annotationCategoryRegistryId } = do entry <- fetch annotationCategoryRegistryId hubs <- query @Hub |> fetch render EditAnnotationCategoryView { entry, hubs } action UpdateAnnotationCategoryAction { annotationCategoryRegistryId } = do entry <- fetch annotationCategoryRegistryId hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] |> validateField #label nonEmpty |> ifValid \case Left entry -> render EditAnnotationCategoryView { entry, hubs } Right entry -> do updateRecord entry setSuccessMessage "Annotation category updated" redirectTo AnnotationCategoryRegistryAction action DeprecateAnnotationCategoryAction { annotationCategoryRegistryId } = do entry <- fetch annotationCategoryRegistryId replacedBy <- param @Text "deprecated_in_favour_of" when (null replacedBy) do setErrorMessage "You must specify the replacement category name" redirectTo AnnotationCategoryRegistryAction entry |> set #status "deprecated" |> set #deprecatedInFavourOf (Just replacedBy) |> updateRecord setSuccessMessage ("Annotation category '" <> entry.name <> "' deprecated") redirectTo AnnotationCategoryRegistryAction -- ── Policy Scopes ──────────────────────────────────────────────────────── action PolicyScopeRegistryAction = do entries <- query @PolicyScopeRegistry |> orderByAsc #label |> fetch hubs <- query @Hub |> fetch render PolicyScopesView { entries, hubs } action ShowPolicyScopeAction { policyScopeRegistryId } = do entry <- fetch policyScopeRegistryId mOwner <- case entry.ownerHubId of Nothing -> pure Nothing Just hid -> fmap Just (fetch hid) render ShowPolicyScopeView { entry, mOwner } action NewPolicyScopeAction = do let entry = newRecord @PolicyScopeRegistry hubs <- query @Hub |> fetch render NewPolicyScopeView { entry, hubs } action CreatePolicyScopeAction = do let entry = newRecord @PolicyScopeRegistry hubs <- query @Hub |> fetch entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty |> validateField #label nonEmpty |> ifValid \case Left entry -> render NewPolicyScopeView { entry, hubs } Right entry -> do createRecord entry setSuccessMessage ("Policy scope '" <> entry.name <> "' registered") redirectTo PolicyScopeRegistryAction action EditPolicyScopeAction { policyScopeRegistryId } = do entry <- fetch policyScopeRegistryId hubs <- query @Hub |> fetch render EditPolicyScopeView { entry, hubs } action UpdatePolicyScopeAction { policyScopeRegistryId } = do entry <- fetch policyScopeRegistryId hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] |> validateField #label nonEmpty |> ifValid \case Left entry -> render EditPolicyScopeView { entry, hubs } Right entry -> do updateRecord entry setSuccessMessage "Policy scope updated" redirectTo PolicyScopeRegistryAction action DeprecatePolicyScopeAction { policyScopeRegistryId } = do entry <- fetch policyScopeRegistryId replacedBy <- param @Text "deprecated_in_favour_of" when (null replacedBy) do setErrorMessage "You must specify the replacement scope name" redirectTo PolicyScopeRegistryAction entry |> set #status "deprecated" |> set #deprecatedInFavourOf (Just replacedBy) |> updateRecord setSuccessMessage ("Policy scope '" <> entry.name <> "' deprecated") redirectTo PolicyScopeRegistryAction