From d815ce76e0ca0cda12b607ef552fb492df9a4832 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sun, 16 Apr 2023 12:33:20 +0200
Subject: [PATCH] Added TasksController

---
 Web/Controller/Tasks.hs | 55 +++++++++++++++++++++++++++++++++++++++++
 Web/FrontController.hs  |  2 ++
 Web/Routes.hs           |  4 ++-
 Web/Types.hs            | 10 ++++++++
 Web/View/Tasks/Edit.hs  | 23 +++++++++++++++++
 Web/View/Tasks/Index.hs | 39 +++++++++++++++++++++++++++++
 Web/View/Tasks/New.hs   | 23 +++++++++++++++++
 Web/View/Tasks/Show.hs  | 17 +++++++++++++
 8 files changed, 172 insertions(+), 1 deletion(-)
 create mode 100644 Web/Controller/Tasks.hs
 create mode 100644 Web/View/Tasks/Edit.hs
 create mode 100644 Web/View/Tasks/Index.hs
 create mode 100644 Web/View/Tasks/New.hs
 create mode 100644 Web/View/Tasks/Show.hs

diff --git a/Web/Controller/Tasks.hs b/Web/Controller/Tasks.hs
new file mode 100644
index 0000000..5c44e13
--- /dev/null
+++ b/Web/Controller/Tasks.hs
@@ -0,0 +1,55 @@
+module Web.Controller.Tasks where
+
+import Web.Controller.Prelude
+import Web.View.Tasks.Index
+import Web.View.Tasks.New
+import Web.View.Tasks.Edit
+import Web.View.Tasks.Show
+
+instance Controller TasksController where
+    action TasksAction = do
+        tasks <- query @Task |> fetch
+        render IndexView { .. }
+
+    action NewTaskAction = do
+        let task = newRecord
+        render NewView { .. }
+
+    action ShowTaskAction { taskId } = do
+        task <- fetch taskId
+        render ShowView { .. }
+
+    action EditTaskAction { taskId } = do
+        task <- fetch taskId
+        render EditView { .. }
+
+    action UpdateTaskAction { taskId } = do
+        task <- fetch taskId
+        task
+            |> buildTask
+            |> ifValid \case
+                Left task -> render EditView { .. }
+                Right task -> do
+                    task <- task |> updateRecord
+                    setSuccessMessage "Task updated"
+                    redirectTo EditTaskAction { .. }
+
+    action CreateTaskAction = do
+        let task = newRecord @Task
+        task
+            |> buildTask
+            |> ifValid \case
+                Left task -> render NewView { .. } 
+                Right task -> do
+                    task <- task |> createRecord
+                    setSuccessMessage "Task created"
+                    redirectTo TasksAction
+
+    action DeleteTaskAction { taskId } = do
+        task <- fetch taskId
+        deleteRecord task
+        setSuccessMessage "Task deleted"
+        redirectTo TasksAction
+
+buildTask task = task
+    |> fill @'["description"]
diff --git a/Web/FrontController.hs b/Web/FrontController.hs
index e1fb78a..6fda5a2 100644
--- a/Web/FrontController.hs
+++ b/Web/FrontController.hs
@@ -5,12 +5,14 @@ import Web.Controller.Prelude
 import Web.View.Layout (defaultLayout)
 
 -- Controller Imports
+import Web.Controller.Tasks
 import Web.Controller.Static
 
 instance FrontController WebApplication where
     controllers = 
         [ startPage WelcomeAction
         -- Generator Marker
+        , parseRoute @TasksController
         ]
 
 instance InitControllerContext WebApplication where
diff --git a/Web/Routes.hs b/Web/Routes.hs
index 98b0b2b..314ebfc 100644
--- a/Web/Routes.hs
+++ b/Web/Routes.hs
@@ -4,4 +4,6 @@ import Generated.Types
 import Web.Types
 
 -- Generator Marker
-instance AutoRoute StaticController
\ No newline at end of file
+instance AutoRoute StaticController
+instance AutoRoute TasksController
+
diff --git a/Web/Types.hs b/Web/Types.hs
index d48bddd..4f6cf4a 100644
--- a/Web/Types.hs
+++ b/Web/Types.hs
@@ -8,3 +8,13 @@ data WebApplication = WebApplication deriving (Eq, Show)
 
 
 data StaticController = WelcomeAction deriving (Eq, Show, Data)
+
+data TasksController
+    = TasksAction
+    | NewTaskAction
+    | ShowTaskAction { taskId :: !(Id Task) }
+    | CreateTaskAction
+    | EditTaskAction { taskId :: !(Id Task) }
+    | UpdateTaskAction { taskId :: !(Id Task) }
+    | DeleteTaskAction { taskId :: !(Id Task) }
+    deriving (Eq, Show, Data)
diff --git a/Web/View/Tasks/Edit.hs b/Web/View/Tasks/Edit.hs
new file mode 100644
index 0000000..6853914
--- /dev/null
+++ b/Web/View/Tasks/Edit.hs
@@ -0,0 +1,23 @@
+module Web.View.Tasks.Edit where
+import Web.View.Prelude
+
+data EditView = EditView { task :: Task }
+
+instance View EditView where
+    html EditView { .. } = [hsx|
+        {breadcrumb}
+        <h1>Edit Task</h1>
+        {renderForm task}
+    |]
+        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
diff --git a/Web/View/Tasks/Index.hs b/Web/View/Tasks/Index.hs
new file mode 100644
index 0000000..93bfdd5
--- /dev/null
+++ b/Web/View/Tasks/Index.hs
@@ -0,0 +1,39 @@
+module Web.View.Tasks.Index where
+import Web.View.Prelude
+
+data IndexView = IndexView { tasks :: [Task]  }
+
+instance View IndexView where
+    html IndexView { .. } = [hsx|
+        {breadcrumb}
+
+        <h1>Index<a href={pathTo NewTaskAction} class="btn btn-primary ms-4">+ New</a></h1>
+        <div class="table-responsive">
+            <table class="table">
+                <thead>
+                    <tr>
+                        <th>Task</th>
+                        <th></th>
+                        <th></th>
+                        <th></th>
+                    </tr>
+                </thead>
+                <tbody>{forEach tasks renderTask}</tbody>
+            </table>
+            
+        </div>
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "Tasks" TasksAction
+                ]
+
+renderTask :: Task -> Html
+renderTask task = [hsx|
+    <tr>
+        <td>{task}</td>
+        <td><a href={ShowTaskAction task.id}>Show</a></td>
+        <td><a href={EditTaskAction task.id} class="text-muted">Edit</a></td>
+        <td><a href={DeleteTaskAction task.id} class="js-delete text-muted">Delete</a></td>
+    </tr>
+|]
\ No newline at end of file
diff --git a/Web/View/Tasks/New.hs b/Web/View/Tasks/New.hs
new file mode 100644
index 0000000..36b7c45
--- /dev/null
+++ b/Web/View/Tasks/New.hs
@@ -0,0 +1,23 @@
+module Web.View.Tasks.New where
+import Web.View.Prelude
+
+data NewView = NewView { task :: Task }
+
+instance View NewView where
+    html NewView { .. } = [hsx|
+        {breadcrumb}
+        <h1>New Task</h1>
+        {renderForm task}
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                [ breadcrumbLink "Tasks" TasksAction
+                , breadcrumbText "New Task"
+                ]
+
+renderForm :: Task -> Html
+renderForm task = formFor task [hsx|
+    {(textField #description)}
+    {submitButton}
+
+|]
\ No newline at end of file
diff --git a/Web/View/Tasks/Show.hs b/Web/View/Tasks/Show.hs
new file mode 100644
index 0000000..b98b43f
--- /dev/null
+++ b/Web/View/Tasks/Show.hs
@@ -0,0 +1,17 @@
+module Web.View.Tasks.Show where
+import Web.View.Prelude
+
+data ShowView = ShowView { task :: Task }
+
+instance View ShowView where
+    html ShowView { .. } = [hsx|
+        {breadcrumb}
+        <h1>Show Task</h1>
+        <p>{task}</p>
+
+    |]
+        where
+            breadcrumb = renderBreadcrumb
+                            [ breadcrumbLink "Tasks" TasksAction
+                            , breadcrumbText "Show Task"
+                            ]
\ No newline at end of file