packages feed

tinytools-vty-0.1.0.0: src/Potato/Flow/Vty/SaveAsWindow.hs

{-# 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)