{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecursiveDo #-} module Potato.Flow.Vty.SaveAsWindow where import Relude import Potato.Flow import Potato.Flow.Vty.Common import Potato.Reflex.Vty.Helpers import Potato.Flow.Vty.PotatoReader import Potato.Flow.Vty.Attrs import Potato.Reflex.Vty.Widget.FileExplorer import Potato.Reflex.Vty.Widget.Popup import Control.Monad.Fix import Control.Monad.NodeId import Data.Align import Data.Char (isNumber) import Data.Dependent.Sum (DSum ((:=>))) import qualified Data.IntMap as IM import qualified Data.List.Extra as L import qualified Data.Maybe import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Data.Text.Zipper as TZ import Data.These import Data.Tuple.Extra import qualified Graphics.Vty as V import Reflex import Reflex.Network import Reflex.Potato.Helpers import Reflex.Vty import qualified System.FilePath as FP import qualified System.Directory as FP data SaveAsWindowConfig t = SaveAsWindowConfig { _saveAsWindowConfig_saveAs :: Event t FP.FilePath -- ^ Event to launch the popup window to save file as Text is previous file name or empty string } popupSaveAsWindow :: forall t m. (MonadWidget t m, HasPotato t m) => SaveAsWindowConfig t -> m (Event t FP.FilePath, Dynamic t Bool) -- ^ (file to save to, popup state) popupSaveAsWindow SaveAsWindowConfig {..} = do potatostylebeh <- fmap _potatoConfig_style askPotato let popupSaveAsEv = ffor _saveAsWindowConfig_saveAs $ \f0 -> mdo boxTitle (constant def) "Save As" $ do initManager_ $ col $ mdo fewidget <- (tile . stretch) 3 $ holdFileExplorerWidget $ FileExplorerWidgetConfig { _fileExplorerWidgetConfig_fileFilter = \fp -> FP.takeExtension fp == kTinyToolsFileExtension , _fileExplorerWidgetConfig_initialFile = f0 , _fileExplorerWidgetConfig_clickDownStyle = fmap _potatoStyle_layers_softSelected potatostylebeh } (cancelEv, saveButtonEv) <- (tile . fixed) 3 $ row $ do cancelEv' <- (tile . stretch) 10 $ textButton def "cancel" -- TODO grey out if filename is empty saveEv' <- (tile . stretch) 10 $ textButton def "save" return (cancelEv', saveEv') -- DELETE -- IO file validity checkin {-mSaveAsFileEv <- performEvent $ ffor (tag (_fileExplorerWidget_fullfilename fewidget) saveEv) $ \ffn -> liftIO $ do exists <- FP.doesFileExist ffn return $ if exists then Just ffn else Nothing let saveAsFileEv = fmapMaybe id mSaveAsFileEv-} let -- do we really want to allow save on pressing enter? saveEv' = leftmost [_fileExplorerWidget_returnOnfilename fewidget, _fileExplorerWidget_doubleClick fewidget, saveButtonEv] -- only save if filename is non-empty saveEv = gate (fmap (not . T.null) (_fileExplorerWidget_filename fewidget)) saveEv' saveAsFileEv' = tag (_fileExplorerWidget_fullfilename fewidget) saveEv saveAsFileEv = fmap addTinyToolsFileExtensionIfNecessary saveAsFileEv' return (cancelEv, saveAsFileEv) fmapfn w = \escEv clickOutsideEv -> fmap (\(cancelEv, outputEv) -> (leftmost [escEv, cancelEv, void outputEv], outputEv)) w localTheme (const $ fmap _potatoStyle_normal potatostylebeh) $ do popupPane def $ (fmap fmapfn popupSaveAsEv) -- TODO rename to MaybeSaveBeforeAction... data SaveBeforeActionConfig t = SaveBeforeActionConfig { _saveBeforeActionConfig_unsavedChangesBeh :: Behavior t Bool , _saveBeforeActionConfig_open :: Event t () , _saveBeforeActionConfig_new :: Event t () , _saveBeforeActionConfig_exit :: Event t () , _saveBeforeActionConfig_saveOutcomeEv :: Event t (Either Text FilePath) -- Left is error Right is success, open/new/exit events only fire if it was a success } data SaveBeforeActionType = SaveBeforeActionType_Open | SaveBeforeActionType_New | SaveBeforeActionType_Exit | SaveBeforeActionType_None deriving (Show, Eq) -- TODO make this generic, via some PopupManager thingy or what not -- you want to use the same NeedSave for close and open when there are unsaved changes -- and after the save action, you want to redirect back to the open or quit operation data SaveBeforeActionOutput t = SaveBeforeActionOutput { -- TODO you should be able to get this to work... --_saveBeforeActionOutput_save :: Event t FP.FilePath _saveBeforeActionOutput_save :: Event t () , _saveBeforeActionOutput_saveAs :: Event t () , _saveBeforeActionOutput_new :: Event t () , _saveBeforeActionOutput_open :: Event t () , _saveBeforeActionOutput_exit :: Event t () } hackAlign3 :: (Reflex t) => Event t a -> Event t b -> Event t c -> Event t (These a (These b c)) hackAlign3 a b c = align a (align b c) hackFanThese3 :: (Reflex t) => Event t (These a (These b c)) -> (Event t a, Event t b, Event t c) hackFanThese3 ev = r where (a, bc) = fanThese ev (b, c) = fanThese bc r = (a,b,c) -- TODO somehow allow auto save on exit popupSaveBeforeExit :: forall t m. (MonadWidget t m, HasPotato t m) => SaveBeforeActionConfig t -> m (SaveBeforeActionOutput t, Dynamic t Bool) popupSaveBeforeExit SaveBeforeActionConfig {..} = do mopenfilebeh <- fmap _potatoConfig_appCurrentOpenFile askPotato -- TODO unsure why this doesn't get resampled each time popup is created :( --mopenfile <- sample mopenfilebeh potatostylebeh <- fmap _potatoConfig_style askPotato let combinedEv = leftmost [SaveBeforeActionType_Open <$_saveBeforeActionConfig_open, SaveBeforeActionType_New <$_saveBeforeActionConfig_new, SaveBeforeActionType_Exit <$_saveBeforeActionConfig_exit] filteredEv = gate _saveBeforeActionConfig_unsavedChangesBeh combinedEv skipNoUnsavedChangesEv = gate (fmap not _saveBeforeActionConfig_unsavedChangesBeh) combinedEv combinedDyn <- holdDyn SaveBeforeActionType_None combinedEv let popupSaveBeforeExitEv = ffor filteredEv $ \iev -> mdo boxTitle (constant def) "😱😱 You have unsaved changes. Would you like to save? 😱😱" $ do initManager_ $ col $ mdo (ignoreEv, cancelEv, saveButtonEv, saveAsButtonEv) <- do (tile . stretch) 0 $ col $ return () (tile . fixed) 3 $ row $ do cancelEv' <- (tile . stretch) 9 $ textButton def "cancel" -- TODO you should be able to get this to work... --saveEv' <- case mopenfile of -- Nothing -> return never -- Just x -> (tile . stretch) 9 $ (const x <<$>> textButton def "save") saveEv' <- (tile . stretch) 9 $ textButton def "save" saveAsEv' <- (tile . stretch) 9 $ textButton def "save as" ignoreEv' <- (tile . stretch) 9 $ textButton def "ignore" return (ignoreEv' $> iev, cancelEv', saveEv', saveAsEv') return (cancelEv, hackAlign3 saveButtonEv saveAsButtonEv ignoreEv) fmapfn w = \escEv clickOutsideEv -> fmap (\(cancelEv, outputEv) -> (leftmost [escEv, cancelEv, void outputEv], outputEv)) w (outputEv, stateDyn) <- localTheme (const $ fmap _potatoStyle_normal potatostylebeh) $ do popupPane def $ (fmap fmapfn popupSaveBeforeExitEv) let (saveEv, saveAsEv, ignoreEv) = hackFanThese3 outputEv saveFinalized <- waitForSecondAfterFirst (tag (current combinedDyn) $ align saveEv saveAsEv) _saveBeforeActionConfig_saveOutcomeEv let saveFinalizedSuccess = fmap fst . ffilter (isRight . snd) $ saveFinalized -- only do the action if -- there were no unsaved changes -- the user hit the "ignore" button -- the user successfuly saved after save/saveas operation doActionEv = leftmost [skipNoUnsavedChangesEv, ignoreEv, saveFinalizedSuccess] sbao = SaveBeforeActionOutput { _saveBeforeActionOutput_save = saveEv , _saveBeforeActionOutput_saveAs = saveAsEv , _saveBeforeActionOutput_new = void $ ffilter (== SaveBeforeActionType_New) doActionEv , _saveBeforeActionOutput_open = void $ ffilter (== SaveBeforeActionType_Open) doActionEv , _saveBeforeActionOutput_exit = void $ ffilter (== SaveBeforeActionType_Exit) doActionEv } return (sbao, stateDyn)