@@ -1,4 +1,4 @@
1−{-# LANGUAGE TypeOperators, DeriveGeneric, NamedFieldPuns, DataKinds #-}
1+{-# LANGUAGE TypeOperators, DeriveGeneric, NamedFieldPuns, DataKinds, StandaloneDeriving, FlexibleContexts #-}
22
33module PGQueue.Endpoints where
44
@@ -29,11 +29,11 @@ import Data.Time.Format.Human as Time
2929import Data.Aeson as Aeson
3030import qualified Data.HashMap.Strict as HM
3131import GHC.Exts (toList)
32−
33−data Routes route = Routes
34− { rFilterResults :: route :- Get '[HTML] (Html ())
35− , rStaticAssets :: route :- "assets" :> Raw
36− } deriving (Generic)
32+import Data.Maybe (fromMaybe)
33+import Data.Text.Conversions (fromText, toText)
34+import Control.Applicative ((<|>))
35+import Data.Time.Convenience as Time
36+import qualified PGQueue.Links as Links
3737
3838startApp :: IO ()
3939startApp = do
@@ -73,19 +73,22 @@ server = Routes
7373 , rStaticAssets = serveDirectoryFileServer "assets"
7474 }
7575
76+
7677withDbConnection :: HasJobMonitor m
7778 => (Connection -> m a)
7879 -> m a
7980withDbConnection fn = getDbPool >>= \pool -> Pool.withResource pool fn
8081
8182filterResults :: HasJobMonitor m
82− => m (Html ())
83−filterResults = do
84− jobs <- withDbConnection $ \conn -> filterJobs blankFilter
83+ => Maybe Filter
84+ -> m (Html ())
85+filterResults mFilter = do
86+ let filters = fromMaybe mempty mFilter
87+ jobs <- withDbConnection $ \conn -> filterJobs filters
8588 t <- liftIO getCurrentTime
8689 pure $ pageLayout $ do
87− searchBar
88− resultsPanel t jobs
90+ searchBar t filters
91+ resultsPanel t filters jobs
8992
9093
9194pageNav :: Html ()
@@ -133,28 +136,37 @@ pageLayout inner = do
133136 script_ [ src_ "https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.6.0/slick.js" ] $ ("" :: Text)
134137 script_ [ src_ "assets/js/logo-slider.js" ] $ ("" :: Text)
135138
136−searchBar :: Html ()
137−searchBar = do
139+searchBar :: UTCTime -> Filter -> Html ()
140+searchBar t filter@Filter{filterStatuses, filterCreatedAfter, filterCreatedBefore, filterUpdatedAfter, filterUpdatedBefore, filterJobTypes} = do
138141 form_ [ style_ "padding-top: 2em;" ] $ do
139142 div_ [ class_ "form-group" ] $ do
140143 div_ [ class_ "search-container" ] $ do
141144 ul_ [ class_ "list-inline search-bar" ] $ do
142− -- li_ [ class_ "search-filter" ] $ do
143− -- span_ [ class_ "filter-name" ] $ "Status"
144− -- span_ [ class_ "filter-value" ] $ do
145− -- "Currently running"
146− -- a_ [ href_ "#", class_ "text-danger" ] $ i_ [ class_ "glyphicon glyphicon-remove" ] $ ""
147− li_ [ class_ "search-filter" ] $ ""
145+ forM_ filterStatuses $ \s -> renderFilter "Status" (toText s) "#"
146+ maybe mempty (\x -> renderFilter "Created after" (showText x) "#") filterCreatedAfter
147+ maybe mempty (\x -> renderFilter "Created before" (showText x) "#") filterCreatedBefore
148+ maybe mempty (\x -> renderFilter "Updated after" (showText x) "#") filterUpdatedAfter
149+ maybe mempty (\x -> renderFilter "Updated before" (showText x) "#") filterUpdatedBefore
150+ forM_ filterJobTypes $ \x -> renderFilter "Job type" x "#"
151+
148152 button_ [ class_ "btn btn-default search-button", type_ "button" ] $ "Search"
149153 ul_ [ class_ "list-inline" ] $ do
150154 li_ $ span_ $ strong_ "Common searches:"
151− li_ $ a_ [ href_ "#" ] $ "All jobs"
155+ li_ $ a_ [ href_ (Links.rFilterResults $ Just mempty) ] $ "All jobs"
152156 li_ $ a_ [ href_ "#" ] $ "Currently running"
153− li_ $ a_ [ href_ "#" ] $ "Successful"
154− li_ $ a_ [ href_ "#" ] $ "Failed"
155− li_ $ a_ [ href_ "#" ] $ "Future"
157+ li_ $ a_ [ href_ (Links.rFilterResults $ Just $ filter <> mempty{ filterStatuses = [Job.Success] }) ] $ "Successful"
158+ li_ $ a_ [ href_ (Links.rFilterResults $ Just $ filter <> mempty{ filterStatuses = [Job.Failed] }) ] $ "Failed"
159+ li_ $ a_ [ href_ (Links.rFilterResults $ Just $ filter <> mempty{ filterStatuses = [Job.Queued] }) ] $ "Future"
156160 li_ $ a_ [ href_ "#" ] $ "Retried"
157− li_ $ a_ [ href_ "#" ] $ "Last 10 mins"
161+ li_ $ a_ [ href_ (Links.rFilterResults $ Just $ filter <> mempty{ filterUpdatedAfter = Just $ timeSince t 10 Minutes Ago }) ] $ "Last 10 mins"
162+ where
163+ renderFilter :: Text -> Text -> Text -> Html ()
164+ renderFilter k v u = do
165+ li_ [ class_ "search-filter" ] $ do
166+ span_ [ class_ "filter-name" ] $ toHtml k
167+ span_ [ class_ "filter-value" ] $ do
168+ toHtml v
169+ a_ [ href_ u, class_ "text-danger" ] $ i_ [ class_ "glyphicon glyphicon-remove" ] $ ""
158170
159171
160172timeDuration :: UTCTime -> UTCTime -> (Int, String)
@@ -376,8 +388,8 @@ rowLocked = do
376388 td_ "Text"
377389 td_ $ button_ [ class_ "btn btn-default", type_ "button" ] $ "Unlock"
378390
379−resultsPanel :: UTCTime -> [Job] -> Html ()
380−resultsPanel t jobs = do
391+resultsPanel :: UTCTime -> Filter -> [Job] -> Html ()
392+resultsPanel t filter@Filter{filterPage} jobs = do
381393 div_ [ class_ "panel panel-default" ] $ do
382394 div_ [ class_ "panel-heading" ] $ h3_ [ class_ "panel-title" ] $ do
383395 "Currently running"
@@ -399,8 +411,13 @@ resultsPanel t jobs = do
399411 -- rowRetry
400412 -- rowFailed
401413 div_ [ class_ "panel-footer" ] $ nav_ $ ul_ [ class_ "pager", style_ "margin:0px;" ] $ do
402− li_ [ class_ "previous" ] $ a_ [ href_ "#" ] $ "Prev"
403− li_ [ class_ "next" ] $ a_ [ href_ "#" ] $ "Next"
414+ li_ [ class_ "previous" ] $ case filterPage of
415+ Nothing -> a_ [ disabled_ "disabled" ] $ "Prev"
416+ Just (l, 0) -> a_ [ disabled_ "disabled" ] $ "Prev"
417+ Just (l, o) -> a_ [ href_ (Links.rFilterResults $ Just $ filter {filterPage = Just (l, max 0 $ o - l)}) ] $ "Prev"
418+ li_ [ class_ "next" ] $ case filterPage of
419+ Nothing -> a_ [ href_ (Links.rFilterResults $ Just $ filter {filterPage = Just (10, 10)}) ] $ "Next"
420+ Just (l, o) -> a_ [ href_ (Links.rFilterResults $ Just $ filter {filterPage = Just (l, o + l)}) ] $ "Next"
404421
405422
406423ariaExpanded_ :: Text -> Attribute