Project settings route, with wiki repo selector

config/routes

@@ -83,7 +83,8 @@
 
 /s/#ShrIdent/p                               ProjectsR         GET POST
 /s/#ShrIdent/p/!new                          ProjectNewR       GET
-/s/#ShrIdent/p/#PrjIdent                     ProjectR          GET
+/s/#ShrIdent/p/#PrjIdent                     ProjectR          GET PUT POST
+/s/#ShrIdent/p/#PrjIdent/edit                ProjectEditR      GET
 /s/#ShrIdent/p/#PrjIdent/d                   ProjectDevsR      GET POST
 /s/#ShrIdent/p/#PrjIdent/d/!new              ProjectDevNewR    GET
 /s/#ShrIdent/p/#PrjIdent/d/#ShrIdent         ProjectDevR       GET DELETE POST

src/Vervis/Form/Project.hs

@@ -17,6 +17,7 @@ module Vervis.Form.Project
     ( newProjectForm
     , NewProjectCollab (..)
     , newProjectCollabForm
+    , editProjectForm
     )
 where
 
@@ -71,3 +72,20 @@ newProjectCollabAForm pid rid = NewProjectCollab
 
 newProjectCollabForm :: PersonId -> ProjectId -> Form NewProjectCollab
 newProjectCollabForm pid rid = renderDivs $ newProjectCollabAForm pid rid
+
+editProjectAForm :: Entity Project -> AForm Handler Project
+editProjectAForm (Entity jid project) = Project
+    <$> pure                          (projectIdent project)
+    <*> pure                          (projectSharer project)
+    <*> aopt textField "Name*"        (Just $ projectName project)
+    <*> aopt textField "Description*" (Just $ projectDesc project)
+    <*> pure                          (projectNextTicket project)
+    <*> aopt selectWiki "Wiki*"       (Just $ projectWiki project)
+    where
+    selectWiki =
+        selectField $
+        optionsPersistKey [RepoProject ==. Just jid] [] $
+        rp2text . repoIdent
+
+editProjectForm :: Entity Project -> Form Project
+editProjectForm p = renderDivs $ editProjectAForm p

src/Vervis/Foundation.hs

@@ -150,6 +150,8 @@ instance Yesod App where
 
         (ProjectsR shar          , True) -> person shar
         (ProjectNewR user        , _   ) -> person user
+        (ProjectR shr _prj       , True) -> person shr
+        (ProjectEditR shr _prj   , _   ) -> person shr
         (ProjectDevsR shr _prj     , _   ) -> person shr
         (ProjectDevNewR shr _prj   , _   ) -> person shr
         (ProjectDevR shr _prj _dev , _   ) -> person shr
@@ -354,6 +356,7 @@ instance YesodBreadcrumbs App where
         ProjectR shar proj               -> ( prj2text proj
                                             , Just $ ProjectsR shar
                                             )
+        ProjectEditR shr prj             -> ("Edit", Just $ ProjectR shr prj)
         ProjectDevsR shr prj             -> ( "Collaborators"
                                             , Just $ ProjectR shr prj
                                             )

src/Vervis/Handler/Project.hs

@@ -18,6 +18,9 @@ module Vervis.Handler.Project
     , postProjectsR
     , getProjectNewR
     , getProjectR
+    , putProjectR
+    , postProjectR
+    , getProjectEditR
     , getProjectDevsR
     , postProjectDevsR
     , getProjectDevNewR
@@ -94,6 +97,39 @@ getProjectR shar proj = do
         return (p, rs)
     defaultLayout $(widgetFile "project/one")
 
+putProjectR :: ShrIdent -> PrjIdent -> Handler Html
+putProjectR shr prj = do
+    ep@(Entity jid project) <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharer shr
+        getBy404 $ UniqueProject prj sid
+    ((result, widget), enctype) <- runFormPost $ editProjectForm ep
+    case result of
+        FormSuccess project' -> do
+            runDB $ replace jid project'
+            setMessage "Project updated."
+            redirect $ ProjectR shr prj
+        FormMissing -> do
+            setMessage "Field(s) missing."
+            defaultLayout $(widgetFile "project/edit")
+        FormFailure _l -> do
+            setMessage "Project update failed, see errors below."
+            defaultLayout $(widgetFile "project/edit")
+
+postProjectR :: ShrIdent -> PrjIdent -> Handler Html
+postProjectR shr prj = do
+    mmethod <- lookupPostParam "_method"
+    case mmethod of
+        Just "PUT" -> putProjectR shr prj
+        _          -> notFound
+
+getProjectEditR :: ShrIdent -> PrjIdent -> Handler Html
+getProjectEditR shr prj = do
+    ep <- runDB $ do
+        Entity sid _sharer <- getBy404 $ UniqueSharer shr
+        getBy404 $ UniqueProject prj sid
+    ((_result, widget), enctype) <- runFormPost $ editProjectForm ep
+    defaultLayout $(widgetFile "project/edit")
+
 getProjectDevsR :: ShrIdent -> PrjIdent -> Handler Html
 getProjectDevsR shr rp = do
     devs <- runDB $ do

templates/project/edit.hamlet

@@ -0,0 +1,18 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<form method=POST action=@{ProjectR shr prj} enctype=#{enctype}>
+  <input type=hidden name=_method value=PUT>
+  ^{widget}
+  <input type=submit>