diff --git a/Application/Migration/1712249898.sql b/Application/Migration/1712249898.sql new file mode 100644 index 0000000..2b9cefb --- /dev/null +++ b/Application/Migration/1712249898.sql @@ -0,0 +1 @@ +ALTER TABLE tags ADD COLUMN value TEXT NOT NULL; diff --git a/Application/Schema.sql b/Application/Schema.sql index f8fcad3..b1bc3ec 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -6,7 +6,8 @@ CREATE TABLE tasks ( CREATE TABLE tags ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, name TEXT NOT NULL, - task_id UUID NOT NULL + task_id UUID NOT NULL, + value TEXT NOT NULL ); CREATE INDEX tags_task_id_index ON tags (task_id); ALTER TABLE tags ADD CONSTRAINT tags_ref_task_id FOREIGN KEY (task_id) REFERENCES tasks (id) ON DELETE NO ACTION; diff --git a/Web/Controller/Tasks.hs b/Web/Controller/Tasks.hs index e2858d4..79278ee 100644 --- a/Web/Controller/Tasks.hs +++ b/Web/Controller/Tasks.hs @@ -32,15 +32,15 @@ instance Controller TasksController where let tagIds :: [Id Tag] = paramList "tags_id" let tagNames :: [Text] = paramList "tags_name" + let tagValues :: [Text] = paramList "tags_value" originalTags <- fetch tagIds - let tags = zip tagIds tagNames - |> map (\(id, name) -> originalTags + let tags = zip3 tagIds tagNames tagValues + |> map (\(id, name, value) -> originalTags |> find (\tag -> tag.id == id) |> fromMaybe (newRecord |> set #taskId task.id) - |> \tag -> buildTag tag name + |> \tag -> buildTag tag name value ) - task |> buildTask |> updateField @"tags" tags @@ -62,7 +62,8 @@ instance Controller TasksController where action CreateTaskAction = do let task = newRecord @Task let names :: [Text] = paramList "tags_name" - let tags = names |> map (buildTag newRecord) + let values :: [Text] = paramList "tags_value" + let tags = zip names values |> map (\(name, value) -> buildTag newRecord name value) task |> buildTask @@ -92,9 +93,10 @@ buildTask task = task |> fill @'["description"] |> validateField #description nonEmpty -buildTag :: Tag -> Text -> Tag -buildTag tag name = tag +buildTag :: Tag -> Text -> Text -> Tag +buildTag tag name value = tag |> set #name name + |> set #value value |> validateField #name nonEmpty -- | Adds a validation error to the record when any of the child records is invalid @@ -120,4 +122,4 @@ 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 +clearTags task = updateField @"tags" (newRecord @Task).tags task diff --git a/Web/View/Tasks/New.hs b/Web/View/Tasks/New.hs index e2f8a82..ffb28d4 100644 --- a/Web/View/Tasks/New.hs +++ b/Web/View/Tasks/New.hs @@ -1,4 +1,5 @@ module Web.View.Tasks.New where + import Web.View.Prelude import Text.Blaze.Html.Renderer.Text @@ -16,6 +17,7 @@ instance View NewView where [ breadcrumbLink "Tasks" TasksAction , breadcrumbText "New Task" ] + renderForm :: Include "tags" Task -> Html renderForm task = formFor task [hsx| {textField #description} @@ -42,4 +44,5 @@ prototypeFor field record = renderTagForm :: (?formContext :: FormContext Tag) => Html renderTagForm = [hsx| {(textField #name) { disableLabel = True, placeholder = "Tag name" } } + {(textField #value) { disableLabel = True, placeholder = "Tag value" } } |]