diff --git a/config/models b/config/models index 58ce8f0..506690c 100644 --- a/config/models +++ b/config/models @@ -303,6 +303,7 @@ WorkflowField filterNew Bool filterTodo Bool filterClosed Bool + color Int Maybe UniqueWorkflowField workflow ident diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index a72fca7..ef3b87b 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/src/Vervis/Form/Workflow.hs @@ -65,6 +65,7 @@ data NewField = NewField , nfNew :: Bool , nfTodo :: Bool , nfClosed :: Bool + , nfColor :: Maybe Int } newFieldAForm :: WorkflowId -> AForm Handler NewField @@ -79,12 +80,15 @@ newFieldAForm wid = NewField <*> areq checkBoxField "Applies to New*" (Just True) <*> areq checkBoxField "Applies to Todo*" (Just True) <*> areq checkBoxField "Applies to Closed*" (Just True) + <*> aopt (selectField selectColor) "Color" Nothing where selectEnum = optionsPersistKey [WorkflowEnumWorkflow ==. wid] [Asc WorkflowEnumName] workflowEnumName + selectColor = + optionsPairs [("red" :: Text, 1), ("green", 2), ("yellow", 3), ("blue", 4)] newFieldForm :: WorkflowId -> Form NewField newFieldForm wid = renderDivs $ newFieldAForm wid diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 477d6af..37ade96 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -59,6 +59,7 @@ import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (logWarn) import Control.Monad.Trans.Except +import Data.Aeson (encode) import Data.Bifunctor import Data.Bool (bool) import Data.Default.Class (def) @@ -82,6 +83,7 @@ import Yesod.Form.Functions (runFormGet, runFormPost) import Yesod.Form.Types (FormResult (..)) import Yesod.Persist.Core (runDB, get404, getBy404) +import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T (filter, intercalate, pack) import qualified Data.Text.Lazy as TL import qualified Database.Esqueleto as E @@ -95,11 +97,13 @@ import Yesod.ActivityPub import Yesod.Auth.Unverified import Yesod.FedURI import Yesod.Hashids +import Yesod.MonadSite import qualified Web.ActivityPub as AP import Data.Either.Local import Data.Maybe.Local (partitionMaybePairs) +import Data.Paginate.Local import Database.Persist.Local import Yesod.Persist.Local @@ -114,6 +118,7 @@ import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Ticket import Vervis.Model.Workflow +import Vervis.Paginate import Yesod.RenderSource import Vervis.Settings import Vervis.Style @@ -125,23 +130,84 @@ import Vervis.Widget.Discussion (discussionW) import Vervis.Widget.Sharer import Vervis.Widget.Ticket -getTicketsR :: ShrIdent -> PrjIdent -> Handler Html -getTicketsR shr prj = do - ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm - let tf = - case filtResult of - FormSuccess filt -> filt - FormMissing -> def - FormFailure l -> - error $ "Ticket filter form failed: " ++ show l - rows <- runDB $ do - Entity sid _ <- getBy404 $ UniqueSharer shr - Entity jid _ <- getBy404 $ UniqueProject prj sid - getTicketSummaries - (filterTickets tf) - (Just $ \ t -> [E.asc $ t E.^. TicketNumber]) - jid - defaultLayout $(widgetFile "ticket/list") +getTicketsR :: ShrIdent -> PrjIdent -> Handler TypedContent +getTicketsR shr prj = selectRep $ do + provideRep $ do + ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm + let tf = + case filtResult of + FormSuccess filt -> filt + FormMissing -> def + FormFailure l -> + error $ "Ticket filter form failed: " ++ show l + (total, pages, mpage) <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity jid _ <- getBy404 $ UniqueProject prj sid + let countAllTickets = count [TicketProject ==. jid] + selectTickets off lim = + getTicketSummaries + (filterTickets tf) + (Just $ \ t -> [E.asc $ t E.^. TicketNumber]) + (Just (off, lim)) + jid + getPageAndNavCount countAllTickets selectTickets + case mpage of + Nothing -> redirectFirstPage here + Just (rows, navModel) -> + let pageNav = navWidget navModel + in defaultLayout $(widgetFile "ticket/list") + provideAP' $ do + (total, pages, mpage) <- runDB $ do + Entity sid _ <- getBy404 $ UniqueSharer shr + Entity jid _ <- getBy404 $ UniqueProject prj sid + let countAllTickets = count [TicketProject ==. jid] + selectTickets off lim = selectList [TicketProject ==. jid] [Desc TicketNumber, OffsetBy off, LimitTo lim] + getPageAndNavCount countAllTickets selectTickets + + encodeRouteHome <- getEncodeRouteHome + encodeRouteLocal <- getEncodeRouteLocal + encodeRoutePageLocal <- getEncodeRoutePageLocal + let pageUrl = encodeRoutePageLocal here + host <- asksSite siteInstanceHost + + return $ + case mpage of + Nothing -> encodeStrict $ Doc host $ Collection + { collectionId = encodeRouteLocal here + , collectionType = CollectionTypeOrdered + , collectionTotalItems = Just total + , collectionCurrent = Nothing + , collectionFirst = Just $ pageUrl 1 + , collectionLast = Just $ pageUrl pages + , collectionItems = [] :: [Text] + } + Just (tickets, navModel) -> + let current = nmCurrent navModel + in encodeStrict $ Doc host $ CollectionPage + { collectionPageId = pageUrl current + , collectionPageType = CollectionPageTypeOrdered + , collectionPageTotalItems = Nothing + , collectionPageCurrent = Just $ pageUrl current + , collectionPageFirst = Just $ pageUrl 1 + , collectionPageLast = Just $ pageUrl pages + , collectionPagePartOf = encodeRouteLocal here + , collectionPagePrev = + if current > 1 + then Just $ pageUrl $ current - 1 + else Nothing + , collectionPageNext = + if current < pages + then Just $ pageUrl $ current + 1 + else Nothing + , collectionPageStartIndex = Nothing + , collectionPageItems = + map (encodeRouteHome . ticketUrl . entityVal) + tickets + } + where + here = TicketsR shr prj + ticketUrl = TicketR shr prj . ticketNumber + encodeStrict = BL.toStrict . encode getTicketTreeR :: ShrIdent -> PrjIdent -> Handler Html getTicketTreeR shr prj = do @@ -149,7 +215,7 @@ getTicketTreeR shr prj = do Entity sid _ <- getBy404 $ UniqueSharer shr Entity jid _ <- getBy404 $ UniqueProject prj sid liftA2 (,) - (getTicketSummaries Nothing Nothing jid) + (getTicketSummaries Nothing Nothing Nothing jid) (getTicketDepEdges jid) defaultLayout $ ticketTreeDW shr prj summaries deps diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs index c959287..1fdf685 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/src/Vervis/Handler/Workflow.hs @@ -161,6 +161,7 @@ postWorkflowFieldsR shr wfl = do , workflowFieldFilterNew = nfNew nf , workflowFieldFilterTodo = nfTodo nf , workflowFieldFilterClosed = nfClosed nf + , workflowFieldColor = nfColor nf } runDB $ insert_ field return $ Right $ nfIdent nf diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index d949eac..51b0cc0 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -1226,6 +1226,8 @@ changes hLocal ctx = , renameUnique "WorkflowEnumCtor" "UniqueWorkflowFieldEnumCtor" "UniqueWorkflowEnumCtor" -- 184 , addEntities model_2020_01_05 + -- 185 + , addFieldPrimOptional "WorkflowField" (Nothing :: Maybe Int) "color" ] migrateDB diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index caab449..3207e91 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -33,8 +33,8 @@ where import Control.Arrow ((***)) import Data.Foldable (for_) import Data.Text (Text) +import Data.Traversable import Database.Esqueleto -import Database.Esqueleto.PostgreSQL import Vervis.Foundation (AppDB) import Vervis.Model @@ -46,63 +46,69 @@ import Vervis.Widget.Ticket (TicketSummary (..)) getTicketSummaries :: Maybe (SqlExpr (Entity Ticket) -> SqlExpr (Value Bool)) -> Maybe (SqlExpr (Entity Ticket) -> [SqlExpr OrderBy]) + -> Maybe (Int, Int) -> ProjectId -> AppDB [TicketSummary] -getTicketSummaries mfilt morder jid = fmap (map toSummary) $ select $ from $ - \ ( t - `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s) - `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) - `InnerJoin` d - `LeftOuterJoin` m - `LeftOuterJoin` (tpc `InnerJoin` wf) - ) -> do - on $ tpc ?. TicketParamClassField ==. wf ?. WorkflowFieldId - on $ just (t ^. TicketId) ==. tpc ?. TicketParamClassTicket - on $ just (d ^. DiscussionId) ==. m ?. MessageRoot - on $ t ^. TicketDiscuss ==. d ^. DiscussionId - on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId - on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId - on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId - on $ just (t ^. TicketId) ==. tar ?. TicketAuthorRemoteTicket - on $ p ?. PersonIdent ==. s ?. SharerId - on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId - on $ just (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket - where_ $ t ^. TicketProject ==. val jid - groupBy - ( t ^. TicketId, s ?. SharerId - , ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId - ) - for_ mfilt $ \ filt -> where_ $ filt t - for_ morder $ \ order -> orderBy $ order t - return - ( t ^. TicketNumber - , s - , i - , ro - , ra - , t ^. TicketCreated - , t ^. TicketTitle - , t ^. TicketStatus - , count $ m ?. MessageId - , arrayRemoveNull $ maybeArray $ arrayAgg $ wf ?. WorkflowFieldName - ) - where - toSummary (Value n, ms, mi, mro, mra, Value c, Value t, Value d, Value r, Value wfs) = - TicketSummary - { tsNumber = n - , tsCreatedBy = - case (ms, mi, mro, mra) of - (Just s, Nothing, Nothing, Nothing) -> - Left $ entityVal s - (Nothing, Just i, Just ro, Just ra) -> - Right (entityVal i, entityVal ro, entityVal ra) - _ -> error "Ticket author DB invalid state" - , tsCreatedAt = c - , tsTitle = t - , tsLabels = wfs - , tsStatus = d - , tsComments = r - } +getTicketSummaries mfilt morder offlim jid = do + tickets <- select $ from $ + \ ( t + `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s) + `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` ro `InnerJoin` i) + `InnerJoin` d + `LeftOuterJoin` m + ) -> do + on $ just (d ^. DiscussionId) ==. m ?. MessageRoot + on $ t ^. TicketDiscuss ==. d ^. DiscussionId + on $ ro ?. RemoteObjectInstance ==. i ?. InstanceId + on $ ra ?. RemoteActorIdent ==. ro ?. RemoteObjectId + on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId + on $ just (t ^. TicketId) ==. tar ?. TicketAuthorRemoteTicket + on $ p ?. PersonIdent ==. s ?. SharerId + on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId + on $ just (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket + where_ $ t ^. TicketProject ==. val jid + groupBy + ( t ^. TicketId, s ?. SharerId + , ra ?. RemoteActorId, ro ?. RemoteObjectId, i ?. InstanceId + ) + for_ mfilt $ \ filt -> where_ $ filt t + for_ morder $ \ order -> orderBy $ order t + for_ offlim $ \ (off, lim) -> do + offset $ fromIntegral off + limit $ fromIntegral lim + return + ( t ^. TicketId + , t ^. TicketNumber + , s + , i + , ro + , ra + , t ^. TicketCreated + , t ^. TicketTitle + , t ^. TicketStatus + , count $ m ?. MessageId + ) + for tickets $ + \ (Value tid, Value n, ms, mi, mro, mra, Value c, Value t, Value d, Value r) -> do + labels <- select $ from $ \ (tpc `InnerJoin` wf) -> do + on $ tpc ^. TicketParamClassField ==. wf ^. WorkflowFieldId + where_ $ tpc ^. TicketParamClassTicket ==. val tid + return wf + return TicketSummary + { tsNumber = n + , tsCreatedBy = + case (ms, mi, mro, mra) of + (Just s, Nothing, Nothing, Nothing) -> + Left $ entityVal s + (Nothing, Just i, Just ro, Just ra) -> + Right (entityVal i, entityVal ro, entityVal ra) + _ -> error "Ticket author DB invalid state" + , tsCreatedAt = c + , tsTitle = t + , tsLabels = map entityVal labels + , tsStatus = d + , tsComments = r + } -- | Get the child-parent ticket number pairs of all the ticket dependencies -- in the given project, in ascending order by child, and then ascending order diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs index 4a2f566..a048c54 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -50,7 +50,7 @@ data TicketSummary = TicketSummary , tsCreatedBy :: Either Sharer (Instance, RemoteObject, RemoteActor) , tsCreatedAt :: UTCTime , tsTitle :: Text - , tsLabels :: [Text] + , tsLabels :: [WorkflowField] , tsStatus :: TicketStatus , tsComments :: Int } diff --git a/templates/ticket/list.hamlet b/templates/ticket/list.hamlet index a7b49b6..b11023b 100644 --- a/templates/ticket/list.hamlet +++ b/templates/ticket/list.hamlet @@ -23,6 +23,10 @@ $# .
+^{pageNav} +
$forall ts <- rows ^{ticketSummaryW shr prj ts Nothing} + +^{pageNav} diff --git a/templates/ticket/widget/summary.cassius b/templates/ticket/widget/summary.cassius index 0898141..5d63e55 100644 --- a/templates/ticket/widget/summary.cassius +++ b/templates/ticket/widget/summary.cassius @@ -1,6 +1,7 @@ /* This file is part of Vervis. * - * Written in 2016 by fr33domlover . + * Written in 2016, 2020 by fr33domlover , + * 2019 by Jason Harrer . * * ♡ Copying is an act of love. Please copy, reuse and share. * @@ -24,7 +25,7 @@ .ticket-status-column grid-column: 1 / 1 -" + .ticket-number-column grid-column: 2 / 2 @@ -42,3 +43,15 @@ .ticket-node-column grid-column: 7 / 7 + +.label1 + color: #{light red} + +.label2 + color: #{light green} + +.label3 + color: #{light yellow} + +.label4 + color: #{light blue} diff --git a/templates/ticket/widget/summary.hamlet b/templates/ticket/widget/summary.hamlet index 9944ed2..5839a64 100644 --- a/templates/ticket/widget/summary.hamlet +++ b/templates/ticket/widget/summary.hamlet @@ -37,8 +37,13 @@ $# . #{tsTitle ts} - $forall wfname <- tsLabels ts - \ [#{wfname}] + $forall wf <- tsLabels ts + $maybe wfcol <- workflowFieldColor wf + + [#{workflowFieldName wf}] + $nothing + + [#{workflowFieldName wf}] $if tsComments ts > 0 diff --git a/templates/workflow/field/one.hamlet b/templates/workflow/field/one.hamlet index 0560387..e6de0d0 100644 --- a/templates/workflow/field/one.hamlet +++ b/templates/workflow/field/one.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016, 2018 by fr33domlover . +$# Written in 2016, 2018, 2020 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -38,3 +38,9 @@ $# . Applies to Todo tickets: #{workflowFieldFilterTodo f}
  • Applies to Closed tickets: #{workflowFieldFilterClosed f} +
  • + Color: + $maybe c <- workflowFieldColor f + #{c} + $nothing + None