Client, UI: Form for creating a new Deck

This commit is contained in:
fr33domlover 2022-08-16 13:17:26 +00:00
parent a12409548f
commit 26ec6527e2
7 changed files with 76 additions and 107 deletions

View file

@ -14,22 +14,22 @@
-} -}
module Vervis.Client module Vervis.Client
( createThread ( --createThread
, createReply --, createReply
, follow --, follow
, followSharer --, followSharer
, followProject --, followProject
, followTicket --, followTicket
, followRepo --, followRepo
, offerTicket --, offerTicket
, resolve --, resolve
, undoFollowSharer --, undoFollowSharer
, undoFollowProject --, undoFollowProject
, undoFollowTicket --, undoFollowTicket
, undoFollowRepo --, undoFollowRepo
, unresolve --, unresolve
, offerMR --, offerMR
, createDeck createDeck
) )
where where
@ -70,11 +70,11 @@ import Vervis.ActivityPub
import Vervis.FedURI import Vervis.FedURI
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Model.Ident
import Vervis.Recipient import Vervis.Recipient
import Vervis.Ticket import Vervis.Ticket
import Vervis.WorkItem import Vervis.WorkItem
{-
createThread createThread
:: (MonadSite m, SiteEnv m ~ App) :: (MonadSite m, SiteEnv m ~ App)
=> ShrIdent => ShrIdent
@ -593,20 +593,19 @@ offerMR shrAuthor title desc uContext muBranch typ diff = runExceptT $ do
} }
return (Nothing, Audience recips [] [] [] [] [], ticket) return (Nothing, Audience recips [] [] [] [] [], ticket)
-} -}
-}
createDeck createDeck
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App) :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
=> ShrIdent => KeyHashid Person
-> Text -> Text
-> Maybe Text -> Text
-> m (Maybe TextHtml, Audience URIMode, AP.ActorDetail, Maybe FedURI) -> m (Maybe TextHtml, Audience URIMode, AP.ActorDetail)
createDeck shrAuthor name mdesc = do createDeck senderHash name desc = do
error "Temporarily disabled"
{-
encodeRouteHome <- getEncodeRouteHome encodeRouteHome <- getEncodeRouteHome
let audAuthor = let audAuthor =
AudLocal [] [LocalPersonCollectionSharerFollowers shrAuthor] AudLocal [] [LocalStagePersonFollowers senderHash]
(_, _, _, audLocal, audRemote) = collectAudience [audAuthor] (_, _, _, audLocal, audRemote) = collectAudience [audAuthor]
@ -616,8 +615,7 @@ createDeck shrAuthor name mdesc = do
{ AP.actorType = AP.ActorTypeTicketTracker { AP.actorType = AP.ActorTypeTicketTracker
, AP.actorUsername = Nothing , AP.actorUsername = Nothing
, AP.actorName = Just name , AP.actorName = Just name
, AP.actorSummary = mdesc , AP.actorSummary = Just desc
} }
return (Nothing, Audience recips [] [] [] [] [], detail, Nothing) return (Nothing, AP.Audience recips [] [] [] [] [], detail)
-}

View file

@ -16,16 +16,15 @@
module Vervis.Form.Project module Vervis.Form.Project
( NewProject (..) ( NewProject (..)
, newProjectForm , newProjectForm
, NewProjectCollab (..) --, NewProjectCollab (..)
, newProjectCollabForm --, newProjectCollabForm
, editProjectForm --, editProjectForm
) )
where where
import Data.Bifunctor import Data.Bifunctor
import Data.Maybe import Data.Maybe
import Data.Text (Text) import Data.Text (Text)
import Database.Esqueleto hiding ((==.))
import Database.Persist ((==.)) import Database.Persist ((==.))
import Yesod.Form.Fields import Yesod.Form.Fields
import Yesod.Form.Functions import Yesod.Form.Functions
@ -34,52 +33,20 @@ import Yesod.Persist.Core
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Vervis.Field.Project
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Model.Ident
import Development.PatchMediaType
import Vervis.Model.Workflow
data NewProject = NewProject data NewProject = NewProject
{ npName :: Text { npName :: Text
, npDesc :: Maybe Text , npDesc :: Text
, npWflow :: WorkflowId
, npRole :: Maybe RoleId
} }
newProjectAForm :: SharerId -> AForm Handler NewProject newProjectForm :: Form NewProject
newProjectAForm sid = NewProject newProjectForm = renderDivs $ NewProject
<$> areq textField "Name*" Nothing <$> areq textField "Name*" Nothing
<*> aopt textField "Description" Nothing <*> areq 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
{-
data NewProjectCollab = NewProjectCollab data NewProjectCollab = NewProjectCollab
{ ncPerson :: PersonId { ncPerson :: PersonId
, ncRole :: Maybe RoleId , ncRole :: Maybe RoleId
@ -134,3 +101,4 @@ editProjectAForm sid (Entity jid project) = Project
editProjectForm :: SharerId -> Entity Project -> Form Project editProjectForm :: SharerId -> Entity Project -> Form Project
editProjectForm s j = renderDivs $ editProjectAForm s j editProjectForm s j = renderDivs $ editProjectAForm s j
-}

View file

@ -348,6 +348,7 @@ instance Yesod App where
-- Deck -- Deck
(DeckInboxR _ , False) -> personAny (DeckInboxR _ , False) -> personAny
(DeckNewR , _ ) -> personAny
-- Loom -- Loom

View file

@ -93,12 +93,15 @@ import Yesod.Persist.Local
import Vervis.Actor import Vervis.Actor
import Vervis.API import Vervis.API
import Vervis.Federation import Vervis.Federation
import Vervis.Form.Project
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.Paginate import Vervis.Paginate
import Vervis.Settings import Vervis.Settings
import Vervis.Widget.Person import Vervis.Widget.Person
import qualified Vervis.Client as C
getDeckR :: KeyHashid Deck -> Handler TypedContent getDeckR :: KeyHashid Deck -> Handler TypedContent
getDeckR deckHash = do getDeckR deckHash = do
deckID <- decodeKeyHashid404 deckHash deckID <- decodeKeyHashid404 deckHash
@ -251,43 +254,43 @@ getDeckTreeR _ = error "Temporarily disabled"
getDeckNewR :: Handler Html getDeckNewR :: Handler Html
getDeckNewR = do getDeckNewR = do
error "Temporarily disabled" ((_result, widget), enctype) <- runFormPost newProjectForm
{-
Entity sid _ <- runDB $ getBy404 $ UniqueSharer shr
((_result, widget), enctype) <- runFormPost $ newProjectForm sid
defaultLayout $(widgetFile "project/new") 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 :: Handler Html
postDeckNewR = do postDeckNewR = do
error "Temporarily disabled" (NewProject name desc, _widget, _enctype) <- runForm DeckNewR newProjectForm
{-
ep@(Entity _ p) <- requireAuth personEntity@(Entity personID person) <- requireAuth
Entity sid s <- runDB $ do personHash <- encodeKeyHashid personID
_ <- getBy404 $ UniqueSharer shr (maybeSummary, audience, detail) <- C.createDeck personHash name desc
getJustEntity $ personIdent p actor <- runDB $ getJust $ personActor person
unless (sharerIdent s == shr) $ result <-
invalidArgs ["Trying to create project under someone/something else"] runExceptT $ createTicketTrackerC personEntity actor maybeSummary audience detail Nothing Nothing
((result, widget), enctype) <- runFormPost $ newProjectForm sid
eprj <- runExceptT $ do
NewProject name mdesc _ _ <-
case result of 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
Left e -> do Left e -> do
setMessage $ toHtml e setMessage $ toHtml e
defaultLayout $(widgetFile "project/new") redirect DeckNewR
Right prj -> do Right createID -> do
setMessage "Project created!" maybeDeckID <- runDB $ getKeyBy $ UniqueDeckCreate createID
redirect $ ProjectR shr prj 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 :: KeyHashid Deck -> Handler Html
postDeckDeleteR _ = error "Temporarily disabled" postDeckDeleteR _ = error "Temporarily disabled"

View file

@ -19,5 +19,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<ul> <ul>
<li> <li>
<li>
<a href=@{DeckNewR}>
Create a new ticket tracker
<a href=@{PublishR}> <a href=@{PublishR}>
Publish an activity Publish an activity

View file

@ -12,11 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>. $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<p> <form method=POST action=@{DeckNewR} enctype=#{enctype}>
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}>
^{widget} ^{widget}
<div class="submit"> <div class="submit">
<input type="submit"> <input type="submit">

View file

@ -129,7 +129,7 @@ library
Vervis.Changes Vervis.Changes
Vervis.ChangeFeed Vervis.ChangeFeed
--Vervis.Class.Actor --Vervis.Class.Actor
--Vervis.Client Vervis.Client
Vervis.Cloth Vervis.Cloth
Vervis.Colour Vervis.Colour
Vervis.Content Vervis.Content
@ -155,7 +155,7 @@ library
Vervis.Form.Discussion Vervis.Form.Discussion
--Vervis.Form.Group --Vervis.Form.Group
-- Vervis.Form.Key -- Vervis.Form.Key
--Vervis.Form.Project Vervis.Form.Project
--Vervis.Form.Repo --Vervis.Form.Repo
--Vervis.Form.Role --Vervis.Form.Role
--Vervis.Form.Ticket --Vervis.Form.Ticket