safer deletion

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
 
 updateDraft :: API.DraftId -> Maybe DraftTitle -> Printout -> Handler ()
 updateDraft draftId title content = handle (\(KeyNotFound _) -> throwError $ err404) $ do
-  runSqlPool (update (castId draftId) [ DraftTitle =. title, DraftContent =. content ]) =<< asks sqlPool
+  void . runSqlPool (updateGet (castId draftId) [ DraftTitle =. title, DraftContent =. content ]) =<< asks sqlPool
   $(logInfo) $ "Updated draft #" <> (T.pack $ show (castId draftId :: Integer))
   notify $ safeLink thermoprintAPI (Proxy :: Proxy ("draft" :> Capture "draftId" API.DraftId :> Get '[JSON] (Maybe DraftTitle, Printout))) $ draftId
 
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 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-server
-version:             2.0.0
+version:             2.0.1
 synopsis:            Server for thermoprint-spec
 -- description:         
 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
   
   selectedPrinter <- handleJobTable fJobs
 
-  changeEditorStatus <- handleEditor selectedPrinter fJobs
+  (editorStatus, changeEditorStatus) <- handleEditor selectedPrinter fJobs
 
-  handleDraftTable changeEditorStatus
+  handleDraftTable (editorStatus, changeEditorStatus)
   
   where
     handleSocketErr InvalidMessage = emitError "Received unparseable message from server-side websocket"
@@ -242,13 +242,13 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
       on (whenE (not <$> saveDraft) . UI.click) discardButton $ const discardAction
       on (whenE saveDraft . UI.click) discardButton $ const clearAction
 
-      return modifyStatus
+      return (editorStatus, modifyStatus)
 
     saveable s@EditorState{..} = isRight ePrintout && discardable s
     printable EditorState{..} = isRight ePrintout && not (null eText)
     discardable EditorState{..} = not (maybe True null eTitle && null eText)
 
-    handleDraftTable changeEditorState = do
+    handleDraftTable (editorState, changeEditorState) = do
       -- allowDeletion <- fatal' "Could not find deletion switch" =<< getElementById window "allowDeletion"
       -- deletion' <- allowDeletion # get UI.checked
 
@@ -257,7 +257,12 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
 
       
       enactDeletion <- fatal' "Could not find deletion button" =<< getElementById window "enactDeletion"
-      on UI.click enactDeletion . const $ currentValue marking >>= mapM_ (runExceptT . draftDelete) >> updateMarking Set.empty
+      on UI.click enactDeletion . const $ do
+        cMarking <- currentValue marking
+        mapM_ (runExceptT . draftDelete) cMarking
+        cDraft <- associatedDraft <$> currentValue editorState
+        when (Set.member cDraft $ Set.map Just cMarking) $ changeEditorState (\s -> s { associatedDraft = Nothing } )
+        updateMarking Set.empty
       -- deletion' <- allowDeletion # get UI.checked
       let
         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 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                thermoprint-webgui
-version:             1.0.0
+version:             1.0.1
 synopsis:            Threepenny interface for thermoprint-spec compliant servers
 -- description:         
 homepage:            http://dirty-haskell.org/tags/thermoprint.html