From a93837da703767b6a982ead94494df7c885b46f1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 25 Feb 2016 14:07:03 +0100
Subject: Checkbox to disable autosave

---
 webgui/src/Main.hs | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

(limited to 'webgui/src')

diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs
index dde6eb1..cbb1a75 100644
--- a/webgui/src/Main.hs
+++ b/webgui/src/Main.hs
@@ -45,6 +45,7 @@ import           Data.Monoid
 import           Text.Read hiding (get)
 import           Data.Either
 import           Data.List (isPrefixOf)
+import           Data.Bool
 
 import           Paths_thermoprint_webgui
 
@@ -147,6 +148,10 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
 
       (editorStatus, fmap liftIO -> changeEditorStatus) <- stepper' def
 
+      saveDraft <- do
+        saveDraft <- fatal' "Could not find save switch" =<< getElementById window "saveDraft"
+        flip stepper (UI.checkedChange saveDraft) =<< saveDraft # get UI.checked
+                  
       let
         modifyStatus f = changeEditorStatus . f =<< currentValue editorStatus
 
@@ -186,10 +191,11 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
             when' :: Applicative m => Bool -> m a -> m (Maybe a)
             when' True = fmap Just
             when' False = const $ pure Nothing
-        discardAction = do
+        clearAction = do
           -- maybe (return ()) draftDelete . associatedDraft =<< currentValue editorStatus
           saved <- saveAction False
-          when saved $ modifyStatus $ const def
+          when saved $ discardAction
+        discardAction = modifyStatus $ const def
         printAction = do
           EditorState{..} <- currentValue editorStatus
           case ePrintout of
@@ -201,15 +207,18 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
                 runFunction . focusJob =<< jobCreate Nothing po -- FIXME
             Left err -> emitError $ "Could not print draft due to error parsing bbcode: " ++ show err
 
-      onEvent (tick autoSaveTimer) (const . void $ saveAction True)
+      onEvent (whenE saveDraft $ tick autoSaveTimer) (const . void $ saveAction True)
 
-      return saveButton # sink UI.enabled (saveable <$> editorStatus)
+      return saveButton # sink UI.enabled ((&&) <$> (saveable <$> editorStatus) <*> saveDraft)
       return printButton # sink UI.enabled (printable <$> editorStatus)
       return discardButton # sink UI.enabled (discardable <$> editorStatus)
 
-      on UI.click saveButton . const . void $ saveAction False
+      return discardButton # sink UI.text (bool "Discard" "Save & Clear" <$> saveDraft)
+
+      on (whenE saveDraft . UI.click) saveButton . const . void $ saveAction False
       on UI.click printButton $ const printAction
-      on UI.click discardButton $ const discardAction
+      on (whenE (not <$> saveDraft) . UI.click) discardButton $ const discardAction
+      on (whenE saveDraft . UI.click) discardButton $ const clearAction
 
       return modifyStatus
 
-- 
cgit v1.2.3