Added TasksController

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"]

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

Web/Routes.hs

@@ -4,4 +4,6 @@ import Generated.Types
 import Web.Types
 
 -- Generator Marker
-instance AutoRoute StaticController
+instance AutoRoute StaticController
+instance AutoRoute TasksController
+

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)

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}
+
+|]

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

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}
+
+|]

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"
+                            ]