From 4affa4001afa5cad8ed2e8cd865fae21812badce Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 26 Feb 2016 00:35:57 +0000 Subject: View job contents --- webgui/src/Main.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 'webgui/src') diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs index 644c4f6..018e59b 100644 --- a/webgui/src/Main.hs +++ b/webgui/src/Main.hs @@ -361,7 +361,27 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do let abortButton' = case status of Queued _ -> [abortButton] _ -> [] - actions <- UI.td # set children abortButton' + viewJob = do + tabLinkList <- fatal' "Could not find tab link list" =<< getElementById window "tabLinks" + tabContainer <- fatal' "Could not find tab container" =<< getElementById window "tabContent" + content <- job rJId + let + text = cobbcode content + case text of + Left err -> emitError $ "Could not decode content of job #" ++ show jId ++ ": " ++ show err + Right (T.unpack -> text) -> void $ do + tabLink <- UI.a # set UI.href ("#viewJob" ++ show jId) # set UI.text ("Job #" ++ show jId) + tabLinkItem <- UI.li # set children [tabLink] + return tabLinkList #+ [ return tabLinkItem ] + closeLink <- UI.a # set UI.text "Close Tab" # set UI.class_ "close" # set UI.href "#printers" + tabContent <- UI.pre # set UI.text text + tab <- UI.new # set children [closeLink, tabContent] # set UI.id_ ("viewJob" ++ show jId) # set UI.class_ "tab" + return tabContainer #+ [ return tab ] + on UI.click closeLink . const $ mapM_ delete [tabLink, tabLinkItem, closeLink, tabContent, tab] >> runFunction (switchTab "printers") + runFunction . switchTab $ "viewJob" ++ show jId + viewButton <- UI.button # set UI.text "View" + on UI.click viewButton . const $ viewJob + actions <- UI.td # set children (viewButton : 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 -- cgit v1.2.3