78 lines
3.8 KiB
Haskell
78 lines
3.8 KiB
Haskell
|
module Web.Controller.WidgetAdapterSpecs where
|
||
|
|
|
||
|
|
import Web.Types
|
||
|
|
import Web.View.WidgetAdapterSpecs.Index
|
||
|
|
import Web.View.WidgetAdapterSpecs.Show
|
||
|
|
import Web.View.WidgetAdapterSpecs.New
|
||
|
|
import Web.View.WidgetAdapterSpecs.Edit
|
||
|
|
import Generated.Types
|
||
|
|
import IHP.Prelude
|
||
|
|
import IHP.ControllerPrelude
|
||
|
|
|
||
|
|
instance Controller WidgetAdapterSpecsController where
|
||
|
|
beforeAction = ensureIsUser
|
||
|
|
|
||
|
|
action WidgetAdapterSpecsAction = do
|
||
|
|
specs <- query @WidgetAdapterSpec |> orderByAsc #name |> fetch
|
||
|
|
envelopes <- query @EnvelopeEmissionContract |> fetch
|
||
|
|
reportings <- query @InteractionReportingContract |> fetch
|
||
|
|
render IndexView { specs, envelopes, reportings }
|
||
|
|
|
||
|
|
action ShowWidgetAdapterSpecAction { widgetAdapterSpecId } = do
|
||
|
|
spec <- fetch widgetAdapterSpecId
|
||
|
|
mEnvelope <- case spec.envelopeContractId of
|
||
|
|
Nothing -> pure Nothing
|
||
|
|
Just eid -> fetchOneOrNothing eid
|
||
|
|
mReporting <- case spec.reportingContractId of
|
||
|
|
Nothing -> pure Nothing
|
||
|
|
Just rid -> fetchOneOrNothing rid
|
||
|
|
widgets <- query @Widget
|
||
|
|
|> filterWhere (#adapterSpecId, Just widgetAdapterSpecId)
|
||
|
|
|> orderByAsc #name
|
||
|
|
|> fetch
|
||
|
|
render ShowView { spec, mEnvelope, mReporting, widgets }
|
||
|
|
|
||
|
|
action NewWidgetAdapterSpecAction = do
|
||
|
|
let spec = newRecord @WidgetAdapterSpec
|
||
|
|
envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
render NewView { spec, envelopes, reportings }
|
||
|
|
|
||
|
|
action CreateWidgetAdapterSpecAction = do
|
||
|
|
let spec = newRecord @WidgetAdapterSpec
|
||
|
|
envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
spec
|
||
|
|
|> fill @'["name", "framework", "version", "envelopeContractId", "reportingContractId", "status", "notes"]
|
||
|
|
|> validateField #name nonEmpty
|
||
|
|
|> validateField #framework nonEmpty
|
||
|
|
|> validateField #version nonEmpty
|
||
|
|
|> validateField #status (isInList ["draft", "active", "deprecated"])
|
||
|
|
|> ifValid \case
|
||
|
|
Left spec -> render NewView { spec, envelopes, reportings }
|
||
|
|
Right spec -> do
|
||
|
|
spec <- createRecord spec
|
||
|
|
setSuccessMessage ("Adapter spec '" <> spec.name <> "' registered")
|
||
|
|
redirectTo ShowWidgetAdapterSpecAction { widgetAdapterSpecId = spec.id }
|
||
|
|
|
||
|
|
action EditWidgetAdapterSpecAction { widgetAdapterSpecId } = do
|
||
|
|
spec <- fetch widgetAdapterSpecId
|
||
|
|
envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
render EditView { spec, envelopes, reportings }
|
||
|
|
|
||
|
|
action UpdateWidgetAdapterSpecAction { widgetAdapterSpecId } = do
|
||
|
|
spec <- fetch widgetAdapterSpecId
|
||
|
|
envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch
|
||
|
|
-- Only status and notes are editable once a spec exists.
|
||
|
|
spec
|
||
|
|
|> fill @'["status", "notes"]
|
||
|
|
|> validateField #status (isInList ["draft", "active", "deprecated"])
|
||
|
|
|> ifValid \case
|
||
|
|
Left spec -> render EditView { spec, envelopes, reportings }
|
||
|
|
Right spec -> do
|
||
|
|
spec |> updateRecord
|
||
|
|
setSuccessMessage "Adapter spec updated"
|
||
|
|
redirectTo ShowWidgetAdapterSpecAction { widgetAdapterSpecId = spec.id }
|