Ticket filtering

This commit is contained in:
fr33domlover 2016-05-22 14:31:56 +00:00
parent 83a56d5fb8
commit 1a3f976a81
5 changed files with 85 additions and 2 deletions

View file

@ -17,6 +17,7 @@ module Vervis.Form.Ticket
( NewTicket (..) ( NewTicket (..)
, newTicketForm , newTicketForm
, editTicketForm , editTicketForm
, ticketFilterForm
) )
where where
@ -31,6 +32,7 @@ import Yesod.Form
import Vervis.Foundation (Form, Handler) import Vervis.Foundation (Form, Handler)
import Vervis.Model import Vervis.Model
import Vervis.TicketFilter (TicketFilter (..))
--TODO use custom fields to ensure uniqueness or other constraints? --TODO use custom fields to ensure uniqueness or other constraints?
@ -83,3 +85,13 @@ editTicketAForm ticket pid = fmap fixDone $ Ticket
editTicketForm :: Ticket -> PersonId -> Form Ticket editTicketForm :: Ticket -> PersonId -> Form Ticket
editTicketForm t p = renderDivs $ editTicketAForm t p editTicketForm t p = renderDivs $ editTicketAForm t p
ticketFilterAForm :: AForm Handler TicketFilter
ticketFilterAForm = TicketFilter
<$> areq (selectFieldList status) "Status*" (Just Nothing)
where
status :: [(Text, Maybe Bool)]
status = [("Open", Just False), ("Closed", Just True), ("All", Nothing)]
ticketFilterForm :: Form TicketFilter
ticketFilterForm = renderDivs ticketFilterAForm

View file

@ -34,6 +34,7 @@ where
import Prelude import Prelude
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Default.Class (def)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Calendar (Day (..)) import Data.Time.Calendar (Day (..))
@ -45,7 +46,7 @@ import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId) import Yesod.Auth (requireAuthId)
import Yesod.Core (defaultLayout) import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound) import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound)
import Yesod.Form.Functions (runFormPost) import Yesod.Form.Functions (runFormGet, runFormPost)
import Yesod.Form.Types (FormResult (..)) import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404) import Yesod.Persist.Core (runDB, get404, getBy404)
@ -59,12 +60,20 @@ import Vervis.MediaType (MediaType (Markdown))
import Vervis.Model import Vervis.Model
import Vervis.Render (renderSourceT) import Vervis.Render (renderSourceT)
import Vervis.Settings (widgetFile) import Vervis.Settings (widgetFile)
import Vervis.TicketFilter (filterTickets)
import Vervis.Widget.Discussion (discussionW) import Vervis.Widget.Discussion (discussionW)
getTicketsR :: Text -> Text -> Handler Html getTicketsR :: Text -> Text -> Handler Html
getTicketsR shar proj = do getTicketsR shar proj = 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 $ select $ from $ \ (sharer, project, ticket) -> do rows <- runDB $ select $ from $ \ (sharer, project, ticket) -> do
where_ $ where_ $ filterTickets tf ticket $
sharer ^. SharerIdent E.==. val shar &&. sharer ^. SharerIdent E.==. val shar &&.
project ^. ProjectSharer E.==. sharer ^. SharerId &&. project ^. ProjectSharer E.==. sharer ^. SharerId &&.
project ^. ProjectIdent E.==. val proj &&. project ^. ProjectIdent E.==. val proj &&.

View file

@ -0,0 +1,57 @@
{- 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/>.
-}
module Vervis.TicketFilter
( TicketFilter (..)
, filterTickets
)
where
import Prelude
import Data.Default.Class
import Database.Esqueleto
import Vervis.Model
data TicketFilter = TicketFilter
{ tfStatus :: Maybe Bool
}
instance Default TicketFilter where
def = TicketFilter
{ tfStatus = Nothing
}
ticketFilter
:: Esqueleto q e b
=> TicketFilter
-> e (Entity Ticket)
-> Maybe (e (Value Bool))
ticketFilter tf ticket =
case tfStatus tf of
Nothing -> Nothing
Just t -> Just $ ticket ^. TicketDone ==. val t
filterTickets
:: Esqueleto q e b
=> TicketFilter
-> e (Entity Ticket)
-> e (Value Bool)
-> e (Value Bool)
filterTickets tf ticket cond =
case ticketFilter tf ticket of
Nothing -> cond
Just f -> cond &&. f

View file

@ -15,6 +15,10 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<p> <p>
<a href=@{TicketNewR shar proj}>Create new… <a href=@{TicketNewR shar proj}>Create new…
<form method=GET action=@{TicketsR shar proj} enctype=#{filtEnctype}>
^{filtWidget}
<input type="submit" value="Filter">
<table> <table>
<tr> <tr>
<th>Number <th>Number

View file

@ -111,6 +111,7 @@ library
Vervis.SourceTree Vervis.SourceTree
Vervis.Ssh Vervis.Ssh
Vervis.Style Vervis.Style
Vervis.TicketFilter
Vervis.Widget Vervis.Widget
Vervis.Widget.Discussion Vervis.Widget.Discussion
Vervis.Widget.Repo Vervis.Widget.Repo