1 files changed, 27 insertions, 9 deletions

diff --git a/webgui/src/Main.hs b/webgui/src/Main.hs
index 141b0ea..dde6eb1 100644
--- a/webgui/src/Main.hs
+++ b/webgui/src/Main.hs
@@ -115,7 +115,7 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
         errorsTab = maybe (fatal "Could not make nonfatal errors visible") return =<< getElementById window "errors-tab"
       errors #+ [UI.li # set TP.text str]
       errorsTab # set style [("display", "inline-block")]
-      switchTab "errors"
+      runFunction $ switchTab "errors"
     fatal :: String -> UI a
     fatal str = do
       (getBody window #) . set children =<< sequence [UI.p # set TP.text str # set UI.class_ "fatal"]
@@ -165,34 +165,49 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
       let
         saveAction automatic = do
           s@(EditorState{..}) <- currentValue editorStatus
-          when (not $ maybe True null eTitle && null eText) $ case ePrintout of
-            Left err -> when (not automatic) . emitError $ "Could not save draft due to error parsing bbcode: " ++ show err
+          r <- when' (not $ maybe True null eTitle && null eText) $ case ePrintout of
+            Left err -> do
+              when (not automatic) . emitError $ "Could not save draft due to error parsing bbcode: " ++ show err
+              return False
             Right p -> do
               draftId <- case associatedDraft of
                 Nothing -> draftCreate (T.pack <$> eTitle) p
                 Just i -> i <$ when (different s) (draftReplace i (T.pack <$> eTitle) p)
               time <- liftIO getCurrentTime
               modifyStatus (\x -> x { associatedDraft = Just draftId, lastSaved = Just (time, s) })
+              return True
+          return $ fromMaybe False r
           where
             different s
               | Just (_, s') <- lastSaved s = not $ and [ eTitle s == eTitle s'
                                                         , eText s == eText s'
                                                         ]
               | otherwise = True
+            when' :: Applicative m => Bool -> m a -> m (Maybe a)
+            when' True = fmap Just
+            when' False = const $ pure Nothing
         discardAction = do
           -- maybe (return ()) draftDelete . associatedDraft =<< currentValue editorStatus
-          saveAction False
-          modifyStatus $ const def
+          saved <- saveAction False
+          when saved $ modifyStatus $ const def
         printAction = do
-          emitError "Printing not implemented"
-
-      onEvent (tick autoSaveTimer) (const $ saveAction True)
+          EditorState{..} <- currentValue editorStatus
+          case ePrintout of
+            Right po -> case associatedDraft of
+              Just dId -> do
+                saved <- saveAction False
+                when saved $ runFunction . focusJob =<< draftPrint dId Nothing -- FIXME
+              Nothing -> 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)
 
       return saveButton # sink UI.enabled (saveable <$> editorStatus)
       return printButton # sink UI.enabled (printable <$> editorStatus)
       return discardButton # sink UI.enabled (discardable <$> editorStatus)
 
-      on UI.click saveButton . const $ saveAction False
+      on UI.click saveButton . const . void $ saveAction False
       on UI.click printButton $ const printAction
       on UI.click discardButton $ const discardAction
 
@@ -256,6 +271,9 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
           | "draft/" `isPrefixOf` p = True
           | otherwise = False
 
+focusJob :: JobId -> JSFunction ()
+focusJob (JobId (fromInteger -> i)) = ffi "alert(%1)" (i :: Int) -- FIXME
+
 switchTab :: String -> JSFunction ()
 switchTab = ffi "$(%1).first().trigger(\"click\")" . (\p -> "a[href='#" ++ p ++ "']")