Ticket filtering

src/Vervis/Form/Ticket.hs

@@ -17,6 +17,7 @@ module Vervis.Form.Ticket
     ( NewTicket (..)
     , newTicketForm
     , editTicketForm
+    , ticketFilterForm
     )
 where
 
@@ -31,6 +32,7 @@ import Yesod.Form
 
 import Vervis.Foundation (Form, Handler)
 import Vervis.Model
+import Vervis.TicketFilter (TicketFilter (..))
 
 --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 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

src/Vervis/Handler/Ticket.hs

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

src/Vervis/TicketFilter.hs

@@ -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

templates/ticket/list.hamlet

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

vervis.cabal

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