diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-07 14:16:21 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-07 14:16:21 +0100 |
commit | 7065a8cc1b8b01cd32d4b1d5317b323fec5238bd (patch) | |
tree | d6608f463b066aa6caf33357fd9ae0e508e49084 /webgui/src | |
parent | 75d9fe614dca572aa1d7cfa53553e9c103eb2dd0 (diff) | |
download | thermoprint-7065a8cc1b8b01cd32d4b1d5317b323fec5238bd.tar thermoprint-7065a8cc1b8b01cd32d4b1d5317b323fec5238bd.tar.gz thermoprint-7065a8cc1b8b01cd32d4b1d5317b323fec5238bd.tar.bz2 thermoprint-7065a8cc1b8b01cd32d4b1d5317b323fec5238bd.tar.xz thermoprint-7065a8cc1b8b01cd32d4b1d5317b323fec5238bd.zip |
Bump versions
Diffstat (limited to 'webgui/src')
-rw-r--r-- | webgui/src/Main.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs index 03cd318..65dbfc7 100644 --- a/webgui/src/Main.hs +++ b/webgui/src/Main.hs | |||
@@ -40,6 +40,7 @@ import Data.Time | |||
40 | import Control.Concurrent | 40 | import Control.Concurrent |
41 | import Control.Exception | 41 | import Control.Exception |
42 | import Control.Monad.Catch | 42 | import Control.Monad.Catch |
43 | import Control.Monad.Catch.Pure | ||
43 | 44 | ||
44 | import Control.Applicative | 45 | import Control.Applicative |
45 | import Control.Monad hiding (sequence) | 46 | import Control.Monad hiding (sequence) |
@@ -151,9 +152,9 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
151 | status <- stepper init statusEvent | 152 | status <- stepper init statusEvent |
152 | return (status, triggerStatusChange) | 153 | return (status, triggerStatusChange) |
153 | 154 | ||
154 | Client{..} = mkClient (hoistNat $ Nat liftIO) server | 155 | Client{..} = (mkClient' server :: Client (CatchT UI)) |
155 | withFatal :: ExceptT ServantError UI a -> UI a | 156 | withFatal :: CatchT UI a -> UI a |
156 | withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runExceptT a | 157 | withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runCatchT a |
157 | 158 | ||
158 | handleEditor selectedPrinter (_, modifyFocusedJobs) = do | 159 | handleEditor selectedPrinter (_, modifyFocusedJobs) = do |
159 | title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle" | 160 | title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle" |
@@ -259,7 +260,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
259 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" | 260 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" |
260 | on UI.click enactDeletion . const $ do | 261 | on UI.click enactDeletion . const $ do |
261 | cMarking <- currentValue marking | 262 | cMarking <- currentValue marking |
262 | mapM_ (runExceptT . draftDelete) cMarking | 263 | mapM_ (runCatchT . draftDelete) cMarking |
263 | cDraft <- associatedDraft <$> currentValue editorState | 264 | cDraft <- associatedDraft <$> currentValue editorState |
264 | when (Set.member cDraft $ Set.map Just cMarking) $ changeEditorState (\s -> s { associatedDraft = Nothing } ) | 265 | when (Set.member cDraft $ Set.map Just cMarking) $ changeEditorState (\s -> s { associatedDraft = Nothing } ) |
265 | updateMarking Set.empty | 266 | updateMarking Set.empty |
@@ -348,7 +349,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
348 | (marking, (liftIO .) -> updateMarking) <- stepper' $ Set.empty | 349 | (marking, (liftIO .) -> updateMarking) <- stepper' $ Set.empty |
349 | 350 | ||
350 | enactAbortion <- fatal' "Could not find deletion button" =<< getElementById window "enactAbortion" | 351 | enactAbortion <- fatal' "Could not find deletion button" =<< getElementById window "enactAbortion" |
351 | on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runExceptT . jobDelete) >> updateMarking Set.empty | 352 | on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runCatchT . jobDelete) >> updateMarking Set.empty |
352 | 353 | ||
353 | (selectedPrinter, updatePrinter) <- do | 354 | (selectedPrinter, updatePrinter) <- do |
354 | autoselectPrinter <- fatal' "Could not find printer autoselect switch" =<< getElementById window "autoselectPrinter" | 355 | autoselectPrinter <- fatal' "Could not find printer autoselect switch" =<< getElementById window "autoselectPrinter" |