diff --git a/Web/Controller/Tasks.hs b/Web/Controller/Tasks.hs index 5c44e13..e2858d4 100644 --- a/Web/Controller/Tasks.hs +++ b/Web/Controller/Tasks.hs @@ -9,10 +9,13 @@ import Web.View.Tasks.Show instance Controller TasksController where action TasksAction = do tasks <- query @Task |> fetch + >>= collectionFetchRelated #tags render IndexView { .. } action NewTaskAction = do - let task = newRecord + let tags = [newRecord @Tag, newRecord @Tag] + let task = newRecord @Task + |> updateField @"tags" tags render NewView { .. } action ShowTaskAction { taskId } = do @@ -21,28 +24,62 @@ instance Controller TasksController where action EditTaskAction { taskId } = do task <- fetch taskId + >>= fetchRelated #tags render EditView { .. } action UpdateTaskAction { taskId } = do task <- fetch taskId + + let tagIds :: [Id Tag] = paramList "tags_id" + let tagNames :: [Text] = paramList "tags_name" + originalTags <- fetch tagIds + let tags = zip tagIds tagNames + |> map (\(id, name) -> originalTags + |> find (\tag -> tag.id == id) + |> fromMaybe (newRecord |> set #taskId task.id) + |> \tag -> buildTag tag name + ) + + task |> buildTask + |> updateField @"tags" tags + |> bubbleValidationResult #tags |> ifValid \case - Left task -> render EditView { .. } + Left task -> do + render EditView { task } Right task -> do - task <- task |> updateRecord + (task, tags) <- withTransaction do + task <- task + |> clearTags + |> updateRecord + tags <- mapM updateOrCreateRecord tags + pure (task, tags) + setSuccessMessage "Task updated" redirectTo EditTaskAction { .. } action CreateTaskAction = do let task = newRecord @Task + let names :: [Text] = paramList "tags_name" + let tags = names |> map (buildTag newRecord) + task |> buildTask + |> updateField @"tags" tags + |> bubbleValidationResult #tags |> ifValid \case - Left task -> render NewView { .. } - Right task -> do - task <- task |> createRecord - setSuccessMessage "Task created" + Left task -> render NewView { task } + Right taskAndTags -> do + (task, tags) <- withTransaction do + task <- taskAndTags |> clearTags |> createRecord + tags <- taskAndTags.tags + |> map (set #taskId task.id) + |> createMany + + pure (task, tags) + + setSuccessMessage "Task and Tags created" redirectTo TasksAction action DeleteTaskAction { taskId } = do @@ -53,3 +90,34 @@ instance Controller TasksController where buildTask task = task |> fill @'["description"] + |> validateField #description nonEmpty + +buildTag :: Tag -> Text -> Tag +buildTag tag name = tag + |> set #name name + |> validateField #name nonEmpty + +-- | Adds a validation error to the record when any of the child records is invalid +bubbleValidationResult :: forall fieldName record childRecord. + ( HasField "meta" record MetaBag + , SetField "meta" record MetaBag + , KnownSymbol fieldName + , HasField fieldName record [childRecord] + , HasField "meta" childRecord MetaBag + , SetField "meta" childRecord MetaBag + ) => Proxy fieldName -> record -> record +bubbleValidationResult field record = + if isEmpty childAnnotations + then record + else record |> attachFailure field "Invalid records" + where + childAnnotations :: [(Text, Violation)] + childAnnotations = get field record + |> map (\record -> record.meta.annotations) + |> concat + +updateOrCreateRecord record | isNew record = createRecord record +updateOrCreateRecord record = updateRecord record + +clearTags :: Include "tags" Task -> Task +clearTags task = updateField @"tags" (newRecord @Task).tags task \ No newline at end of file diff --git a/Web/View/Tasks/Edit.hs b/Web/View/Tasks/Edit.hs index 6853914..907e741 100644 --- a/Web/View/Tasks/Edit.hs +++ b/Web/View/Tasks/Edit.hs @@ -1,7 +1,8 @@ module Web.View.Tasks.Edit where import Web.View.Prelude +import Web.View.Tasks.New (renderForm) -data EditView = EditView { task :: Task } +data EditView = EditView { task :: Include "tags" Task } instance View EditView where html EditView { .. } = [hsx| @@ -13,11 +14,4 @@ instance View EditView where breadcrumb = renderBreadcrumb [ breadcrumbLink "Tasks" TasksAction , breadcrumbText "Edit Task" - ] - -renderForm :: Task -> Html -renderForm task = formFor task [hsx| - {(textField #description)} - {submitButton} - -|] \ No newline at end of file + ] \ No newline at end of file diff --git a/Web/View/Tasks/Index.hs b/Web/View/Tasks/Index.hs index 5f78343..70991b6 100644 --- a/Web/View/Tasks/Index.hs +++ b/Web/View/Tasks/Index.hs @@ -1,7 +1,7 @@ module Web.View.Tasks.Index where import Web.View.Prelude -data IndexView = IndexView { tasks :: [Task] } +data IndexView = IndexView { tasks :: [Include "tags" Task] } instance View IndexView where html IndexView { .. } = [hsx| @@ -26,12 +26,19 @@ instance View IndexView where [ breadcrumbLink "Tasks" TasksAction ] -renderTask :: Task -> Html +renderTask :: Include "tags" Task -> Html renderTask task = [hsx|