diff options
| author | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-17 19:21:56 +0200 |
|---|---|---|
| committer | Gregor Kleen <pngwjpgh@users.noreply.github.com> | 2016-07-17 19:21:56 +0200 |
| commit | 2b9ceaead3f3cd80e973cccecb9a3eebc51154f7 (patch) | |
| tree | df2378943480647606b6a06f62c0f4b8b2ab406d /webgui | |
| parent | ac4cf4a0a494eafe55364f816569c517684fdf32 (diff) | |
| download | thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.gz thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.bz2 thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.tar.xz thermoprint-2b9ceaead3f3cd80e973cccecb9a3eebc51154f7.zip | |
Fixes for GHC 8.0.1
Diffstat (limited to 'webgui')
| -rw-r--r-- | webgui/src/Main.hs | 9 | ||||
| -rw-r--r-- | webgui/thermoprint-webgui.cabal | 8 |
2 files changed, 9 insertions, 8 deletions
diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs index a295fd9..252e933 100644 --- a/webgui/src/Main.hs +++ b/webgui/src/Main.hs | |||
| @@ -86,6 +86,7 @@ config = do | |||
| 86 | <*> (BaseUrl Http | 86 | <*> (BaseUrl Http |
| 87 | <$> Opt.strOption (Opt.long "target-addr" <> Opt.short 'A' <> Opt.metavar "HOST" <> Opt.help "Host to connect to" <> Opt.value "localhost" <> Opt.showDefault) | 87 | <$> Opt.strOption (Opt.long "target-addr" <> Opt.short 'A' <> Opt.metavar "HOST" <> Opt.help "Host to connect to" <> Opt.value "localhost" <> Opt.showDefault) |
| 88 | <*> Opt.option Opt.auto (Opt.long "target-port" <> Opt.short 'P' <> Opt.metavar "PORT" <> Opt.help "Port to connect to" <> Opt.value 3000 <> Opt.showDefault) | 88 | <*> Opt.option Opt.auto (Opt.long "target-port" <> Opt.short 'P' <> Opt.metavar "PORT" <> Opt.help "Port to connect to" <> Opt.value 3000 <> Opt.showDefault) |
| 89 | <*> Opt.strOption (Opt.long "target-path" <> Opt.short 'F' <> Opt.metavar "PATH" <> Opt.help "Path we expect to find Thermoprint.Server under" <> Opt.value "" <> Opt.showDefault) | ||
| 89 | ) | 90 | ) |
| 90 | where | 91 | where |
| 91 | port def = Opt.long "port" | 92 | port def = Opt.long "port" |
| @@ -151,8 +152,8 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
| 151 | return (status, triggerStatusChange) | 152 | return (status, triggerStatusChange) |
| 152 | 153 | ||
| 153 | Client{..} = mkClient (hoistNat $ Nat liftIO) server | 154 | Client{..} = mkClient (hoistNat $ Nat liftIO) server |
| 154 | withFatal :: EitherT ServantError UI a -> UI a | 155 | withFatal :: ExceptT ServantError UI a -> UI a |
| 155 | withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runEitherT a | 156 | withFatal a = either (fatal . ("Error while communicating to Thermoprint.Server: " ++) . show) return =<< runExceptT a |
| 156 | 157 | ||
| 157 | handleEditor selectedPrinter (_, modifyFocusedJobs) = do | 158 | handleEditor selectedPrinter (_, modifyFocusedJobs) = do |
| 158 | title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle" | 159 | title <- fatal' "Could not find editor title field" =<< getElementById window "editorTitle" |
| @@ -256,7 +257,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
| 256 | 257 | ||
| 257 | 258 | ||
| 258 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" | 259 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" |
| 259 | on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runEitherT . draftDelete) >> updateMarking Set.empty | 260 | on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runExceptT . draftDelete) >> updateMarking Set.empty |
| 260 | -- deletion' <- allowDeletion # get UI.checked | 261 | -- deletion' <- allowDeletion # get UI.checked |
| 261 | let | 262 | let |
| 262 | updateMarking' = callFunction (mangle <$> ffi getChecked) >>= updateMarking | 263 | updateMarking' = callFunction (mangle <$> ffi getChecked) >>= updateMarking |
| @@ -342,7 +343,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
| 342 | (marking, (liftIO .) -> updateMarking) <- stepper' $ Set.empty | 343 | (marking, (liftIO .) -> updateMarking) <- stepper' $ Set.empty |
| 343 | 344 | ||
| 344 | enactAbortion <- fatal' "Could not find deletion button" =<< getElementById window "enactAbortion" | 345 | enactAbortion <- fatal' "Could not find deletion button" =<< getElementById window "enactAbortion" |
| 345 | on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runEitherT . jobDelete) >> updateMarking Set.empty | 346 | on UI.click enactAbortion . const $ currentValue marking >>= mapM_ (runExceptT . jobDelete) >> updateMarking Set.empty |
| 346 | 347 | ||
| 347 | (selectedPrinter, updatePrinter) <- do | 348 | (selectedPrinter, updatePrinter) <- do |
| 348 | autoselectPrinter <- fatal' "Could not find printer autoselect switch" =<< getElementById window "autoselectPrinter" | 349 | autoselectPrinter <- fatal' "Could not find printer autoselect switch" =<< getElementById window "autoselectPrinter" |
diff --git a/webgui/thermoprint-webgui.cabal b/webgui/thermoprint-webgui.cabal index 024bcf6..03aa9b2 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: 0.0.0 | 5 | version: 1.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 |
| @@ -25,9 +25,9 @@ executable thermoprint-webgui | |||
| 25 | main-is: Main.hs | 25 | main-is: Main.hs |
| 26 | -- other-modules: | 26 | -- other-modules: |
| 27 | -- other-extensions: | 27 | -- other-extensions: |
| 28 | build-depends: base >=4.8 && <4.9 | 28 | build-depends: base >=4.8 && <5 |
| 29 | , thermoprint-bbcode >=1.0.0 && <2 | 29 | , thermoprint-bbcode >=2.0.0 && <3 |
| 30 | , thermoprint-client ==0.0.* | 30 | , thermoprint-client ==1.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 |
