refactor to make it easier to navigate

src/Handler/Group.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Replace case with fromMaybe" #-}
+module Handler.Group where
+
+import Import
+import Text.Read
+import Database.Persist.Sql (fromSqlKey, toSqlKey, rawSql)
+getGroupR :: Handler Html
+getGroupR = do
+    userId <- getUserId
+    groups <- getGroups userId
+    mToken <- fmap reqToken getRequest
+    defaultLayout $ do
+        setTitle "Groups"
+        [whamlet|
+            <a href=@{GroupR}>Home
+            <ul>
+                $forall group <- groups
+                    <li>
+                        <a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group}
+            <form action=@{AddGroupR} method="post">
+                <input type="text" name="group" placeholder="new group">
+                $maybe token <- mToken
+                    <input type="hidden" name="_token" value="#{token}">
+                <button type="submit">add
+            <a href=@{EditGroupR}>Edit
+        |]
+
+postAddGroupR :: Handler Html
+postAddGroupR = do
+    g <- runInputPost $ ireq textField "group"
+    -- TODO: in a newer version, put insertUnique_
+    user <- getUserId
+    _ <- runDB $ do
+        gId <- insert $ Group g
+        success <- insertUnique $ GroupUser user gId
+        when (isNothing success) $ delete gId
+    redirect GroupR
+
+getEditGroupR :: Handler Html
+getEditGroupR = do
+    userId <- getUserId
+    groups <- getGroups userId
+    mToken <- fmap reqToken getRequest
+    defaultLayout $ do
+        let a e = pack $ show $ fromSqlKey $ entityKey e ::Text
+        setTitle "Groups"
+        [whamlet|
+            <form action=@{DeleteGroupR} method="POST">
+                <ul>
+                    $forall group <- groups
+                        <li>
+                            <input type="checkbox" name="ids" value="#{a group}">
+                            <a href="">#{(groupGroup . entityVal) group}
+                $maybe token <- mToken
+                    <input type="hidden" name="_token" value="#{token}">
+                <button type=submit>Delete selected 
+            <a href=@{GroupR}>Back
+        |]
+postEditGroupR :: Handler Html
+postEditGroupR = do
+    -- TODO: not implemented yet
+    -- title <- runInputPost $ ireq textField "title"
+    -- users <- runInputPost $ ireq textField "users"
+    -- id <- runInputPost $ ireq intField "id"
+    -- let key = toSqlKey id
+    -- runDB $ update key [GroupGroup =. title]
+    redirect EditGroupR
+postDeleteGroupR :: Handler Html
+postDeleteGroupR = do
+    text <- lookupPostParams "ids"
+    let ints = map (read . unpack) text :: [Int64]
+    let ids = map toSqlKey ints :: [GroupId]
+    -- TODO: make sure the user has access to it aswell (this only works now for single user), and handle group owned by many
+    runDB $ deleteWhere [GroupId <-. ids]
+    redirect EditGroupR
+
+getGroups :: Key User -> Handler [Entity Group]
+getGroups userId =
+    let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?" in
+    runDB $ rawSql sql [toPersistValue userId]