UI: New ticket/MR creation form + deck/loom navigation links

src/Vervis/Client.hs

@@ -24,7 +24,7 @@ module Vervis.Client
     --, followProject
     --, followTicket
     --, followRepo
-    --, offerTicket
+    , offerIssue
     --, resolve
     --, undoFollowSharer
     --, undoFollowProject
@@ -299,55 +299,65 @@ followRepo shrAuthor shrObject rpObject hide = do
     let uObject = encodeRouteHome $ RepoR shrObject rpObject
     follow shrAuthor uObject uObject hide
     -}
+-}
+
+offerIssue
+    :: KeyHashid Person -> Text -> PandocMarkdown -> FedURI
+    -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Ticket URIMode)
+offerIssue senderHash title desc uTracker = do
+
+    tracker <- do
+        tracker <- checkTracker uTracker
+        case tracker of
+            TrackerDeck deckID -> Left <$> encodeKeyHashid deckID
+            TrackerLoom _ -> throwE "Local patch tracker doesn't take issues"
+            TrackerRemote (ObjURI hTracker luTracker) -> Right <$> do
+                instanceID <- lift $ runDB $ either entityKey id <$> insertBy' (Instance hTracker)
+                result <- ExceptT $ first (T.pack . displayException) <$> fetchRemoteActor instanceID hTracker luTracker
+                case result of
+                    Left Nothing -> throwE "Tracker @id mismatch"
+                    Left (Just err) -> throwE $ T.pack $ displayException err
+                    Right Nothing -> throwE "Tracker isn't an actor"
+                    Right (Just actor) -> return (entityVal actor, uTracker)
 
-offerTicket
-    :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
-    => ShrIdent -> TextHtml -> TextPandocMarkdown -> ShrIdent -> PrjIdent -> m (Either Text (TextHtml, Audience URIMode, AP.Ticket URIMode, FedURI))
-offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj = runExceptT $ do
-    error "Temporarily disabled"
-    {-
-    encodeRouteLocal <- getEncodeRouteLocal
-    encodeRouteHome <- getEncodeRouteHome
     descHtml <- ExceptT . pure $ renderPandocMarkdown desc
-    summary <-
+
-        TextHtml . TL.toStrict . renderHtml <$>
+    encodeRouteLocal <- getEncodeRouteLocal
-            withUrlRenderer
+    hLocal <- asksSite siteInstanceHost
-                [hamlet|
+
-                    <p>
+    let audAuthor =
-                        <a href=@{SharerR shrAuthor}>
+            AudLocal [] [LocalStagePersonFollowers senderHash]
-                        #{shr2text shrAuthor}
+        audTracker =
-                        \ offered a ticket to project #
+            case tracker of
-                        <a href=@{ProjectR shr prj}>
+                Left deckHash ->
-                        ./s/#{shr2text shr}/p/#{prj2text prj}
+                    AudLocal
-                        : #{preEscapedToHtml title}.
+                        [LocalActorDeck deckHash]
-                |]
+                        [LocalStageDeckFollowers deckHash]
-    let recipsA = [ProjectR shr prj]
+                Right (remoteActor, ObjURI hTracker luTracker) ->
-        recipsC = [ProjectTeamR shr prj, ProjectFollowersR shr prj]
+                    AudRemote hTracker
+                        [luTracker]
+                        (maybeToList $ remoteActorFollowers remoteActor)
+
+        audience = [audAuthor, audTracker]
+
         ticket = AP.Ticket
             { AP.ticketLocal        = Nothing
-            , AP.ticketAttributedTo = encodeRouteLocal $ SharerR shrAuthor
+            , AP.ticketAttributedTo = encodeRouteLocal $ PersonR senderHash
             , AP.ticketPublished    = Nothing
             , AP.ticketUpdated      = Nothing
             , AP.ticketContext      = Nothing
-            -- , AP.ticketName         = Nothing
+            , AP.ticketSummary      = encodeEntities title
-            , AP.ticketSummary      = TextHtml title
+            , AP.ticketContent      = descHtml
-            , AP.ticketContent      = TextHtml descHtml
+            , AP.ticketSource       = desc
-            , AP.ticketSource       = TextPandocMarkdown desc
             , AP.ticketAssignedTo   = Nothing
             , AP.ticketResolved     = Nothing
             , AP.ticketAttachment   = Nothing
             }
-        target = encodeRouteHome $ ProjectR shr prj
-        audience = Audience
-            { audienceTo        = map encodeRouteHome $ recipsA ++ recipsC
-            , audienceBto       = []
-            , audienceCc        = []
-            , audienceBcc       = []
-            , audienceGeneral   = []
-            , audienceNonActors = map encodeRouteHome recipsC
-            }
-    return (summary, audience, ticket, target)
 
+    return (Nothing, audience, ticket)
+
+{-
+{-
 resolve
     :: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
     => ShrIdent

src/Vervis/Form/Ticket.hs

@@ -14,12 +14,16 @@
  -}
 
 module Vervis.Form.Ticket
-    ( --NewTicket (..)
+    ( fedUriField
-    --, newTicketForm
+
+    , NewTicket (..)
+    , NewCloth (..)
+    , newTicketForm
+    , newClothForm
     --, editTicketContentForm
     --, assignTicketForm
     --, claimRequestForm
-      ticketFilterForm
+    , ticketFilterForm
     --, ticketDepForm
     )
 where
@@ -32,13 +36,19 @@ import Data.Maybe
 import Data.Text (Text)
 import Data.Time.Calendar (Day (..))
 import Data.Time.Clock (getCurrentTime, UTCTime (..))
+import Data.Traversable
 import Database.Persist
-import Text.HTML.SanitizeXSS
+import Yesod.Core
 import Yesod.Form
 import Yesod.Persist.Core (runDB)
 
 import qualified Data.Text as T
 
+import Development.PatchMediaType
+import Network.FedURI
+import Web.Text
+
+import Vervis.FedURI
 import Vervis.Foundation (App, Form, Handler)
 import Vervis.Model
 import Vervis.Model.Ticket
@@ -46,18 +56,36 @@ import Vervis.Model.Workflow
 import Vervis.Ticket
 import Vervis.TicketFilter (TicketFilter (..))
 
+fedUriField
+    :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m FedURI
+fedUriField = Field
+    { fieldParse = parseHelper $ \ t ->
+        case parseObjURI t of
+            Left e  -> Left $ MsgInvalidUrl $ T.pack e <> ": " <> t
+            Right u -> Right u
+    , fieldView = \theId name attrs val isReq ->
+        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id renderObjURI val}>|]
+    , fieldEnctype = UrlEncoded
+    }
 --TODO use custom fields to ensure uniqueness or other constraints?
 
-{-
 data NewTicket = NewTicket
     { ntTitle   :: Text
-    , ntDesc    :: Text
+    , ntDesc    :: PandocMarkdown
-    , ntTParams :: [(WorkflowFieldId, Text)]
+    --, ntTParams :: [(WorkflowFieldId, Text)]
-    , ntEParams :: [(WorkflowFieldId, WorkflowEnumCtorId)]
+    --, ntEParams :: [(WorkflowFieldId, WorkflowEnumCtorId)]
-    , ntCParams :: [WorkflowFieldId]
+    --, ntCParams :: [WorkflowFieldId]
-    , ntOffer   :: Bool
     }
 
+data NewCloth = NewCloth
+    { ncTitle   :: Text
+    , ncDesc    :: PandocMarkdown
+    , ncTarget  :: Maybe Text
+    , ncOrigin  :: Maybe (FedURI, Maybe Text)
+    , ncPatch   :: Maybe (PatchMediaType, FileInfo)
+    }
+
+{-
 fieldSettings :: Text -> Bool -> FieldSettings App
 fieldSettings name req =
     fieldSettingsLabel $
@@ -103,9 +131,11 @@ cfield (Entity fid f) =
     in  if workflowFieldRequired f
             then mkval <$> areq checkBoxField sets Nothing
             else mkval . fromMaybe False <$> aopt checkBoxField sets Nothing
+-}
 
 newTicketForm :: WorkflowId -> Form NewTicket
 newTicketForm wid html = do
+    {-
     (tfs, efs, cfs) <- lift $ runDB $ do
         tfs <- selectList
             [ WorkflowFieldWorkflow  ==. wid
@@ -128,16 +158,37 @@ newTicketForm wid html = do
             ]
             []
         return (tfs, efs, cfs)
+    -}
     flip renderDivs html $ NewTicket
-        <$> (sanitizeBalance <$> areq textField "Title*" Nothing)
+        <$> (areq textField "Title*" Nothing)
-        <*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$>
+        <*> ( pandocMarkdownFromText . T.filter (/= '\r') . unTextarea <$>
-              aopt textareaField "Description (Markdown)" Nothing
+              areq textareaField "Description (Markdown)*" Nothing
             )
-        <*> (catMaybes <$> traverse tfield tfs)
+        -- <*> (catMaybes <$> traverse tfield tfs)
-        <*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
+        -- <*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
-        <*> (catMaybes <$> traverse cfield cfs)
+        -- <*> (catMaybes <$> traverse cfield cfs)
-        <*> areq checkBoxField "Offer" Nothing
+
--}
+newClothForm :: Form NewCloth
+newClothForm = renderDivs $ mk
+    <$> (areq textField "Title*" Nothing)
+    <*> ( pandocMarkdownFromText . T.filter (/= '\r') . unTextarea <$>
+            areq textareaField "Description (Markdown)*" Nothing
+        )
+    <*> aopt textField "Target branch" Nothing
+    <*> aopt fedUriField "Origin repo" Nothing
+    <*> aopt textField "Origin branch" Nothing
+    <*> aopt (selectFieldList typeList) "Patch type" Nothing
+    <*> aopt fileField "Patch file" Nothing
+    where
+    typeList :: [(Text, PatchMediaType)]
+    typeList =
+        [ ("Darcs", PatchMediaTypeDarcs)
+        , ("Git"  , PatchMediaTypeGit)
+        ]
+    mk title desc targetBranch originRepo originBranch typ file =
+        NewCloth
+            title desc targetBranch
+            ((,originBranch) <$> originRepo) ((,) <$> typ <*> file)
 
 {-
 editTicketContentAForm :: Ticket -> AForm Handler Ticket

src/Vervis/Form/Tracker.hs

@@ -13,9 +13,9 @@
  - <http://creativecommons.org/publicdomain/zero/1.0/>.
  -}
 
-module Vervis.Form.Project
+module Vervis.Form.Tracker
-    ( NewProject (..)
+    ( NewDeck (..)
-    , newProjectForm
+    , newDeckForm
     , NewLoom (..)
     , newLoomForm
     --, NewProjectCollab (..)
@@ -41,13 +41,13 @@ import Yesod.Hashids
 import Vervis.Foundation
 import Vervis.Model
 
-data NewProject = NewProject
+data NewDeck = NewDeck
-    { npName  :: Text
+    { ndName  :: Text
-    , npDesc  :: Text
+    , ndDesc  :: Text
     }
 
-newProjectForm :: Form NewProject
+newDeckForm :: Form NewDeck
-newProjectForm = renderDivs $ NewProject
+newDeckForm = renderDivs $ NewDeck
     <$> areq textField "Name*"       Nothing
     <*> areq textField "Description" Nothing
 

src/Vervis/Foundation.hs

@@ -908,6 +908,7 @@ instance YesodBreadcrumbs App where
         TicketDepsR d t        -> ("Dependencies", Just $ TicketR d t)
         TicketReverseDepsR d t -> ("Dependants", Just $ TicketR d t)
 
+        TicketNewR d         -> ("New Ticket", Just $ DeckR d)
         TicketFollowR _ _    -> ("", Nothing)
         TicketUnfollowR _ _  -> ("", Nothing)
         TicketReplyR d t     -> ("Reply", Just $ TicketR d t)
@@ -940,6 +941,7 @@ instance YesodBreadcrumbs App where
         BundleR l c b  -> ("Bundle " <> keyHashidText b, Just $ ClothR l c)
         PatchR l c b p -> ("Patch " <> keyHashidText p, Just $ BundleR l c b)
 
+        ClothNewR l         -> ("New Merge Request", Just $ LoomR l)
         ClothApplyR _ _     -> ("", Nothing)
         ClothFollowR _ _    -> ("", Nothing)
         ClothUnfollowR _ _  -> ("", Nothing)

src/Vervis/Handler/Client.hs

@@ -79,6 +79,7 @@ import Vervis.API
 import Vervis.Client
 import Vervis.Data.Actor
 import Vervis.FedURI
+import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
@@ -898,93 +899,6 @@ postRepoUnfollowR shrFollowee rpFollowee = do
     setUnfollowMessage shrAuthor eid
     redirect $ RepoR shrFollowee rpFollowee
 
-postProjectTicketsR :: ShrIdent -> PrjIdent -> Handler Html
-postProjectTicketsR shr prj = do
-    wid <- runDB $ do
-        sid <- getKeyBy404 $ UniqueSharer shr
-        j <- getValBy404 $ UniqueProject prj sid
-        return $ projectWorkflow j
-    ((result, widget), enctype) <- runFormPost $ newTicketForm wid
-
-    (eperson, sharer) <- do
-        ep@(Entity _ p) <- requireVerifiedAuth
-        s <- runDB $ getJust $ personIdent p
-        return (ep, s)
-    let shrAuthor = sharerIdent sharer
-
-    eid <- runExceptT $ do
-        NewTicket title desc tparams eparams cparams offer <-
-            case result of
-                FormMissing -> throwE "Field(s) missing."
-                FormFailure _l ->
-                    throwE "Ticket submission failed, see errors below."
-                FormSuccess nt -> return nt
-        unless (null tparams && null eparams && null cparams) $
-            throwE "Custom param support currently disabled"
-            {-
-            let mktparam (fid, v) = TicketParamText
-                    { ticketParamTextTicket = tid
-                    , ticketParamTextField  = fid
-                    , ticketParamTextValue  = v
-                    }
-            insertMany_ $ map mktparam $ ntTParams nt
-            let mkeparam (fid, v) = TicketParamEnum
-                    { ticketParamEnumTicket = tid
-                    , ticketParamEnumField  = fid
-                    , ticketParamEnumValue  = v
-                    }
-            insertMany_ $ map mkeparam $ ntEParams nt
-            -}
-        if offer
-            then Right <$> do
-                (summary, audience, ticket, target) <-
-                    ExceptT $ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj
-                obiid <- offerTicketC eperson sharer (Just summary) audience ticket target
-                ExceptT $ runDB $ do
-                    mtal <- getValBy $ UniqueTicketAuthorLocalOpen obiid
-                    return $
-                        case mtal of
-                            Nothing ->
-                                Left
-                                    "Offer processed successfully but no ticket \
-                                    \created"
-                            Just tal -> Right $ ticketAuthorLocalTicket tal
-            else Left <$> do
-                (summary, audience, Create obj mtarget) <- do
-                    encodeRouteHome <- getEncodeRouteHome
-                    let project = encodeRouteHome $ ProjectR shr prj
-                    ExceptT $ createTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) project project
-                let ticket =
-                        case obj of
-                            CreateTicket _ t -> t
-                            _ -> error "Create object isn't a ticket"
-                obiid <- createTicketC eperson sharer (Just summary) audience ticket mtarget
-                ExceptT $ runDB $ do
-                    mtalid <- getKeyBy $ UniqueTicketAuthorLocalOpen obiid
-                    return $
-                        case mtalid of
-                            Nothing ->
-                                Left
-                                    "Create processed successfully but no ticket \
-                                    \created"
-                            Just v -> Right v
-    case eid of
-        Left e -> do
-            setMessage $ toHtml e
-            defaultLayout $(widgetFile "ticket/new")
-        Right (Left talid) -> do
-            talkhid <- encodeKeyHashid talid
-            redirect $ SharerTicketR shr talkhid
-        Right (Right ltid) -> do
-            ltkhid <- encodeKeyHashid ltid
-            eobiidFollow <- runExceptT $ do
-                (summary, audience, follow) <- followTicket shrAuthor shr prj ltkhid False
-                followC shrAuthor (Just summary) audience follow
-            case eobiidFollow of
-                Left e -> setMessage $ toHtml $ "Ticket created, but following it failed: " <> e
-                Right _ -> setMessage "Ticket created."
-            redirect $ ProjectTicketR shr prj ltkhid
-
 postProjectTicketCloseR
     :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
 postProjectTicketCloseR shr prj ltkhid = do
@@ -1016,18 +930,6 @@ postProjectTicketOpenR shr prj ltkhid = do
     redirect $ ProjectTicketR shr prj ltkhid
 -}
 
-fedUriField
-    :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m FedURI
-fedUriField = Field
-    { fieldParse = parseHelper $ \ t ->
-        case parseObjURI t of
-            Left e  -> Left $ MsgInvalidUrl $ T.pack e <> ": " <> t
-            Right u -> Right u
-    , fieldView = \theId name attrs val isReq ->
-        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id renderObjURI val}>|]
-    , fieldEnctype = UrlEncoded
-    }
-
 capField
     :: Field Handler
         ( FedURI

src/Vervis/Handler/Cloth.hs

@@ -26,6 +26,9 @@ module Vervis.Handler.Cloth
 
     , getClothDepR
 
+    , getClothNewR
+    , postClothNewR
+
     , postClothApplyR
     , postClothFollowR
     , postClothUnfollowR
@@ -66,6 +69,7 @@ module Vervis.Handler.Cloth
     )
 where
 
+import Control.Exception.Base
 import Control.Monad
 import Control.Monad.Trans.Except
 import Data.Bifunctor
@@ -83,10 +87,13 @@ import Network.HTTP.Types.Method
 import Text.Blaze.Html (Html, preEscapedToHtml)
 import Yesod.Auth
 import Yesod.Core
+import Yesod.Form
 import Yesod.Persist.Core
 
 import qualified Data.List.NonEmpty as NE
 import qualified Data.List.Ordered as LO
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
 import qualified Database.Esqueleto as E
 
 import Data.MediaType
@@ -97,6 +104,7 @@ import Web.Text
 import Yesod.ActivityPub
 import Yesod.FedURI
 import Yesod.Hashids
+import Yesod.MonadSite
 import Yesod.RenderSource
 
 import qualified Web.ActivityPub as AP
@@ -104,6 +112,7 @@ import qualified Web.ActivityPub as AP
 import Control.Monad.Trans.Except.Local
 import Data.Paginate.Local
 import Database.Persist.Local
+import Yesod.Form.Local
 import Yesod.Persist.Local
 
 import Vervis.ActivityPub
@@ -112,6 +121,7 @@ import Vervis.Cloth
 import Vervis.Data.Actor
 import Vervis.Persist.Discussion
 import Vervis.FedURI
+import Vervis.Form.Ticket
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
@@ -129,6 +139,7 @@ import Vervis.Web.Repo
 import Vervis.Widget
 import Vervis.Widget.Discussion
 import Vervis.Widget.Person
+import Vervis.Widget.Tracker
 
 import qualified Vervis.Client as C
 
@@ -284,10 +295,11 @@ getClothR loomHash clothHash = do
     where
     getClothHtml = do
         mpid <- maybeAuthId
-        (ticket, targetRepo, author, tparams, eparams, cparams, resolved, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
+        (eloom, actor, ticket, targetRepo, author, tparams, eparams, cparams, resolved, moriginRepo, mbundle) <- handlerToWidget $ runDB $ do
-            (Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, maybeResolve, proposal) <-
+            (eloom@(Entity _ loom), Entity _ cloth, Entity ticketID ticket, author, maybeResolve, proposal) <-
                 getCloth404 loomHash clothHash
-            (ticket,,,,,,,,)
+            actor <- getJust $ loomActor loom
+            (eloom,actor,ticket,,,,,,,,)
                 <$> getLocalRepo' (loomRepo loom) (ticketLoomBranch cloth)
                 <*> bitraverse
                         (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
@@ -626,6 +638,69 @@ getClothDepR _ _ _ = do
             tdc
     -}
 
+getClothNewR :: KeyHashid Loom -> Handler Html
+getClothNewR loomHash = do
+    loomID <- decodeKeyHashid404 loomHash
+    _ <- runDB $ get404 loomID
+    ((_result, widget), enctype) <- runFormPost newClothForm
+    defaultLayout $(widgetFile "cloth/new")
+
+postClothNewR :: KeyHashid Loom -> Handler Html
+postClothNewR loomHash = do
+    loomID <- decodeKeyHashid404 loomHash
+    person@(Entity pid p) <- requireAuth
+    (loom, senderActor) <- runDB $ do
+        loom <- get404 loomID
+        a <- getJust $ personActor p
+        return (loom, a)
+    NewCloth title desc targetBranch origin patch <-
+        runFormPostRedirect (ClothNewR loomHash) newClothForm
+    encodeRouteHome <- getEncodeRouteHome
+    errorOrTicket <- runExceptT $ do
+        let uLoom = encodeRouteHome $ LoomR loomHash
+        senderHash <- encodeKeyHashid pid
+        (maybeSummary, audience, ticket) <- do
+            uTargetRepo <-
+                encodeRouteHome . RepoR <$> encodeKeyHashid (loomRepo loom)
+            case (origin, patch) of
+                (Nothing, Nothing) -> throwE "Neither origin no patch provided"
+                (Just _, Just _) -> throwE "Both origin and patch provided"
+                (Just (uRepo, mb), Nothing) ->
+                    C.offerMerge
+                        senderHash title desc uLoom uTargetRepo targetBranch
+                        uRepo mb
+                (Nothing, Just (typ, fi)) -> do
+                    diff <-
+                        withExceptT (T.pack . displayException) $ ExceptT $
+                            TE.decodeUtf8' <$> fileSourceByteString fi
+                    C.offerPatches
+                        senderHash title desc uLoom uTargetRepo targetBranch
+                        typ (diff :| [])
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            lift $ C.makeServerInput Nothing maybeSummary audience $
+                AP.OfferActivity $ AP.Offer (AP.OfferTicket ticket) uLoom
+        offerID <-
+            offerTicketC
+                person senderActor Nothing localRecips remoteRecips fwdHosts action
+                ticket uLoom
+        runDBExcept $ do
+            mtal <- lift $ getValBy $ UniqueTicketAuthorLocalOpen offerID
+            tal <- fromMaybeE mtal "Offer processed bu no ticket created"
+            return $ ticketAuthorLocalTicket tal
+    case errorOrTicket of
+        Left e -> do
+            setMessage $ toHtml e
+            redirect $ ClothNewR loomHash
+        Right ticketID -> do
+            clothID <- do
+                maybeClothID <- runDB $ getKeyBy $ UniqueTicketLoom ticketID
+                case maybeClothID of
+                    Nothing -> error "No TicketLoom for the new Ticket"
+                    Just c -> return c
+            clothHash <- encodeKeyHashid clothID
+            setMessage "MR created"
+            redirect $ ClothR loomHash clothHash
+
 postClothApplyR :: KeyHashid Loom -> KeyHashid TicketLoom -> Handler ()
 postClothApplyR loomHash clothHash = do
     ep@(Entity personID person) <- requireAuth

src/Vervis/Handler/Deck.hs

@@ -103,8 +103,8 @@ import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Ticket
 import Vervis.FedURI
-import Vervis.Form.Project
 import Vervis.Form.Ticket
+import Vervis.Form.Tracker
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Paginate
@@ -115,6 +115,7 @@ import Vervis.TicketFilter
 import Vervis.Web.Actor
 import Vervis.Widget.Person
 import Vervis.Widget.Ticket
+import Vervis.Widget.Tracker
 
 import qualified Vervis.Client as C
 
@@ -226,16 +227,20 @@ getDeckFollowersR = getActorFollowersCollection DeckFollowersR deckActor
 getDeckTicketsR :: KeyHashid Deck -> Handler TypedContent
 getDeckTicketsR deckHash = selectRep $ do
     provideRep $ do
-        ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm
+        let tf = def
+        {-
+        ((filtResult, filtWidget), filtEnctype) <- runFormPost ticketFilterForm
         let tf =
                 case filtResult of
                     FormSuccess filt -> filt
                     FormMissing      -> def
                     FormFailure l    ->
                         error $ "Ticket filter form failed: " ++ show l
+        -}
         deckID <- decodeKeyHashid404 deckHash
-        (total, pages, mpage) <- runDB $ do
+        (deck, actor, (total, pages, mpage)) <- runDB $ do
-            _ <- get404 deckID
+            deck <- get404 deckID
+            actor <- getJust $ deckActor deck
             let countAllTickets = count [TicketDeckDeck ==. deckID]
                 selectTickets off lim =
                     getTicketSummaries
@@ -243,7 +248,7 @@ getDeckTicketsR deckHash = selectRep $ do
                         (Just $ \ t -> [E.desc $ t E.^. TicketId])
                         (Just (off, lim))
                         deckID
-            getPageAndNavCount countAllTickets selectTickets
+            (deck,actor,) <$> getPageAndNavCount countAllTickets selectTickets
         case mpage of
             Nothing -> redirectFirstPage here
             Just (rows, navModel) ->
@@ -319,12 +324,12 @@ getDeckMessageR _ _ = notFound
 
 getDeckNewR :: Handler Html
 getDeckNewR = do
-    ((_result, widget), enctype) <- runFormPost newProjectForm
+    ((_result, widget), enctype) <- runFormPost newDeckForm
-    defaultLayout $(widgetFile "project/new")
+    defaultLayout $(widgetFile "deck/new")
 
 postDeckNewR :: Handler Html
 postDeckNewR = do
-    NewProject name desc <- runFormPostRedirect DeckNewR newProjectForm
+    NewDeck name desc <- runFormPostRedirect DeckNewR newDeckForm
 
     personEntity@(Entity personID person) <- requireAuth
     personHash <- encodeKeyHashid personID

src/Vervis/Handler/Loom.hs

@@ -80,8 +80,8 @@ import Vervis.Federation.Collab
 import Vervis.Federation.Discussion
 import Vervis.Federation.Ticket
 import Vervis.FedURI
-import Vervis.Form.Project
 import Vervis.Form.Ticket
+import Vervis.Form.Tracker
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Paginate
@@ -91,6 +91,7 @@ import Vervis.Ticket
 import Vervis.TicketFilter
 import Vervis.Web.Actor
 import Vervis.Widget.Ticket
+import Vervis.Widget.Tracker
 
 import qualified Vervis.Client as C
 
@@ -180,16 +181,20 @@ getLoomFollowersR = getActorFollowersCollection LoomFollowersR loomActor
 getLoomClothsR :: KeyHashid Loom -> Handler TypedContent
 getLoomClothsR loomHash = selectRep $ do
     provideRep $ do
-        ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm
+        let tf = def
+        {-
+        ((filtResult, filtWidget), filtEnctype) <- runFormPost ticketFilterForm
         let tf =
                 case filtResult of
                     FormSuccess filt -> filt
                     FormMissing      -> def
                     FormFailure l    ->
                         error $ "Ticket filter form failed: " ++ show l
+        -}
         loomID <- decodeKeyHashid404 loomHash
-        (total, pages, mpage) <- runDB $ do
+        (loom, actor, (total, pages, mpage)) <- runDB $ do
-            _ <- get404 loomID
+            loom <- get404 loomID
+            actor <- getJust $ loomActor loom
             let countAllTickets = count [TicketLoomLoom ==. loomID]
                 selectTickets off lim =
                     getClothSummaries
@@ -197,7 +202,7 @@ getLoomClothsR loomHash = selectRep $ do
                         (Just $ \ t -> [E.desc $ t E.^. TicketId])
                         (Just (off, lim))
                         loomID
-            getPageAndNavCount countAllTickets selectTickets
+            (loom,actor,) <$> getPageAndNavCount countAllTickets selectTickets
         case mpage of
             Nothing -> redirectFirstPage here
             Just (rows, navModel) ->

src/Vervis/Handler/Ticket.hs

@@ -24,6 +24,9 @@ module Vervis.Handler.Ticket
 
     , getTicketDepR
 
+    , getTicketNewR
+    , postTicketNewR
+
     , postTicketFollowR
     , postTicketUnfollowR
 
@@ -41,8 +44,6 @@ module Vervis.Handler.Ticket
     {-
     , getProjectTicketsR
     , getProjectTicketTreeR
-    , getProjectTicketNewR
-    , putProjectTicketR
     , deleteProjectTicketR
     , postProjectTicketR
     , getProjectTicketEditR
@@ -98,7 +99,7 @@ import Network.HTTP.Types (StdMethod (DELETE, POST))
 import Text.Blaze.Html (Html, toHtml)
 import Text.Blaze.Html.Renderer.Text
 import Text.HTML.SanitizeXSS
-import Yesod.Auth (requireAuthId, maybeAuthId)
+import Yesod.Auth
 import Yesod.Core hiding (logWarn)
 import Yesod.Core.Handler
 import Yesod.Core.Widget
@@ -128,17 +129,19 @@ import Yesod.RenderSource
 
 import qualified Web.ActivityPub as AP
 
+import Control.Monad.Trans.Except.Local
 import Data.Either.Local
 import Data.Maybe.Local (partitionMaybePairs)
 import Data.Paginate.Local
 import Database.Persist.Local
+import Yesod.Form.Local
 import Yesod.Persist.Local
 
 import Vervis.ActivityPub
 import Vervis.API
 import Vervis.Data.Actor
-import Vervis.Persist.Discussion
 import Vervis.FedURI
+import Vervis.Form.Ticket
 import Vervis.Foundation
 --import Vervis.GraphProxy (ticketDepGraph)
 import Vervis.Model
@@ -147,6 +150,7 @@ import Vervis.Model.Ticket
 import Vervis.Model.Workflow
 import Vervis.Paginate
 import Vervis.Persist.Actor
+import Vervis.Persist.Discussion
 import Vervis.Recipient
 import Vervis.Settings
 import Vervis.Style
@@ -157,6 +161,9 @@ import Vervis.Web.Actor
 import Vervis.Web.Discussion
 import Vervis.Widget.Discussion
 import Vervis.Widget.Person
+import Vervis.Widget.Tracker
+
+import qualified Vervis.Client as C
 
 selectDiscussionID deckHash taskHash = do
     (_, _, Entity _ ticket, _, _) <- getTicket404 deckHash taskHash
@@ -251,10 +258,11 @@ getTicketR deckHash ticketHash = do
     where
     getTicketHtml = do
         mpid <- maybeAuthId
-        (ticket, author, tparams, eparams, cparams, resolved) <- handlerToWidget $ runDB $ do
+        (edeck, actor, ticket, author, tparams, eparams, cparams, resolved) <- handlerToWidget $ runDB $ do
-            (_deck, _ticketdeck, Entity ticketID ticket, author, maybeResolve) <-
+            (deck, _ticketdeck, Entity ticketID ticket, author, maybeResolve) <-
                 getTicket404 deckHash ticketHash
-            (ticket,,,,,)
+            actor <- getJust $ deckActor $ entityVal deck
+            (deck,actor,ticket,,,,,)
                 <$> bitraverse
                         (\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
                             p <- getJust personID
@@ -421,6 +429,54 @@ getTicketDepR _ _ _ = do
             tdc
     -}
 
+getTicketNewR :: KeyHashid Deck -> Handler Html
+getTicketNewR deckHash = do
+    deckID <- decodeKeyHashid404 deckHash
+    wid <- runDB $ deckWorkflow <$> get404 deckID
+    ((_result, widget), enctype) <- runFormPost $ newTicketForm wid
+    defaultLayout $(widgetFile "ticket/new")
+
+postTicketNewR :: KeyHashid Deck -> Handler Html
+postTicketNewR deckHash = do
+    deckID <- decodeKeyHashid404 deckHash
+    person@(Entity pid p) <- requireAuth
+    (wid, actor) <- runDB $ do
+        wid <- deckWorkflow <$> get404 deckID
+        a <- getJust $ personActor p
+        return (wid, a)
+    NewTicket title desc <-
+        runFormPostRedirect (TicketNewR deckHash) $ newTicketForm wid
+    errorOrTicket <- runExceptT $ do
+        encodeRouteHome <- getEncodeRouteHome
+        let uDeck = encodeRouteHome $ DeckR deckHash
+        senderHash <- encodeKeyHashid pid
+        (maybeSummary, audience, ticket) <-
+            C.offerIssue senderHash title desc uDeck
+        (localRecips, remoteRecips, fwdHosts, action) <-
+            lift $ C.makeServerInput Nothing maybeSummary audience $
+                AP.OfferActivity $ AP.Offer (AP.OfferTicket ticket) uDeck
+        offerID <-
+            offerTicketC
+                person actor Nothing localRecips remoteRecips fwdHosts action
+                ticket uDeck
+        runDBExcept $ do
+            mtal <- lift $ getValBy $ UniqueTicketAuthorLocalOpen offerID
+            tal <- fromMaybeE mtal "Offer processed bu no ticket created"
+            return $ ticketAuthorLocalTicket tal
+    case errorOrTicket of
+        Left e -> do
+            setMessage $ toHtml e
+            redirect $ TicketNewR deckHash
+        Right ticketID -> do
+            taskID <- do
+                maybeTaskID <- runDB $ getKeyBy $ UniqueTicketDeck ticketID
+                case maybeTaskID of
+                    Nothing -> error "No TicketDeck for the new Ticket"
+                    Just t -> return t
+            taskHash <- encodeKeyHashid taskID
+            setMessage "Ticket created"
+            redirect $ TicketR deckHash taskHash
+
 postTicketFollowR :: KeyHashid Deck -> KeyHashid TicketDeck -> Handler ()
 postTicketFollowR _ = error "Temporarily disabled"
 
@@ -500,75 +556,6 @@ postTicketReplyOnR deckHash taskHash msgHash = do
 
 
 {-
-getProjectTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
-getProjectTicketNewR shr prj = do
-    wid <- runDB $ do
-        Entity sid _ <- getBy404 $ UniqueSharer shr
-        Entity _   j <- getBy404 $ UniqueProject prj sid
-        return $ projectWorkflow j
-    ((_result, widget), enctype) <- runFormPost $ newTicketForm wid
-    defaultLayout $(widgetFile "ticket/new")
-
-putProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
-putProjectTicketR shr prj ltkhid = do
-    (tid, ticket, wid) <- runDB $ do
-        (_es, Entity _ project, Entity tid ticket, _elt, _etcl, _etpl, _author, _) <- getProjectTicket404 shr prj ltkhid
-        return (tid, ticket, projectWorkflow project)
-    ((result, widget), enctype) <-
-        runFormPost $ editTicketContentForm tid ticket wid
-    case result of
-        FormSuccess (ticket', tparams, eparams, cparams) -> do
-            newDescHtml <-
-                case renderPandocMarkdown $ ticketSource ticket' of
-                    Left err -> do
-                        setMessage $ toHtml err
-                        redirect $ ProjectTicketEditR shr prj ltkhid
-                    Right t -> return t
-            let ticket'' = ticket' { ticketDescription = newDescHtml }
-            runDB $ do
-                replace tid ticket''
-                let (tdel, tins, tupd) = partitionMaybePairs tparams
-                deleteWhere [TicketParamTextId <-. tdel]
-                let mktparam (fid, v) = TicketParamText
-                        { ticketParamTextTicket = tid
-                        , ticketParamTextField  = fid
-                        , ticketParamTextValue  = v
-                        }
-                insertMany_ $ map mktparam tins
-                traverse_
-                    (\ (aid, (_fid, v)) ->
-                        update aid [TicketParamTextValue =. v]
-                    )
-                    tupd
-                let (edel, eins, eupd) = partitionMaybePairs eparams
-                deleteWhere [TicketParamEnumId <-. edel]
-                let mkeparam (fid, v) = TicketParamEnum
-                        { ticketParamEnumTicket = tid
-                        , ticketParamEnumField  = fid
-                        , ticketParamEnumValue  = v
-                        }
-                insertMany_ $ map mkeparam eins
-                traverse_
-                    (\ (aid, (_fid, v)) ->
-                        update aid [TicketParamEnumValue =. v]
-                    )
-                    eupd
-                let (cdel, cins, _ckeep) = partitionMaybePairs cparams
-                deleteWhere [TicketParamClassId <-. cdel]
-                let mkcparam fid = TicketParamClass
-                        { ticketParamClassTicket = tid
-                        , ticketParamClassField  = fid
-                        }
-                insertMany_ $ map mkcparam cins
-            setMessage "Ticket updated."
-            redirect $ ProjectTicketR shr prj ltkhid
-        FormMissing -> do
-            setMessage "Field(s) missing."
-            defaultLayout $(widgetFile "ticket/edit")
-        FormFailure _l -> do
-            setMessage "Ticket update failed, see errors below."
-            defaultLayout $(widgetFile "ticket/edit")
-
 deleteProjectTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
 deleteProjectTicketR _shr _prj _ltkhid =
     --TODO: I can easily implement this, but should it even be possible to

src/Vervis/Widget/Project.hs

@@ -1,29 +0,0 @@
-{- This file is part of Vervis.
- -
- - Written in 2019 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/>.
- -}
-
-module Vervis.Widget.Project
-    ( projectNavW
-    )
-where
-
-import Vervis.Foundation
-import Vervis.Model
-import Vervis.Model.Ident
-import Vervis.Settings
-import Vervis.Widget.Workflow
-
-projectNavW :: Project -> Workflow -> Sharer -> ShrIdent -> PrjIdent -> Widget
-projectNavW project workflow wsharer shar proj =
-    $(widgetFile "project/widget/nav")

src/Vervis/Widget/Tracker.hs

@@ -0,0 +1,40 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2019, 2022 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/>.
+ -}
+
+module Vervis.Widget.Tracker
+    ( deckNavW
+    , loomNavW
+    )
+where
+
+import Database.Persist.Types
+
+import Yesod.Hashids
+
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Settings
+
+deckNavW :: Entity Deck -> Actor -> Widget
+deckNavW (Entity deckID deck) actor = do
+    deckHash <- encodeKeyHashid deckID
+    hashRepo <- getEncodeKeyHashid
+    $(widgetFile "deck/widget/nav")
+
+loomNavW :: Entity Loom -> Actor -> Widget
+loomNavW (Entity loomID loom) actor = do
+    loomHash <- encodeKeyHashid loomID
+    hashRepo <- getEncodeKeyHashid
+    $(widgetFile "loom/widget/nav")

templates/cloth/list.hamlet

@@ -12,16 +12,18 @@ $# 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>
+^{loomNavW (Entity loomID loom) actor}
-$#   <a href=@{ProjectTicketNewR shr prj}>Create new…
+
+<p>
+  <a href=@{ClothNewR loomHash}>Create new…
 
 $# <p>
 $#   <a href=@{ProjectTicketTreeR shr prj}>View as tree…
 
-<form method=GET action=@{LoomClothsR loomHash} enctype=#{filtEnctype}>
+$# <form method=GET action=@{LoomClothsR loomHash} enctype=#{filtEnctype}>
-  ^{filtWidget}
+$#   ^{filtWidget}
-  <div class="submit">
+$#   <div class="submit">
-    <input type="submit" value="Filter">
+$#     <input type="submit" value="Filter">
 
 ^{pageNav}
 

templates/cloth/one.hamlet

@@ -13,6 +13,8 @@ $# 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/>.
 
+^{loomNavW eloom actor}
+
 <h2>#{ticketTitle ticket}
 
 <div>

templates/deck/widget/nav.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -15,36 +15,29 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <div>
   <span>
     [[ 🏗
-    <a href=@{ProjectR shar proj}>
+    <a href=@{DeckR deckHash}>
-      #{prj2text proj}
+      =#{keyHashidText deckHash} #{actorName actor}
     ]] ::
   <span>
-    <a href=@{ProjectInboxR shar proj}>
+    <a href=@{DeckInboxR deckHash}>
       [📥 Inbox]
   <span>
-    <a href=@{ProjectOutboxR shar proj}>
+    <a href=@{DeckOutboxR deckHash}>
       [📤 Outbox]
   <span>
-    <a href=@{ProjectFollowersR shar proj}>
+    <a href=@{DeckFollowersR deckHash}>
       [🐤 Followers]
   <span>
-    <a href=@{ProjectDevsR shar proj}>
+    [🤝 Collaborators]
-      [🤝 Collaborators]
   <span>
-    <a href=@{ProjectTicketsR shar proj}>
+    <a href=@{DeckTicketsR deckHash}>
       [🐛 Tickets]
   <span>
-    <a href=@{ClaimRequestsProjectR shar proj}>
+    $maybe repoID <- deckWiki deck
-      [✋ Ticket claim requests]
+      <a href=@{RepoR $ hashRepo repoID}>
-  <span>
-    [🔁 Ticket workflow:
-    ^{workflowLinkW wsharer workflow}]
-  <span>
-    $maybe _wiki <- projectWiki project
-      <a href=@{WikiPageR shar proj []}>
         [📖 Wiki]
     $nothing
       [No wiki]
   <span>
-    <a href=@{ProjectEditR shar proj}>
+    <a href=@{DeckEditR deckHash}>
       [✏ Edit]

templates/loom/widget/nav.hamlet

@@ -0,0 +1,39 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2019, 2022 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/>.
+
+<div>
+  <span>
+    [[ 🏗
+    <a href=@{LoomR loomHash}>
+      +#{keyHashidText loomHash} #{actorName actor}
+    ]] ::
+  <span>
+    <a href=@{LoomInboxR loomHash}>
+      [📥 Inbox]
+  <span>
+    <a href=@{LoomOutboxR loomHash}>
+      [📤 Outbox]
+  <span>
+    <a href=@{LoomFollowersR loomHash}>
+      [🐤 Followers]
+  <span>
+    [🤝 Collaborators]
+  <span>
+    <a href=@{LoomClothsR loomHash}>
+      [🧩 Merge Requests]
+  <span>
+    <a href=@{RepoR $ hashRepo $ loomRepo loom}>
+      [🗃 Repository]
+  <span>
+    [✏ Edit]

templates/ticket/list.hamlet

@@ -12,16 +12,18 @@ $# 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>
+^{deckNavW (Entity deckID deck) actor}
-$#   <a href=@{ProjectTicketNewR shr prj}>Create new…
+
+<p>
+  <a href=@{TicketNewR deckHash}>Create new…
 
 $# <p>
 $#   <a href=@{ProjectTicketTreeR shr prj}>View as tree…
 
-<form method=GET action=@{DeckTicketsR deckHash} enctype=#{filtEnctype}>
+$# <form method=GET action=@{DeckTicketsR deckHash} enctype=#{filtEnctype}>
-  ^{filtWidget}
+$#   ^{filtWidget}
-  <div class="submit">
+$#   <div class="submit">
-    <input type="submit" value="Filter">
+$#     <input type="submit" value="Filter">
 
 ^{pageNav}
 

templates/ticket/new.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2022 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -14,7 +14,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 Enter the details and click "Submit" to create a new ticket.
 
-<form method=POST action=@{ProjectTicketsR shr prj} enctype=#{enctype}>
+<form method=POST action=@{TicketNewR deckHash} enctype=#{enctype}>
   ^{widget}
   <div class="submit">
     <input type="submit">

templates/ticket/one.hamlet

@@ -13,6 +13,8 @@ $# 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/>.
 
+^{deckNavW edeck actor}
+
 <h2>#{ticketTitle ticket}
 
 <div>

th/routes

@@ -224,10 +224,9 @@
 /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/deps       TicketDepsR        GET
 /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/rdeps      TicketReverseDepsR GET
 
--- /decks/#DeckKeyHashid/new-ticket                           TicketNewR         GET POST
+/decks/#DeckKeyHashid/new-ticket                           TicketNewR         GET POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/edit       TicketEditR        GET POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/delete     TicketDeleteR      POST
--- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/accept     TicketAcceptR      POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/close      TicketCloseR       POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/open       TicketOpenR        POST
 -- /decks/#DeckKeyHashid/tickets/#TicketDeckKeyHashid/claim      TicketClaimR       POST
@@ -277,10 +276,9 @@
 /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/bundles/#BundleKeyHashid                         BundleR GET
 /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/bundles/#BundleKeyHashid/patches/#PatchKeyHashid PatchR  GET
 
--- /looms/#LoomKeyHashid/new-cloth                           ClothNewR         GET POST
+/looms/#LoomKeyHashid/new-cloth                           ClothNewR         GET POST
 -- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/edit       ClothEditR        GET POST
 -- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/delete     ClothDeleteR      POST
--- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/accept     ClothAcceptR      POST
 -- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/close      ClothCloseR       POST
 -- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/open       ClothOpenR        POST
 -- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/claim      ClothClaimR       POST

vervis.cabal

@@ -166,10 +166,10 @@ library
                        Vervis.Form.Discussion
                        --Vervis.Form.Group
                        Vervis.Form.Key
-                       Vervis.Form.Project
                        Vervis.Form.Repo
                        --Vervis.Form.Role
                        Vervis.Form.Ticket
+                       Vervis.Form.Tracker
                        -- Vervis.Form.Workflow
                        Vervis.Formatting
                        Vervis.Foundation
@@ -239,10 +239,10 @@ library
                        Vervis.Widget
                        Vervis.Widget.Discussion
                        Vervis.Widget.Person
-                       --Vervis.Widget.Project
                        Vervis.Widget.Repo
                        --Vervis.Widget.Role
                        Vervis.Widget.Ticket
+                       Vervis.Widget.Tracker
                        -- Vervis.Widget.Workflow
                        -- Vervis.Wiki
                        Vervis.WorkItem