{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Vty.OpenWindow where
import Relude
import Potato.Flow
import Potato.Flow.Vty.Attrs
import Potato.Flow.Vty.Common
import Potato.Flow.Vty.PotatoReader
import Potato.Reflex.Vty.Helpers
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.Directory as FP
import qualified System.FilePath as FP
data OpenWindowConfig t = OpenWindowConfig {
forall t. OpenWindowConfig t -> Event t FilePath
_openWindowConfig_open :: Event t FP.FilePath
}
popupOpenWindow :: forall t m. (MonadWidget t m, HasPotato t m)
=> OpenWindowConfig t
-> m (Event t FP.FilePath, Dynamic t Bool)
OpenWindowConfig {Event t FilePath
_openWindowConfig_open :: Event t FilePath
_openWindowConfig_open :: forall t. OpenWindowConfig 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
popupOpenEv :: Event t (m (Event t (), Event t FilePath))
popupOpenEv = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t FilePath
_openWindowConfig_open forall a b. (a -> b) -> a -> b
$ \FilePath
d0 -> 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
"Open" 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
d0
, _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 ()
openButtonEv) <- (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"
Event t ()
openEv' <- (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
"open"
return (Event t ()
cancelEv', Event t ()
openEv')
let
openEv'' :: Event t ()
openEv'' = 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 ()
openButtonEv]
openEv' :: Event t FilePath
openEv' = 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 ()
openEv''
openEv :: Event t FilePath
openEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
addTinyToolsFileExtensionIfNecessary Event t FilePath
openEv'
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t ()
cancelEv, Event t FilePath
openEv)
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))
popupOpenEv)