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 |