From 01657245580ae45b98e9d47f11acb0bebf9b8cbe Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Fri, 17 Nov 2023 12:16:54 +0200 Subject: [PATCH 1/4] Add Projects type --- Application/Schema.sql | 8 ++++++-- Web/Controller/Projects.hs | 28 ++++++++++++++++++++++++++++ Web/FrontController.hs | 2 ++ Web/Routes.hs | 3 +++ Web/Types.hs | 6 ++++++ Web/View/Projects/Index.hs | 36 ++++++++++++++++++++++++++++++++++++ Web/View/Projects/New.hs | 24 ++++++++++++++++++++++++ 7 files changed, 105 insertions(+), 2 deletions(-) create mode 100644 Web/Controller/Projects.hs create mode 100644 Web/View/Projects/Index.hs create mode 100644 Web/View/Projects/New.hs diff --git a/Application/Schema.sql b/Application/Schema.sql index fa96c87..49a64d4 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -1,3 +1,4 @@ +CREATE TYPE project_type AS ENUM ('project_type_ongoing', 'project_type_not_started', 'project_type_finished'); CREATE FUNCTION set_updated_at_to_now() RETURNS TRIGGER AS $$ BEGIN NEW.updated_at = NOW(); @@ -5,7 +6,6 @@ BEGIN END; $$ language plpgsql; -- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables. - CREATE TABLE users ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, email TEXT NOT NULL, @@ -13,7 +13,6 @@ CREATE TABLE users ( locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL, failed_login_attempts INT DEFAULT 0 NOT NULL ); - CREATE TABLE landing_pages ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -40,6 +39,11 @@ CREATE TABLE paragraph_ctas ( ); CREATE INDEX paragraph_quotes_landing_page_id_index ON paragraph_quotes (landing_page_id); CREATE INDEX paragraph_ctas_landing_page_id_index ON paragraph_ctas (landing_page_id); +CREATE TABLE projects ( + id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, + project_type project_type NOT NULL, + participants TEXT NOT NULL +); ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_ref_landing_page_id FOREIGN KEY (ref_landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_quotes ADD CONSTRAINT paragraph_quotes_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; diff --git a/Web/Controller/Projects.hs b/Web/Controller/Projects.hs new file mode 100644 index 0000000..73860f4 --- /dev/null +++ b/Web/Controller/Projects.hs @@ -0,0 +1,28 @@ +module Web.Controller.Projects where + +import Web.Controller.Prelude +import Web.View.Projects.Index +import Web.View.Projects.New + +instance Controller ProjectsController where + action ProjectsAction = do + projects <- query @Project |> fetch + render IndexView { .. } + + action NewProjectAction = do + let project = newRecord + render NewView { .. } + + action CreateProjectAction = do + let project = newRecord @Project + project + |> buildProject + |> ifValid \case + Left project -> render NewView { .. } + Right project -> do + project <- project |> createRecord + setSuccessMessage "Project created" + redirectTo ProjectsAction + +buildProject project = project + |> fill @'["projectType", "participants"] diff --git a/Web/FrontController.hs b/Web/FrontController.hs index 7539ed4..f323aaf 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -6,6 +6,7 @@ import Web.View.Layout (defaultLayout) -- Controller Imports +import Web.Controller.Projects import Web.Controller.Users import Web.Controller.ImageStyle import Web.Controller.LandingPages @@ -19,6 +20,7 @@ instance FrontController WebApplication where controllers = [ startPage LandingPagesAction -- Generator Marker + , parseRoute @ProjectsController , parseRoute @UsersController , parseRoute @ImageStyleController , parseRoute @LandingPagesController diff --git a/Web/Routes.hs b/Web/Routes.hs index 080c5c5..5941616 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -20,3 +20,6 @@ instance AutoRoute SessionsController instance AutoRoute UsersController + +instance AutoRoute ProjectsController + diff --git a/Web/Types.hs b/Web/Types.hs index 4d97b91..847d806 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -77,3 +77,9 @@ data UsersController | UpdateUserAction { userId :: !(Id User) } | DeleteUserAction { userId :: !(Id User) } deriving (Eq, Show, Data) + +data ProjectsController + = ProjectsAction + | NewProjectAction + | CreateProjectAction + deriving (Eq, Show, Data) diff --git a/Web/View/Projects/Index.hs b/Web/View/Projects/Index.hs new file mode 100644 index 0000000..4cf36fc --- /dev/null +++ b/Web/View/Projects/Index.hs @@ -0,0 +1,36 @@ +module Web.View.Projects.Index where +import Web.View.Prelude + +data IndexView = IndexView { projects :: [Project] } + +instance View IndexView where + html IndexView { .. } = [hsx| + {breadcrumb} + +

Index+ New

+
+ + + + + + + + + + {forEach projects renderProject} +
Project
+ +
+ |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "Projects" ProjectsAction + ] + +renderProject :: Project -> Html +renderProject project = [hsx| + + {project.projectType} {project.participants} + +|] \ No newline at end of file diff --git a/Web/View/Projects/New.hs b/Web/View/Projects/New.hs new file mode 100644 index 0000000..1249327 --- /dev/null +++ b/Web/View/Projects/New.hs @@ -0,0 +1,24 @@ +module Web.View.Projects.New where +import Web.View.Prelude + +data NewView = NewView { project :: Project } + +instance View NewView where + html NewView { .. } = [hsx| + {breadcrumb} +

New Project

+ {renderForm project} + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "Projects" ProjectsAction + , breadcrumbText "New Project" + ] + +renderForm :: Project -> Html +renderForm project = formFor project [hsx| + {(textField #projectType)} + {(textField #participants)} + {submitButton} + +|] \ No newline at end of file From 2b8490b37ca5be962010a128d509f08aae227d6c Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Fri, 17 Nov 2023 12:20:51 +0200 Subject: [PATCH 2/4] Wire form --- Web/Types.hs | 9 +++++++++ Web/View/Projects/New.hs | 8 ++++---- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/Web/Types.hs b/Web/Types.hs index 847d806..57c6990 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -4,6 +4,7 @@ import IHP.Prelude import IHP.ModelSupport import Generated.Types import IHP.LoginSupport.Types +import IHP.View.Form -- Custom types @@ -83,3 +84,11 @@ data ProjectsController | NewProjectAction | CreateProjectAction deriving (Eq, Show, Data) + +instance CanSelect ProjectType where + type SelectValue ProjectType = ProjectType + selectValue value = value + selectLabel value = case value of + ProjectTypeNotStarted -> "Not started" + ProjectTypeOngoing -> "Ongoing" + ProjectTypeFinished -> "Finished" \ No newline at end of file diff --git a/Web/View/Projects/New.hs b/Web/View/Projects/New.hs index 1249327..239536f 100644 --- a/Web/View/Projects/New.hs +++ b/Web/View/Projects/New.hs @@ -17,8 +17,8 @@ instance View NewView where renderForm :: Project -> Html renderForm project = formFor project [hsx| - {(textField #projectType)} - {(textField #participants)} + {(selectField #projectType allProjectTypes)} + {(numberField #participants)} {submitButton} - -|] \ No newline at end of file +|] + where allProjectTypes = allEnumValues @ProjectType \ No newline at end of file From edb25f4eaca224b41139e0ff91edb88cec89f274 Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Fri, 17 Nov 2023 12:22:39 +0200 Subject: [PATCH 3/4] Dump db --- Application/Fixtures.sql | 55 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/Application/Fixtures.sql b/Application/Fixtures.sql index e69de29..ba526ca 100644 --- a/Application/Fixtures.sql +++ b/Application/Fixtures.sql @@ -0,0 +1,55 @@ + + +SET statement_timeout = 0; +SET lock_timeout = 0; +SET idle_in_transaction_session_timeout = 0; +SET client_encoding = 'UTF8'; +SET standard_conforming_strings = on; +SELECT pg_catalog.set_config('search_path', '', false); +SET check_function_bodies = false; +SET xmloption = content; +SET client_min_messages = warning; +SET row_security = off; + + +SET SESSION AUTHORIZATION DEFAULT; + +ALTER TABLE public.landing_pages DISABLE TRIGGER ALL; + + + +ALTER TABLE public.landing_pages ENABLE TRIGGER ALL; + + +ALTER TABLE public.paragraph_ctas DISABLE TRIGGER ALL; + + + +ALTER TABLE public.paragraph_ctas ENABLE TRIGGER ALL; + + +ALTER TABLE public.paragraph_quotes DISABLE TRIGGER ALL; + + + +ALTER TABLE public.paragraph_quotes ENABLE TRIGGER ALL; + + +ALTER TABLE public.projects DISABLE TRIGGER ALL; + +INSERT INTO public.projects (id, project_type, participants) VALUES ('e767f087-d1b9-42ea-898e-c2a2bf39999e', 'project_type_ongoing', '2'); +INSERT INTO public.projects (id, project_type, participants) VALUES ('429177d7-f425-4c5e-b379-5e1a0f72bfb5', 'project_type_not_started', '3'); +INSERT INTO public.projects (id, project_type, participants) VALUES ('84825fa3-2cce-4b4a-872b-81fe554e2076', 'project_type_not_started', '2'); +INSERT INTO public.projects (id, project_type, participants) VALUES ('687e32f5-8e8b-4a6d-b4a7-ead9d8a39f91', 'project_type_finished', '2'); + + +ALTER TABLE public.projects ENABLE TRIGGER ALL; + + +ALTER TABLE public.users DISABLE TRIGGER ALL; + + + +ALTER TABLE public.users ENABLE TRIGGER ALL; + + From 3cc9e7332dd1d7990c223615426e7c2ef1cf2ffd Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Fri, 17 Nov 2023 12:26:26 +0200 Subject: [PATCH 4/4] Compile code --- Web/Controller/Projects.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/Web/Controller/Projects.hs b/Web/Controller/Projects.hs index 73860f4..d0fa7a0 100644 --- a/Web/Controller/Projects.hs +++ b/Web/Controller/Projects.hs @@ -7,6 +7,15 @@ import Web.View.Projects.New instance Controller ProjectsController where action ProjectsAction = do projects <- query @Project |> fetch + + -- Fetch only specific projects by a pair of values. + -- In this case we really fetch all, but show how we pair the values we want to + -- query by. + let pairs = projects + |> fmap (\project -> "(" ++ show project.projectType ++ ", " ++ project.participants ++ ")") + + projectsQuery :: [Project] <- sqlQuery "SELECT * FROM projects WHERE (project_type, participants) IN (VALUES ?)" (Only (In pairs)) + render IndexView { .. } action NewProjectAction = do