WIP: Query by pairs of values

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;
+
+

Application/Schema.sql

@@ -1,19 +1,18 @@
+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();
     RETURN NEW;
 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,
     password_hash TEXT NOT NULL,
     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;

Web/Controller/Projects.hs

@@ -0,0 +1,37 @@
+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
+
+        -- 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
+        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"]

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

Web/Routes.hs

@@ -20,3 +20,6 @@ instance AutoRoute SessionsController
 
 instance AutoRoute UsersController
 
+
+instance AutoRoute ProjectsController
+

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
 
@@ -77,3 +78,17 @@ data UsersController
     | UpdateUserAction { userId :: !(Id User) }
     | DeleteUserAction { userId :: !(Id User) }
     deriving (Eq, Show, Data)
+
+data ProjectsController
+    = ProjectsAction
+    | 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"

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}
+
+        <h1>Index<a href={pathTo NewProjectAction} class="btn btn-primary ms-4">+ New</a></h1>
+        <div class="table-responsive">
+            <table class="table">
+                <thead>
+                    <tr>
+                        <th>Project</th>
+                        <th></th>
+                        <th></th>
+                        <th></th>
+                    </tr>
+                </thead>
+                <tbody>{forEach projects renderProject}</tbody>
+            </table>
+
+        </div>
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "Projects" ProjectsAction
+                ]
+
+renderProject :: Project -> Html
+renderProject project = [hsx|
+    <tr>
+        <td>{project.projectType} {project.participants}</td>
+    </tr>
+|]

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}
+        <h1>New Project</h1>
+        {renderForm project}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "Projects" ProjectsAction
+                , breadcrumbText "New Project"
+                ]
+
+renderForm :: Project -> Html
+renderForm project = formFor project [hsx|
+    {(selectField #projectType allProjectTypes)}
+    {(numberField #participants)}
+    {submitButton}
+|]
+    where allProjectTypes = allEnumValues @ProjectType