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