diff options
Diffstat (limited to 'webgui')
| -rw-r--r-- | webgui/src/Main.hs | 11 | ||||
| -rw-r--r-- | webgui/thermoprint-webgui.cabal | 6 | ||||
| -rw-r--r-- | webgui/thermoprint-webgui.nix | 2 |
3 files changed, 10 insertions, 9 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" |
diff --git a/webgui/thermoprint-webgui.cabal b/webgui/thermoprint-webgui.cabal index 9c67a9c..dcd3c4f 100644 --- a/webgui/thermoprint-webgui.cabal +++ b/webgui/thermoprint-webgui.cabal | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | -- documentation, see http://haskell.org/cabal/users-guide/ | 2 | -- documentation, see http://haskell.org/cabal/users-guide/ |
| 3 | 3 | ||
| 4 | name: thermoprint-webgui | 4 | name: thermoprint-webgui |
| 5 | version: 1.0.2 | 5 | version: 2.0.0 |
| 6 | synopsis: Threepenny interface for thermoprint-spec compliant servers | 6 | synopsis: Threepenny interface for thermoprint-spec compliant servers |
| 7 | -- description: | 7 | -- description: |
| 8 | homepage: http://dirty-haskell.org/tags/thermoprint.html | 8 | homepage: http://dirty-haskell.org/tags/thermoprint.html |
| @@ -26,8 +26,8 @@ executable thermoprint-webgui | |||
| 26 | -- other-modules: | 26 | -- other-modules: |
| 27 | -- other-extensions: | 27 | -- other-extensions: |
| 28 | build-depends: base >=4.8 && <5 | 28 | build-depends: base >=4.8 && <5 |
| 29 | , thermoprint-bbcode >=2.0.0 && <3 | 29 | , thermoprint-bbcode >=3.0.0 && <4 |
| 30 | , thermoprint-client ==1.0.* | 30 | , thermoprint-client ==2.0.* |
| 31 | , threepenny-gui >=0.6.0 && <1 | 31 | , threepenny-gui >=0.6.0 && <1 |
| 32 | , optparse-applicative >=0.12.1 && <1 | 32 | , optparse-applicative >=0.12.1 && <1 |
| 33 | , bytestring >=0.10.6 && <1 | 33 | , bytestring >=0.10.6 && <1 |
diff --git a/webgui/thermoprint-webgui.nix b/webgui/thermoprint-webgui.nix index d4cafe8..bff836e 100644 --- a/webgui/thermoprint-webgui.nix +++ b/webgui/thermoprint-webgui.nix | |||
| @@ -5,7 +5,7 @@ | |||
| 5 | }: | 5 | }: |
| 6 | mkDerivation { | 6 | mkDerivation { |
| 7 | pname = "thermoprint-webgui"; | 7 | pname = "thermoprint-webgui"; |
| 8 | version = "1.0.2"; | 8 | version = "2.0.0"; |
| 9 | src = ./.; | 9 | src = ./.; |
| 10 | isLibrary = false; | 10 | isLibrary = false; |
| 11 | isExecutable = true; | 11 | isExecutable = true; |
