From 26ec6527e2ecbcc21e210d3f5526bceed2bcf763 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Tue, 16 Aug 2022 13:17:26 +0000
Subject: [PATCH] Client, UI: Form for creating a new Deck
---
src/Vervis/Client.hs | 52 ++++++++++++------------
src/Vervis/Form/Project.hs | 52 +++++-------------------
src/Vervis/Foundation.hs | 1 +
src/Vervis/Handler/Deck.hs | 65 ++++++++++++++++--------------
templates/personal-overview.hamlet | 3 ++
templates/project/new.hamlet | 6 +--
vervis.cabal | 4 +-
7 files changed, 76 insertions(+), 107 deletions(-)
diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs
index a323440..5e4e24f 100644
--- a/src/Vervis/Client.hs
+++ b/src/Vervis/Client.hs
@@ -14,22 +14,22 @@
-}
module Vervis.Client
- ( createThread
- , createReply
- , follow
- , followSharer
- , followProject
- , followTicket
- , followRepo
- , offerTicket
- , resolve
- , undoFollowSharer
- , undoFollowProject
- , undoFollowTicket
- , undoFollowRepo
- , unresolve
- , offerMR
- , createDeck
+ ( --createThread
+ --, createReply
+ --, follow
+ --, followSharer
+ --, followProject
+ --, followTicket
+ --, followRepo
+ --, offerTicket
+ --, resolve
+ --, undoFollowSharer
+ --, undoFollowProject
+ --, undoFollowTicket
+ --, undoFollowRepo
+ --, unresolve
+ --, offerMR
+ createDeck
)
where
@@ -70,11 +70,11 @@ import Vervis.ActivityPub
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
-import Vervis.Model.Ident
import Vervis.Recipient
import Vervis.Ticket
import Vervis.WorkItem
+{-
createThread
:: (MonadSite m, SiteEnv m ~ App)
=> ShrIdent
@@ -593,20 +593,19 @@ offerMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
}
return (Nothing, Audience recips [] [] [] [] [], ticket)
-}
+-}
createDeck
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
- => ShrIdent
+ => KeyHashid Person
-> Text
- -> Maybe Text
- -> m (Maybe TextHtml, Audience URIMode, AP.ActorDetail, Maybe FedURI)
-createDeck shrAuthor name mdesc = do
- error "Temporarily disabled"
- {-
+ -> Text
+ -> m (Maybe TextHtml, Audience URIMode, AP.ActorDetail)
+createDeck senderHash name desc = do
encodeRouteHome <- getEncodeRouteHome
let audAuthor =
- AudLocal [] [LocalPersonCollectionSharerFollowers shrAuthor]
+ AudLocal [] [LocalStagePersonFollowers senderHash]
(_, _, _, audLocal, audRemote) = collectAudience [audAuthor]
@@ -616,8 +615,7 @@ createDeck shrAuthor name mdesc = do
{ AP.actorType = AP.ActorTypeTicketTracker
, AP.actorUsername = Nothing
, AP.actorName = Just name
- , AP.actorSummary = mdesc
+ , AP.actorSummary = Just desc
}
- return (Nothing, Audience recips [] [] [] [] [], detail, Nothing)
- -}
+ return (Nothing, AP.Audience recips [] [] [] [] [], detail)
diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs
index f72c23b..71a4ed8 100644
--- a/src/Vervis/Form/Project.hs
+++ b/src/Vervis/Form/Project.hs
@@ -16,16 +16,15 @@
module Vervis.Form.Project
( NewProject (..)
, newProjectForm
- , NewProjectCollab (..)
- , newProjectCollabForm
- , editProjectForm
+ --, NewProjectCollab (..)
+ --, newProjectCollabForm
+ --, editProjectForm
)
where
import Data.Bifunctor
import Data.Maybe
import Data.Text (Text)
-import Database.Esqueleto hiding ((==.))
import Database.Persist ((==.))
import Yesod.Form.Fields
import Yesod.Form.Functions
@@ -34,52 +33,20 @@ import Yesod.Persist.Core
import qualified Database.Esqueleto as E
-import Vervis.Field.Project
import Vervis.Foundation
import Vervis.Model
-import Vervis.Model.Ident
-import Development.PatchMediaType
-import Vervis.Model.Workflow
data NewProject = NewProject
{ npName :: Text
- , npDesc :: Maybe Text
- , npWflow :: WorkflowId
- , npRole :: Maybe RoleId
+ , npDesc :: Text
}
-newProjectAForm :: SharerId -> AForm Handler NewProject
-newProjectAForm sid = NewProject
- <$> areq textField "Name*" Nothing
- <*> aopt textField "Description" Nothing
- <*> areq selectWorkflow "Workflow*" Nothing
- <*> aopt selectRole "Custom role" Nothing
- where
- selectRole =
- selectField $
- optionsPersistKey [RoleSharer ==. sid] [] $
- rl2text . roleIdent
- selectWorkflow = selectField $ do
- l <- runDB $ select $ from $ \ (w `InnerJoin` s) -> do
- on $ w ^. WorkflowSharer E.==. s ^. SharerId
- where_ $
- w ^. WorkflowSharer E.==. val sid E.||.
- w ^. WorkflowScope E.!=. val WSSharer
- return
- ( s ^. SharerIdent
- , w ^. WorkflowId
- , w ^. WorkflowIdent
- , w ^. WorkflowName
- )
- let mkpair (Value sident, Value wid, Value wident, Value wname) =
- ( shr2text sident <> " / " <> fromMaybe (wfl2text wident) wname
- , wid
- )
- optionsPairs $ map mkpair l
-
-newProjectForm :: SharerId -> Form NewProject
-newProjectForm sid = renderDivs $ newProjectAForm sid
+newProjectForm :: Form NewProject
+newProjectForm = renderDivs $ NewProject
+ <$> areq textField "Name*" Nothing
+ <*> areq textField "Description" Nothing
+{-
data NewProjectCollab = NewProjectCollab
{ ncPerson :: PersonId
, ncRole :: Maybe RoleId
@@ -134,3 +101,4 @@ editProjectAForm sid (Entity jid project) = Project
editProjectForm :: SharerId -> Entity Project -> Form Project
editProjectForm s j = renderDivs $ editProjectAForm s j
+-}
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index 6742d85..8d9b629 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -348,6 +348,7 @@ instance Yesod App where
-- Deck
(DeckInboxR _ , False) -> personAny
+ (DeckNewR , _ ) -> personAny
-- Loom
diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs
index 8fcb880..ac4721e 100644
--- a/src/Vervis/Handler/Deck.hs
+++ b/src/Vervis/Handler/Deck.hs
@@ -93,12 +93,15 @@ import Yesod.Persist.Local
import Vervis.Actor
import Vervis.API
import Vervis.Federation
+import Vervis.Form.Project
import Vervis.Foundation
import Vervis.Model
import Vervis.Paginate
import Vervis.Settings
import Vervis.Widget.Person
+import qualified Vervis.Client as C
+
getDeckR :: KeyHashid Deck -> Handler TypedContent
getDeckR deckHash = do
deckID <- decodeKeyHashid404 deckHash
@@ -251,43 +254,43 @@ getDeckTreeR _ = error "Temporarily disabled"
getDeckNewR :: Handler Html
getDeckNewR = do
- error "Temporarily disabled"
- {-
- Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
- ((_result, widget), enctype) <- runFormPost $ newProjectForm sid
+ ((_result, widget), enctype) <- runFormPost newProjectForm
defaultLayout $(widgetFile "project/new")
- -}
+
+runForm here form = do
+ ((result, widget), enctype) <- runFormPost $ newProjectForm
+ case result of
+ FormMissing -> do
+ setMessage "Field(s) missing"
+ redirect here
+ FormFailure _l -> do
+ setMessage "Operation failed, see below"
+ redirect here
+ FormSuccess v -> return (v, widget, enctype)
postDeckNewR :: Handler Html
postDeckNewR = do
- error "Temporarily disabled"
- {-
- ep@(Entity _ p) <- requireAuth
- Entity sid s <- runDB $ do
- _ <- getBy404 $ UniqueSharer shr
- getJustEntity $ personIdent p
- unless (sharerIdent s == shr) $
- invalidArgs ["Trying to create project under someone/something else"]
- ((result, widget), enctype) <- runFormPost $ newProjectForm sid
- eprj <- runExceptT $ do
- NewProject name mdesc _ _ <-
- case result of
- FormSuccess np -> return np
- FormMissing -> throwE "Field(s) missing"
- FormFailure _l -> throwE "Project creation failed, see below"
- (msummary, audience, detail, mtarget) <- lift $ createDeck shr name mdesc
- obiidCreate <- createTicketTrackerC ep s msummary audience detail mtarget
- runDBExcept $ do
- mj <- lift $ getValBy $ UniqueProjectCreate obiidCreate
- projectIdent <$> fromMaybeE mj "New project not found"
- case eprj of
+ (NewProject name desc, _widget, _enctype) <- runForm DeckNewR newProjectForm
+
+ personEntity@(Entity personID person) <- requireAuth
+ personHash <- encodeKeyHashid personID
+ (maybeSummary, audience, detail) <- C.createDeck personHash name desc
+ actor <- runDB $ getJust $ personActor person
+ result <-
+ runExceptT $ createTicketTrackerC personEntity actor maybeSummary audience detail Nothing Nothing
+
+ case result of
Left e -> do
setMessage $ toHtml e
- defaultLayout $(widgetFile "project/new")
- Right prj -> do
- setMessage "Project created!"
- redirect $ ProjectR shr prj
- -}
+ redirect DeckNewR
+ Right createID -> do
+ maybeDeckID <- runDB $ getKeyBy $ UniqueDeckCreate createID
+ case maybeDeckID of
+ Nothing -> error "Can't find the newly created deck"
+ Just deckID -> do
+ deckHash <- encodeKeyHashid deckID
+ setMessage "New ticket tracker created"
+ redirect $ DeckR deckHash
postDeckDeleteR :: KeyHashid Deck -> Handler Html
postDeckDeleteR _ = error "Temporarily disabled"
diff --git a/templates/personal-overview.hamlet b/templates/personal-overview.hamlet
index aa63507..b629791 100644
--- a/templates/personal-overview.hamlet
+++ b/templates/personal-overview.hamlet
@@ -19,5 +19,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<ul>
<li>
+ <li>
+ <a href=@{DeckNewR}>
+ Create a new ticket tracker
<a href=@{PublishR}>
Publish an activity
diff --git a/templates/project/new.hamlet b/templates/project/new.hamlet
index 9a151cc..626ebfc 100644
--- a/templates/project/new.hamlet
+++ b/templates/project/new.hamlet
@@ -12,11 +12,7 @@ $# 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/>.
-<p>
- NOTE: Your workflow and role choices will be ignored. They're temporarily
- not in use while these features are being federated.
-
-<form method=POST action=@{ProjectsR shr} enctype=#{enctype}>
+<form method=POST action=@{DeckNewR} enctype=#{enctype}>
^{widget}
<div class="submit">
<input type="submit">
diff --git a/vervis.cabal b/vervis.cabal
index e131755..1eda6c1 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -129,7 +129,7 @@ library
Vervis.Changes
Vervis.ChangeFeed
--Vervis.Class.Actor
- --Vervis.Client
+ Vervis.Client
Vervis.Cloth
Vervis.Colour
Vervis.Content
@@ -155,7 +155,7 @@ library
Vervis.Form.Discussion
--Vervis.Form.Group
-- Vervis.Form.Key
- --Vervis.Form.Project
+ Vervis.Form.Project
--Vervis.Form.Repo
--Vervis.Form.Role
--Vervis.Form.Ticket