diff options
-rw-r--r-- | server/src/Thermoprint/Server/API.hs | 2 | ||||
-rw-r--r-- | server/thermoprint-server.cabal | 2 | ||||
-rw-r--r-- | webgui/src/Main.hs | 15 | ||||
-rw-r--r-- | webgui/thermoprint-webgui.cabal | 2 |
4 files changed, 13 insertions, 8 deletions
diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs index 8e17eb4..f7a8576 100644 --- a/server/src/Thermoprint/Server/API.hs +++ b/server/src/Thermoprint/Server/API.hs | |||
@@ -192,7 +192,7 @@ addDraft title content = do | |||
192 | 192 | ||
193 | updateDraft :: API.DraftId -> Maybe DraftTitle -> Printout -> Handler () | 193 | updateDraft :: API.DraftId -> Maybe DraftTitle -> Printout -> Handler () |
194 | updateDraft draftId title content = handle (\(KeyNotFound _) -> throwError $ err404) $ do | 194 | updateDraft draftId title content = handle (\(KeyNotFound _) -> throwError $ err404) $ do |
195 | runSqlPool (update (castId draftId) [ DraftTitle =. title, DraftContent =. content ]) =<< asks sqlPool | 195 | void . runSqlPool (updateGet (castId draftId) [ DraftTitle =. title, DraftContent =. content ]) =<< asks sqlPool |
196 | $(logInfo) $ "Updated draft #" <> (T.pack $ show (castId draftId :: Integer)) | 196 | $(logInfo) $ "Updated draft #" <> (T.pack $ show (castId draftId :: Integer)) |
197 | notify $ safeLink thermoprintAPI (Proxy :: Proxy ("draft" :> Capture "draftId" API.DraftId :> Get '[JSON] (Maybe DraftTitle, Printout))) $ draftId | 197 | notify $ safeLink thermoprintAPI (Proxy :: Proxy ("draft" :> Capture "draftId" API.DraftId :> Get '[JSON] (Maybe DraftTitle, Printout))) $ draftId |
198 | 198 | ||
diff --git a/server/thermoprint-server.cabal b/server/thermoprint-server.cabal index 37cf065..afb62db 100644 --- a/server/thermoprint-server.cabal +++ b/server/thermoprint-server.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-server | 4 | name: thermoprint-server |
5 | version: 2.0.0 | 5 | version: 2.0.1 |
6 | synopsis: Server for thermoprint-spec | 6 | synopsis: Server for thermoprint-spec |
7 | -- description: | 7 | -- description: |
8 | homepage: http://dirty-haskell.org/tags/thermoprint.html | 8 | homepage: http://dirty-haskell.org/tags/thermoprint.html |
diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs index 252e933..e4b25e6 100644 --- a/webgui/src/Main.hs +++ b/webgui/src/Main.hs | |||
@@ -123,9 +123,9 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
123 | 123 | ||
124 | selectedPrinter <- handleJobTable fJobs | 124 | selectedPrinter <- handleJobTable fJobs |
125 | 125 | ||
126 | changeEditorStatus <- handleEditor selectedPrinter fJobs | 126 | (editorStatus, changeEditorStatus) <- handleEditor selectedPrinter fJobs |
127 | 127 | ||
128 | handleDraftTable changeEditorStatus | 128 | handleDraftTable (editorStatus, changeEditorStatus) |
129 | 129 | ||
130 | where | 130 | where |
131 | handleSocketErr InvalidMessage = emitError "Received unparseable message from server-side websocket" | 131 | handleSocketErr InvalidMessage = emitError "Received unparseable message from server-side websocket" |
@@ -242,13 +242,13 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
242 | on (whenE (not <$> saveDraft) . UI.click) discardButton $ const discardAction | 242 | on (whenE (not <$> saveDraft) . UI.click) discardButton $ const discardAction |
243 | on (whenE saveDraft . UI.click) discardButton $ const clearAction | 243 | on (whenE saveDraft . UI.click) discardButton $ const clearAction |
244 | 244 | ||
245 | return modifyStatus | 245 | return (editorStatus, modifyStatus) |
246 | 246 | ||
247 | saveable s@EditorState{..} = isRight ePrintout && discardable s | 247 | saveable s@EditorState{..} = isRight ePrintout && discardable s |
248 | printable EditorState{..} = isRight ePrintout && not (null eText) | 248 | printable EditorState{..} = isRight ePrintout && not (null eText) |
249 | discardable EditorState{..} = not (maybe True null eTitle && null eText) | 249 | discardable EditorState{..} = not (maybe True null eTitle && null eText) |
250 | 250 | ||
251 | handleDraftTable changeEditorState = do | 251 | handleDraftTable (editorState, changeEditorState) = do |
252 | -- allowDeletion <- fatal' "Could not find deletion switch" =<< getElementById window "allowDeletion" | 252 | -- allowDeletion <- fatal' "Could not find deletion switch" =<< getElementById window "allowDeletion" |
253 | -- deletion' <- allowDeletion # get UI.checked | 253 | -- deletion' <- allowDeletion # get UI.checked |
254 | 254 | ||
@@ -257,7 +257,12 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do | |||
257 | 257 | ||
258 | 258 | ||
259 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" | 259 | enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion" |
260 | on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runExceptT . draftDelete) >> updateMarking Set.empty | 260 | on UI.click enactDeletion . const $ do |
261 | cMarking <- currentValue marking | ||
262 | mapM_ (runExceptT . draftDelete) cMarking | ||
263 | cDraft <- associatedDraft <$> currentValue editorState | ||
264 | when (Set.member cDraft $ Set.map Just cMarking) $ changeEditorState (\s -> s { associatedDraft = Nothing } ) | ||
265 | updateMarking Set.empty | ||
261 | -- deletion' <- allowDeletion # get UI.checked | 266 | -- deletion' <- allowDeletion # get UI.checked |
262 | let | 267 | let |
263 | updateMarking' = callFunction (mangle <$> ffi getChecked) >>= updateMarking | 268 | updateMarking' = callFunction (mangle <$> ffi getChecked) >>= updateMarking |
diff --git a/webgui/thermoprint-webgui.cabal b/webgui/thermoprint-webgui.cabal index 03aa9b2..25af096 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.0 | 5 | version: 1.0.1 |
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 |