aboutsummaryrefslogtreecommitdiff
path: root/webgui
diff options
context:
space:
mode:
authorGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-17 19:21:56 +0200
committerGregor Kleen <pngwjpgh@users.noreply.github.com>2016-07-17 19:21:56 +0200
commit2b9ceaead3f3cd80e973cccecb9a3eebc51154f7 (patch)
treedf2378943480647606b6a06f62c0f4b8b2ab406d /webgui
parentac4cf4a0a494eafe55364f816569c517684fdf32 (diff)
downloadthermoprint-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.hs9
-rw-r--r--webgui/thermoprint-webgui.cabal8
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
4name: thermoprint-webgui 4name: thermoprint-webgui
5version: 0.0.0 5version: 1.0.0
6synopsis: Threepenny interface for thermoprint-spec compliant servers 6synopsis: Threepenny interface for thermoprint-spec compliant servers
7-- description: 7-- description:
8homepage: http://dirty-haskell.org/tags/thermoprint.html 8homepage: 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