aboutsummaryrefslogtreecommitdiff
path: root/webgui
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-02-25 03:30:19 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-02-25 03:30:19 +0000
commita204390c515048e5427198c15846d52eb806ae23 (patch)
tree9fa0ab309aaee9bf6316e3fdead5b0e23041e694 /webgui
parentf4c9fe7ceb7ad29e9bf0b875ec75e00487f90eeb (diff)
downloadthermoprint-a204390c515048e5427198c15846d52eb806ae23.tar
thermoprint-a204390c515048e5427198c15846d52eb806ae23.tar.gz
thermoprint-a204390c515048e5427198c15846d52eb806ae23.tar.bz2
thermoprint-a204390c515048e5427198c15846d52eb806ae23.tar.xz
thermoprint-a204390c515048e5427198c15846d52eb806ae23.zip
mocked up printing
Diffstat (limited to 'webgui')
-rw-r--r--webgui/src/Main.hs36
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
115 errorsTab = maybe (fatal "Could not make nonfatal errors visible") return =<< getElementById window "errors-tab" 115 errorsTab = maybe (fatal "Could not make nonfatal errors visible") return =<< getElementById window "errors-tab"
116 errors #+ [UI.li # set TP.text str] 116 errors #+ [UI.li # set TP.text str]
117 errorsTab # set style [("display", "inline-block")] 117 errorsTab # set style [("display", "inline-block")]
118 switchTab "errors" 118 runFunction $ switchTab "errors"
119 fatal :: String -> UI a 119 fatal :: String -> UI a
120 fatal str = do 120 fatal str = do
121 (getBody window #) . set children =<< sequence [UI.p # set TP.text str # set UI.class_ "fatal"] 121 (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
165 let 165 let
166 saveAction automatic = do 166 saveAction automatic = do
167 s@(EditorState{..}) <- currentValue editorStatus 167 s@(EditorState{..}) <- currentValue editorStatus
168 when (not $ maybe True null eTitle && null eText) $ case ePrintout of 168 r <- when' (not $ maybe True null eTitle && null eText) $ case ePrintout of
169 Left err -> when (not automatic) . emitError $ "Could not save draft due to error parsing bbcode: " ++ show err 169 Left err -> do
170 when (not automatic) . emitError $ "Could not save draft due to error parsing bbcode: " ++ show err
171 return False
170 Right p -> do 172 Right p -> do
171 draftId <- case associatedDraft of 173 draftId <- case associatedDraft of
172 Nothing -> draftCreate (T.pack <$> eTitle) p 174 Nothing -> draftCreate (T.pack <$> eTitle) p
173 Just i -> i <$ when (different s) (draftReplace i (T.pack <$> eTitle) p) 175 Just i -> i <$ when (different s) (draftReplace i (T.pack <$> eTitle) p)
174 time <- liftIO getCurrentTime 176 time <- liftIO getCurrentTime
175 modifyStatus (\x -> x { associatedDraft = Just draftId, lastSaved = Just (time, s) }) 177 modifyStatus (\x -> x { associatedDraft = Just draftId, lastSaved = Just (time, s) })
178 return True
179 return $ fromMaybe False r
176 where 180 where
177 different s 181 different s
178 | Just (_, s') <- lastSaved s = not $ and [ eTitle s == eTitle s' 182 | Just (_, s') <- lastSaved s = not $ and [ eTitle s == eTitle s'
179 , eText s == eText s' 183 , eText s == eText s'
180 ] 184 ]
181 | otherwise = True 185 | otherwise = True
186 when' :: Applicative m => Bool -> m a -> m (Maybe a)
187 when' True = fmap Just
188 when' False = const $ pure Nothing
182 discardAction = do 189 discardAction = do
183 -- maybe (return ()) draftDelete . associatedDraft =<< currentValue editorStatus 190 -- maybe (return ()) draftDelete . associatedDraft =<< currentValue editorStatus
184 saveAction False 191 saved <- saveAction False
185 modifyStatus $ const def 192 when saved $ modifyStatus $ const def
186 printAction = do 193 printAction = do
187 emitError "Printing not implemented" 194 EditorState{..} <- currentValue editorStatus
188 195 case ePrintout of
189 onEvent (tick autoSaveTimer) (const $ saveAction True) 196 Right po -> case associatedDraft of
197 Just dId -> do
198 saved <- saveAction False
199 when saved $ runFunction . focusJob =<< draftPrint dId Nothing -- FIXME
200 Nothing -> do
201 runFunction . focusJob =<< jobCreate Nothing po -- FIXME
202 Left err -> emitError $ "Could not print draft due to error parsing bbcode: " ++ show err
203
204 onEvent (tick autoSaveTimer) (const . void $ saveAction True)
190 205
191 return saveButton # sink UI.enabled (saveable <$> editorStatus) 206 return saveButton # sink UI.enabled (saveable <$> editorStatus)
192 return printButton # sink UI.enabled (printable <$> editorStatus) 207 return printButton # sink UI.enabled (printable <$> editorStatus)
193 return discardButton # sink UI.enabled (discardable <$> editorStatus) 208 return discardButton # sink UI.enabled (discardable <$> editorStatus)
194 209
195 on UI.click saveButton . const $ saveAction False 210 on UI.click saveButton . const . void $ saveAction False
196 on UI.click printButton $ const printAction 211 on UI.click printButton $ const printAction
197 on UI.click discardButton $ const discardAction 212 on UI.click discardButton $ const discardAction
198 213
@@ -256,6 +271,9 @@ setup Config{..} window (split -> (socketErr, dataUpdate)) = void $ do
256 | "draft/" `isPrefixOf` p = True 271 | "draft/" `isPrefixOf` p = True
257 | otherwise = False 272 | otherwise = False
258 273
274focusJob :: JobId -> JSFunction ()
275focusJob (JobId (fromInteger -> i)) = ffi "alert(%1)" (i :: Int) -- FIXME
276
259switchTab :: String -> JSFunction () 277switchTab :: String -> JSFunction ()
260switchTab = ffi "$(%1).first().trigger(\"click\")" . (\p -> "a[href='#" ++ p ++ "']") 278switchTab = ffi "$(%1).first().trigger(\"click\")" . (\p -> "a[href='#" ++ p ++ "']")
261 279