{-# 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 {
  forall t. SaveAsWindowConfig t -> Event t FilePath
_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 :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SaveAsWindowConfig t -> m (Event t FilePath, Dynamic t Bool)
popupSaveAsWindow SaveAsWindowConfig {Event t FilePath
_saveAsWindowConfig_saveAs :: Event t FilePath
_saveAsWindowConfig_saveAs :: forall t. SaveAsWindowConfig t -> Event t FilePath
..} = do

  Behavior t PotatoStyle
potatostylebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato

  let
    popupSaveAsEv :: Event t (m (Event t (), Event t FilePath))
popupSaveAsEv = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t FilePath
_saveAsWindowConfig_saveAs forall a b. (a -> b) -> a -> b
$ \FilePath
f0 -> mdo
      forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m, HasFocusReader t m,
 HasTheme t m) =>
Behavior t BoxStyle -> Behavior t Text -> m a -> m a
boxTitle (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Default a => a
def) Behavior t Text
"Save As" forall a b. (a -> b) -> a -> b
$ do
        forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m a
initManager_ forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ mdo
          FileExplorerWidget t
fewidget <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
3 forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadLayoutWidget t m, HasPotato t m) =>
FileExplorerWidgetConfig t -> m (FileExplorerWidget t)
holdFileExplorerWidget forall a b. (a -> b) -> a -> b
$ FileExplorerWidgetConfig {
              _fileExplorerWidgetConfig_fileFilter :: FilePath -> Bool
_fileExplorerWidgetConfig_fileFilter = \FilePath
fp -> FilePath -> FilePath
FP.takeExtension FilePath
fp forall a. Eq a => a -> a -> Bool
== forall a. IsString a => a
kTinyToolsFileExtension
              , _fileExplorerWidgetConfig_initialFile :: FilePath
_fileExplorerWidgetConfig_initialFile = FilePath
f0
              , _fileExplorerWidgetConfig_clickDownStyle :: Behavior t Attr
_fileExplorerWidgetConfig_clickDownStyle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PotatoStyle -> Attr
_potatoStyle_layers_softSelected Behavior t PotatoStyle
potatostylebeh
            }
          (Event t ()
cancelEv, Event t ()
saveButtonEv) <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
3 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
            Event t ()
cancelEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
10 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"cancel"

            -- TODO grey out if filename is empty
            Event t ()
saveEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
10 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"save"

            return (Event t ()
cancelEv', Event t ()
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' :: Event t ()
saveEv' = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_returnOnfilename FileExplorerWidget t
fewidget, forall t. FileExplorerWidget t -> Event t ()
_fileExplorerWidget_doubleClick FileExplorerWidget t
fewidget, Event t ()
saveButtonEv]

            -- only save if filename is non-empty
            saveEv :: Event t ()
saveEv = forall {k} (t :: k) a.
Reflex t =>
Behavior t Bool -> Event t a -> Event t a
gate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (forall t. FileExplorerWidget t -> Behavior t Text
_fileExplorerWidget_filename FileExplorerWidget t
fewidget)) Event t ()
saveEv'

            saveAsFileEv' :: Event t FilePath
saveAsFileEv' = forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall t. FileExplorerWidget t -> Behavior t FilePath
_fileExplorerWidget_fullfilename FileExplorerWidget t
fewidget) Event t ()
saveEv
            saveAsFileEv :: Event t FilePath
saveAsFileEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
addTinyToolsFileExtensionIfNecessary Event t FilePath
saveAsFileEv'
          forall (m :: * -> *) a. Monad m => a -> m a
return (Event t ()
cancelEv, Event t FilePath
saveAsFileEv)
    fmapfn :: f (Event t (), Event t a)
-> Event t () -> p -> f (Event t (), Event t a)
fmapfn f (Event t (), Event t a)
w = \Event t ()
escEv p
clickOutsideEv -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Event t ()
cancelEv, Event t a
outputEv) -> (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
escEv, Event t ()
cancelEv, forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t a
outputEv], Event t a
outputEv)) f (Event t (), Event t a)
w

  forall {k} (t :: k) (m :: * -> *) a.
HasTheme t m =>
(Behavior t Attr -> Behavior t Attr) -> m a -> m a
localTheme (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PotatoStyle -> Attr
_potatoStyle_normal Behavior t PotatoStyle
potatostylebeh) forall a b. (a -> b) -> a -> b
$ do
    forall t (m :: * -> *) a.
MonadWidget t m =>
PopupPaneSize
-> Event t (PopupInputWidget t m a)
-> m (Event t a, Dynamic t Bool)
popupPane forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {t} {f :: * -> *} {a} {p}.
(Reflex t, Functor f) =>
f (Event t (), Event t a)
-> Event t () -> p -> f (Event t (), Event t a)
fmapfn Event t (m (Event t (), Event t FilePath))
popupSaveAsEv)


-- TODO rename to MaybeSaveBeforeAction...
data SaveBeforeActionConfig t = SaveBeforeActionConfig {
  forall t. SaveBeforeActionConfig t -> Behavior t Bool
_saveBeforeActionConfig_unsavedChangesBeh :: Behavior t Bool
  , forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_open :: Event t ()
  , forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_new :: Event t ()
  , forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_exit :: Event t ()
  , forall t.
SaveBeforeActionConfig t -> Event t (Either Text FilePath)
_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 (Int -> SaveBeforeActionType -> FilePath -> FilePath
[SaveBeforeActionType] -> FilePath -> FilePath
SaveBeforeActionType -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SaveBeforeActionType] -> FilePath -> FilePath
$cshowList :: [SaveBeforeActionType] -> FilePath -> FilePath
show :: SaveBeforeActionType -> FilePath
$cshow :: SaveBeforeActionType -> FilePath
showsPrec :: Int -> SaveBeforeActionType -> FilePath -> FilePath
$cshowsPrec :: Int -> SaveBeforeActionType -> FilePath -> FilePath
Show, SaveBeforeActionType -> SaveBeforeActionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveBeforeActionType -> SaveBeforeActionType -> Bool
$c/= :: SaveBeforeActionType -> SaveBeforeActionType -> Bool
== :: SaveBeforeActionType -> SaveBeforeActionType -> Bool
$c== :: SaveBeforeActionType -> SaveBeforeActionType -> Bool
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
  forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_save :: Event t ()

  , forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_saveAs :: Event t ()

  , forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_new :: Event t ()
  , forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_open :: Event t ()
  , forall t. SaveBeforeActionOutput t -> 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 :: forall t a b c.
Reflex t =>
Event t a
-> Event t b -> Event t c -> Event t (These a (These b c))
hackAlign3 Event t a
a Event t b
b Event t c
c = forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t a
a (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t b
b Event t c
c)

hackFanThese3 :: (Reflex t) =>  Event t (These a (These b c)) -> (Event t a, Event t b, Event t c)
hackFanThese3 :: forall t a b c.
Reflex t =>
Event t (These a (These b c)) -> (Event t a, Event t b, Event t c)
hackFanThese3 Event t (These a (These b c))
ev = (Event t a, Event t b, Event t c)
r where
  (Event t a
a, Event t (These b c)
bc) = forall {k} (t :: k) a b.
Reflex t =>
Event t (These a b) -> (Event t a, Event t b)
fanThese Event t (These a (These b c))
ev
  (Event t b
b, Event t c
c) = forall {k} (t :: k) a b.
Reflex t =>
Event t (These a b) -> (Event t a, Event t b)
fanThese Event t (These b c)
bc
  r :: (Event t a, Event t b, Event t c)
r = (Event t a
a,Event t b
b,Event t c
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 :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SaveBeforeActionConfig t
-> m (SaveBeforeActionOutput t, Dynamic t Bool)
popupSaveBeforeExit SaveBeforeActionConfig {Event t (Either Text FilePath)
Event t ()
Behavior t Bool
_saveBeforeActionConfig_saveOutcomeEv :: Event t (Either Text FilePath)
_saveBeforeActionConfig_exit :: Event t ()
_saveBeforeActionConfig_new :: Event t ()
_saveBeforeActionConfig_open :: Event t ()
_saveBeforeActionConfig_unsavedChangesBeh :: Behavior t Bool
_saveBeforeActionConfig_saveOutcomeEv :: forall t.
SaveBeforeActionConfig t -> Event t (Either Text FilePath)
_saveBeforeActionConfig_exit :: forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_new :: forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_open :: forall t. SaveBeforeActionConfig t -> Event t ()
_saveBeforeActionConfig_unsavedChangesBeh :: forall t. SaveBeforeActionConfig t -> Behavior t Bool
..} = do
  Behavior t (Maybe FilePath)
mopenfilebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t (Maybe FilePath)
_potatoConfig_appCurrentOpenFile forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato
  -- TODO unsure why this doesn't get resampled each time popup is created :(
  --mopenfile <- sample mopenfilebeh

  Behavior t PotatoStyle
potatostylebeh <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. PotatoConfig t -> Behavior t PotatoStyle
_potatoConfig_style forall t (m :: * -> *). HasPotato t m => m (PotatoConfig t)
askPotato

  let
    
    combinedEv :: Event t SaveBeforeActionType
combinedEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [SaveBeforeActionType
SaveBeforeActionType_Open forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$Event t ()
_saveBeforeActionConfig_open, SaveBeforeActionType
SaveBeforeActionType_New forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$Event t ()
_saveBeforeActionConfig_new, SaveBeforeActionType
SaveBeforeActionType_Exit forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$Event t ()
_saveBeforeActionConfig_exit]
    filteredEv :: Event t SaveBeforeActionType
filteredEv = forall {k} (t :: k) a.
Reflex t =>
Behavior t Bool -> Event t a -> Event t a
gate Behavior t Bool
_saveBeforeActionConfig_unsavedChangesBeh Event t SaveBeforeActionType
combinedEv
    skipNoUnsavedChangesEv :: Event t SaveBeforeActionType
skipNoUnsavedChangesEv = forall {k} (t :: k) a.
Reflex t =>
Behavior t Bool -> Event t a -> Event t a
gate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not Behavior t Bool
_saveBeforeActionConfig_unsavedChangesBeh) Event t SaveBeforeActionType
combinedEv


  
  Dynamic t SaveBeforeActionType
combinedDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn SaveBeforeActionType
SaveBeforeActionType_None  Event t SaveBeforeActionType
combinedEv

  let
    popupSaveBeforeExitEv :: Event
  t
  (m (Event t (),
      Event t (These () (These () SaveBeforeActionType))))
popupSaveBeforeExitEv = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t SaveBeforeActionType
filteredEv forall a b. (a -> b) -> a -> b
$ \SaveBeforeActionType
iev -> mdo
      forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasImageWriter t m, HasInput t m, HasFocusReader t m,
 HasTheme t m) =>
Behavior t BoxStyle -> Behavior t Text -> m a -> m a
boxTitle (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Default a => a
def) Behavior t Text
"😱😱 You have unsaved changes. Would you like to save? 😱😱" forall a b. (a -> b) -> a -> b
$ do
        forall t (m :: * -> *) a.
(HasDisplayRegion t m, Reflex t, MonadHold t m, MonadFix m) =>
Layout t (Focus t m) a -> m a
initManager_ forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ mdo
          (Event t SaveBeforeActionType
ignoreEv, Event t ()
cancelEv, Event t ()
saveButtonEv, Event t ()
saveAsButtonEv) <- do
            (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
0 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
col forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
            (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
fixed) Dynamic t Int
3 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadFix m, HasLayout t m) =>
m a -> m a
row forall a b. (a -> b) -> a -> b
$ do
              Event t ()
cancelEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
9 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"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")
              Event t ()
saveEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
9 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"save"

              Event t ()
saveAsEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
9 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"save as"
              Event t ()
ignoreEv' <- (forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasFocus t m,
 HasLayout t m, HasImageWriter t m, HasDisplayRegion t m,
 HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
tile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k).
Reflex t =>
Dynamic t Int -> Dynamic t Constraint
stretch) Dynamic t Int
9 forall a b. (a -> b) -> a -> b
$ forall {k} (m :: * -> *) (t :: k).
(MonadFix m, MonadHold t m, HasDisplayRegion t m,
 HasFocusReader t m, HasTheme t m, HasImageWriter t m,
 HasInput t m) =>
ButtonConfig t -> Behavior t Text -> m (Event t ())
textButton forall a. Default a => a
def Behavior t Text
"ignore"
              return (Event t ()
ignoreEv' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SaveBeforeActionType
iev, Event t ()
cancelEv', Event t ()
saveEv', Event t ()
saveAsEv')
          forall (m :: * -> *) a. Monad m => a -> m a
return (Event t ()
cancelEv, forall t a b c.
Reflex t =>
Event t a
-> Event t b -> Event t c -> Event t (These a (These b c))
hackAlign3 Event t ()
saveButtonEv Event t ()
saveAsButtonEv Event t SaveBeforeActionType
ignoreEv)
    fmapfn :: f (Event t (), Event t a)
-> Event t () -> p -> f (Event t (), Event t a)
fmapfn f (Event t (), Event t a)
w = \Event t ()
escEv p
clickOutsideEv -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Event t ()
cancelEv, Event t a
outputEv) -> (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
escEv, Event t ()
cancelEv, forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t a
outputEv], Event t a
outputEv)) f (Event t (), Event t a)
w
  (Event t (These () (These () SaveBeforeActionType))
outputEv, Dynamic t Bool
stateDyn) <- forall {k} (t :: k) (m :: * -> *) a.
HasTheme t m =>
(Behavior t Attr -> Behavior t Attr) -> m a -> m a
localTheme (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PotatoStyle -> Attr
_potatoStyle_normal Behavior t PotatoStyle
potatostylebeh) forall a b. (a -> b) -> a -> b
$ do
    forall t (m :: * -> *) a.
MonadWidget t m =>
PopupPaneSize
-> Event t (PopupInputWidget t m a)
-> m (Event t a, Dynamic t Bool)
popupPane forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {t} {f :: * -> *} {a} {p}.
(Reflex t, Functor f) =>
f (Event t (), Event t a)
-> Event t () -> p -> f (Event t (), Event t a)
fmapfn Event
  t
  (m (Event t (),
      Event t (These () (These () SaveBeforeActionType))))
popupSaveBeforeExitEv)

  let 
    (Event t ()
saveEv, Event t ()
saveAsEv, Event t SaveBeforeActionType
ignoreEv) = forall t a b c.
Reflex t =>
Event t (These a (These b c)) -> (Event t a, Event t b, Event t c)
hackFanThese3 Event t (These () (These () SaveBeforeActionType))
outputEv
  Event t (SaveBeforeActionType, Either Text FilePath)
saveFinalized <- forall t (m :: * -> *) a b.
(Reflex t, MonadFix m, MonadHold t m) =>
Event t a -> Event t b -> m (Event t (a, b))
waitForSecondAfterFirst (forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t SaveBeforeActionType
combinedDyn) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t ()
saveEv Event t ()
saveAsEv) Event t (Either Text FilePath)
_saveBeforeActionConfig_saveOutcomeEv
  let 
    saveFinalizedSuccess :: Event t SaveBeforeActionType
saveFinalizedSuccess = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ Event t (SaveBeforeActionType, Either Text FilePath)
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 :: Event t SaveBeforeActionType
doActionEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t SaveBeforeActionType
skipNoUnsavedChangesEv, Event t SaveBeforeActionType
ignoreEv,  Event t SaveBeforeActionType
saveFinalizedSuccess]

    sbao :: SaveBeforeActionOutput t
sbao = SaveBeforeActionOutput {
        _saveBeforeActionOutput_save :: Event t ()
_saveBeforeActionOutput_save = Event t ()
saveEv
        , _saveBeforeActionOutput_saveAs :: Event t ()
_saveBeforeActionOutput_saveAs = Event t ()
saveAsEv
        , _saveBeforeActionOutput_new :: Event t ()
_saveBeforeActionOutput_new = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
== SaveBeforeActionType
SaveBeforeActionType_New) Event t SaveBeforeActionType
doActionEv
        , _saveBeforeActionOutput_open :: Event t ()
_saveBeforeActionOutput_open = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
== SaveBeforeActionType
SaveBeforeActionType_Open) Event t SaveBeforeActionType
doActionEv
        , _saveBeforeActionOutput_exit :: Event t ()
_saveBeforeActionOutput_exit = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
ffilter (forall a. Eq a => a -> a -> Bool
== SaveBeforeActionType
SaveBeforeActionType_Exit) Event t SaveBeforeActionType
doActionEv
      }


  return (SaveBeforeActionOutput t
sbao, Dynamic t Bool
stateDyn)