Include jobs in printer table

1 files changed, 32 insertions, 16 deletions

diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs
index dbf34bc..644c4f6 100644
--- a/webgui/src/Main.hs
+++ b/webgui/src/Main.hs
@@ -29,6 +29,8 @@ import           Data.Map        (Map)
 import qualified Data.Map as Map
 import           Data.Sequence        (Seq)
 import qualified Data.Sequence as Seq
+import           Data.Set        (Set)
+import qualified Data.Set as Set
 
 import           Data.Default.Class
 
@@ -105,10 +107,14 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
   onEvent socketErr handleSocketErr
 
   getElementById window "javascriptError" >>= maybeM delete
+
+  (focusedJobs, changeFocusedJobs) <- stepper' Set.empty
+  let modifyFocusedJobs f = changeFocusedJobs . f =<< currentValue focusedJobs
+      fJobs = (focusedJobs, liftIO . modifyFocusedJobs)
   
-  selectedPrinter <- handleJobTable
+  selectedPrinter <- handleJobTable fJobs
 
-  changeEditorStatus <- handleEditor selectedPrinter
+  changeEditorStatus <- handleEditor selectedPrinter fJobs
 
   handleDraftTable changeEditorStatus
   
@@ -143,7 +149,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
 
     Client{..} = mkClient (Nat $ either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return <=< liftIO . runEitherT) server
 
-    handleEditor selectedPrinter = do
+    handleEditor selectedPrinter (_, modifyFocusedJobs) = do
       title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle"
       text <- fatal' "Could not find editor text field" =<< getElementById window "editorText"
       status <- fatal' "Could not find editor status field" =<< getElementById window "editorStatus"
@@ -205,13 +211,15 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
         discardAction = modifyStatus $ const def
         printAction = do
           EditorState{..} <- currentValue editorStatus
+          let
+            reFocusJob jId = modifyFocusedJobs (const $ Set.singleton jId)
           case ePrintout of
             Right po -> case associatedDraft of
               Just dId -> do
                 saved <- saveAction False
-                when saved $ runFunction . focusJob =<< draftPrint dId =<< currentValue selectedPrinter
+                when saved $ reFocusJob =<< draftPrint dId =<< currentValue selectedPrinter
               Nothing -> do
-                runFunction . focusJob =<< flip jobCreate po =<< currentValue selectedPrinter
+                reFocusJob =<< flip jobCreate po =<< currentValue selectedPrinter
             Left err -> emitError $ "Could not print draft due to error parsing bbcode: " ++ show err
 
       onEvent (whenE saveDraft $ tick autoSaveTimer) (const . void $ saveAction True)
@@ -295,10 +303,10 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
     concernsPrinters :: URI -> Bool
     concernsPrinters (uriPath -> p)
       | p == "printers" = True
-      | "jobs/" `isPrefixOf` p = True
+      | p == "jobs" = True
       | otherwise = False
 
-    handleJobTable = do
+    handleJobTable (focusedJobs, _) = do
       allowAbortion <- do
         allowAbortion <- fatal' "Could not find abortion switch" =<< getElementById window "allowAbortion"
         flip stepper (UI.checkedChange allowAbortion) =<< (allowAbortion # get UI.checked)
@@ -320,12 +328,19 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
         -- getJobState :: PrinterId -> UI [(JobId, UTCTime, JobStatus)]
         getJobState pId = toList <$> jobs (Just pId) Nothing Nothing
         mangleTuple (a, (b, c)) = (a, b, c)
-        thrd (_, _, c) = c
+
+        -- jobSort :: (JobId, UTCTime, JobStatus) -> (JobId, UTCTime, JobStatus) -> Ordering
+        jobSort (id, time, status) (id', time', status') = queueSort status status' <> compare time' time <> compare id' id
+          where
+            compare' :: Ord a => a -> a -> Ordering
+            compare'
+              | (Queued _) <- status = compare
+              | otherwise = flip compare
 
         -- toTable :: [(PrinterId, PrinterStatus, [(JobId, UTCTime, JobStatus)])] -> UI [Element]
         toTable = fmap concat . mapM toSubTable
         -- toSubTable :: (PrinterId, PrinterStatus, [(JobId, UTCTime, JobStatus)]) -> UI [Element]
-        toSubTable (rPId@(PrinterId pId), pStatus, (sortBy (queueSort `F.on` thrd) -> jobs)) = do
+        toSubTable (rPId@(PrinterId pId), pStatus, (sortBy jobSort -> jobs)) = do
           pId' <- UI.td # set UI.text (show pId)
           pStatus' <- UI.td # set UI.text (show pStatus)
           let selectId = "printer" ++ show pId
@@ -336,13 +351,18 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
           pSelect' <- UI.td # set children [pSelect, pSelectL]
           pFiller <- UI.td # set UI.colspan 2
           let
-            toLine ((JobId jId), time, status) = do
+            toLine (rJId@(JobId jId), time, status) = do
               jPId <- UI.td
               jId' <- UI.td # set UI.text (show jId)
               jStatus' <- UI.td # set UI.text (show status)
+              time' <- UI.td # set UI.text (formatTime defaultTimeLocale "%F %X" time)
               abortButton <- UI.button # sink UI.enabled allowAbortion # set UI.text "Abort"
-              actions <- UI.td # set children [abortButton]
-              UI.tr # set UI.id_ ("job" ++ show jId) # set children [jPId, jId', jStatus', actions]
+              on UI.click abortButton . const $ jobDelete rJId
+              let abortButton' = case status of
+                    Queued _ -> [abortButton]
+                    _ -> []
+              actions <- UI.td # set children abortButton'
+              UI.tr # set UI.id_ ("job" ++ show jId) # set children [jPId, jId', time', jStatus', actions] # sink UI.class_ (bool "" "focused" . Set.member rJId <$> focusedJobs)
           (:) <$> UI.tr # set children [pId', pFiller, pStatus', pSelect'] <*> mapM toLine jobs
 
       update <- do
@@ -361,10 +381,6 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
 
       return selectedPrinter
 
-
-focusJob :: JobId -> JSFunction ()
-focusJob (JobId (fromInteger -> i)) = ffi "alert(%1)" (i :: Int) -- FIXME
-
 switchTab :: String -> JSFunction ()
 switchTab = ffi "$(%1).first().trigger(\"click\")" . (\p -> "a[href='#" ++ p ++ "']")