{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
module Potato.Flow.Vty.Main (
potatoMainWidget
, mainPFWidget
, mainPFWidgetWithBypass
, MainPFWidgetConfig(..)
, somedefaultpfcfg
, tinytoolsConfigDir
) where
import Relude
import Potato.Flow
import qualified Potato.Flow.Serialization.Snake as Snake
import Potato.Flow.TestStates
import Potato.Flow.Vty.Canvas
import Potato.Flow.Vty.Input
import Potato.Flow.Vty.Layer
import Potato.Flow.Vty.Params
import Potato.Flow.Vty.PotatoReader
import Potato.Flow.Vty.Tools
import Potato.Flow.Vty.Left
import Potato.Reflex.Vty.Helpers
import Potato.Reflex.Vty.Widget.Popup
import Potato.Reflex.Vty.Widget
import qualified Potato.Reflex.Vty.Host
import Potato.Flow.Vty.SaveAsWindow
import Potato.Flow.Vty.OpenWindow
import Potato.Flow.Vty.Alert
import Potato.Flow.Vty.AppKbCmd
import Potato.Flow.Vty.Attrs
import System.Console.ANSI (hSetTitle)
import qualified System.FilePath as FP
import qualified System.Directory as FP
import Control.Concurrent
import Control.Monad.NodeId
import Control.Exception (handle)
import Data.Maybe
import Data.Default
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Data.Text.IO as T
import Data.Time.Clock
import qualified Data.ByteString.Lazy as LBS
import Data.These
import Network.HTTP.Simple
import qualified Graphics.Vty as V
import Reflex
import Reflex.Potato.Helpers
import Reflex.Vty
potatoMainWidgetWithHandle
:: V.Vty
-> (forall t m. (Potato.Reflex.Vty.Host.MonadVtyApp t m
, HasImageWriter t m
, MonadNodeId m
, HasDisplayRegion t m
, HasFocusReader t m
, HasInput t m
, HasTheme t m) => m (Event t ()))
-> IO ()
potatoMainWidgetWithHandle :: Vty
-> (forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ()))
-> IO ()
potatoMainWidgetWithHandle Vty
vty forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ())
child =
Vty -> (forall t (m :: * -> *). VtyApp t m) -> IO ()
Potato.Reflex.Vty.Host.runVtyAppWithHandle Vty
vty forall a b. (a -> b) -> a -> b
$ \DisplayRegion
dr0 Event t Event
inp -> do
Dynamic t DisplayRegion
size <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn DisplayRegion
dr0 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t Event
inp forall a b. (a -> b) -> a -> b
$ \case
V.EvResize Int
w Int
h -> forall a. a -> Maybe a
Just (Int
w, Int
h)
Event
_ -> forall a. Maybe a
Nothing
let inp' :: Event t Event
inp' = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t Event
inp forall a b. (a -> b) -> a -> b
$ \case
V.EvResize {} -> forall a. Maybe a
Nothing
Event
x -> forall a. a -> Maybe a
Just Event
x
(Event t ()
shutdown, Behavior t [Image]
imgs) <- forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, Monad m) =>
Behavior t Attr -> ThemeReader t m a -> m a
runThemeReader (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Attr
lg_default) forall a b. (a -> b) -> a -> b
$
forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, Monad m) =>
Dynamic t Bool -> FocusReader t m a -> m a
runFocusReader (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) forall a b. (a -> b) -> a -> b
$
forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, Monad m) =>
Dynamic t Region -> DisplayRegion t m a -> m a
runDisplayRegion (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
w, Int
h) -> Int -> Int -> Int -> Int -> Region
Region Int
0 Int
0 Int
w Int
h) Dynamic t DisplayRegion
size) forall a b. (a -> b) -> a -> b
$
forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
ImageWriter t m a -> m (a, Behavior t [Image])
runImageWriter forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => NodeIdT m a -> m a
runNodeIdT forall a b. (a -> b) -> a -> b
$
forall {k} (t :: k) (m :: * -> *) a.
Reflex t =>
Event t Event -> Input t m a -> m a
runInput Event t Event
inp' forall a b. (a -> b) -> a -> b
$ do
forall {k} (t :: k) (m :: * -> *).
HasImageWriter t m =>
Behavior t [Image] -> m ()
tellImages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t DisplayRegion
size) forall a b. (a -> b) -> a -> b
$ \(Int
w, Int
h) -> [forall d. Integral d => Attr -> Char -> d -> d -> Image
V.charFill Attr
lg_default Char
' ' Int
w Int
h]
forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ())
child
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Potato.Reflex.Vty.Host.VtyResult
{ _vtyResult_picture :: Behavior t Picture
_vtyResult_picture = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Image] -> Picture
V.picForLayers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) Behavior t [Image]
imgs
, _vtyResult_shutdown :: Event t ()
_vtyResult_shutdown = Event t ()
shutdown
}
tinytoolsConfigDir :: IO FP.FilePath
tinytoolsConfigDir :: IO FilePath
tinytoolsConfigDir = do
FilePath
homedir <- IO FilePath
FP.getHomeDirectory
return $ (FilePath
homedir FilePath -> FilePath -> FilePath
FP.</> FilePath
".tinytools/")
potatoMainWidget
:: (forall t m. (Potato.Reflex.Vty.Host.MonadVtyApp t m
, HasImageWriter t m
, MonadNodeId m
, HasDisplayRegion t m
, HasFocusReader t m
, HasInput t m
, HasTheme t m) => m (Event t ()))
-> IO ()
potatoMainWidget :: (forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ()))
-> IO ()
potatoMainWidget forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ())
child = do
Config
cfg'' <- IO Config
V.standardIOConfig
FilePath
configDir <- IO FilePath
tinytoolsConfigDir
let
mTermName :: Maybe FilePath
mTermName = Config -> Maybe FilePath
V.termName Config
cfg''
widthMapFile :: FilePath
widthMapFile = case Maybe FilePath
mTermName of
Maybe FilePath
Nothing -> FilePath
""
Just FilePath
termName -> FilePath
configDir FilePath -> FilePath -> FilePath
FP.</> (FilePath
termName forall a. Semigroup a => a -> a -> a
<> FilePath
"_termwidthfile")
Bool
doesWidthMapFileExist <- FilePath -> IO Bool
FP.doesFileExist FilePath
widthMapFile
if Bool
doesWidthMapFileExist
then forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"attempting to load unicode width table file " forall a. Semigroup a => a -> a -> a
<> FilePath
widthMapFile
else forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"could not find unicode width table file " forall a. Semigroup a => a -> a -> a
<> FilePath
widthMapFile forall a. Semigroup a => a -> a -> a
<> FilePath
" please run --widthtable to generate unicode width table file"
let
cfg' :: Config
cfg' = Config
cfg'' { mouseMode :: Maybe Bool
V.mouseMode = forall a. a -> Maybe a
Just Bool
True }
cfg :: Config
cfg = if Bool
doesWidthMapFileExist
then Config
cfg' {
allowCustomUnicodeWidthTables :: Maybe Bool
V.allowCustomUnicodeWidthTables = forall a. a -> Maybe a
Just Bool
True
, termWidthMaps :: [(FilePath, FilePath)]
V.termWidthMaps = [(forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
mTermName, FilePath
widthMapFile)]
}
else Config
cfg'
Vty
vty <- Config -> IO Vty
V.mkVty Config
cfg
Vty
-> (forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ()))
-> IO ()
potatoMainWidgetWithHandle Vty
vty forall t (m :: * -> *).
(MonadVtyApp t m, HasImageWriter t m, MonadNodeId m,
HasDisplayRegion t m, HasFocusReader t m, HasInput t m,
HasTheme t m) =>
m (Event t ())
child
tickOnEvent :: (Adjustable t m) => Event t a -> m ()
tickOnEvent :: forall t (m :: * -> *) a. Adjustable t m => Event t a -> m ()
tickOnEvent Event t a
ev = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Event t a
ev forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall (m :: * -> *) a. Monad m => a -> m a
return ())
fanMaybe :: (Reflex t) => Event t (Maybe a) -> (Event t a, Event t ())
fanMaybe :: forall t a.
Reflex t =>
Event t (Maybe a) -> (Event t a, Event t ())
fanMaybe Event t (Maybe a)
ev = (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. a -> a
id Event t (Maybe a)
ev, forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall {a}. Maybe a -> Maybe ()
fmapfn Event t (Maybe a)
ev) where
fmapfn :: Maybe a -> Maybe ()
fmapfn Maybe a
ma = case Maybe a
ma of
Maybe a
Nothing -> forall a. a -> Maybe a
Just ()
Maybe a
_ -> forall a. Maybe a
Nothing
maybeLeft :: Either a b -> Maybe a
maybeLeft :: forall a b. Either a b -> Maybe a
maybeLeft (Left a
a) = forall a. a -> Maybe a
Just a
a
maybeLeft Either a b
_ = forall a. Maybe a
Nothing
somedefaultpfcfg :: MainPFWidgetConfig
somedefaultpfcfg :: MainPFWidgetConfig
somedefaultpfcfg = forall a. Default a => a
def {
_mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState = (OwlPFState
owlpfstate_newProject, ControllerMeta
emptyControllerMeta)
}
fetchMOTD :: IO Text
fetchMOTD :: IO Text
fetchMOTD = do
Response ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
"https://raw.githubusercontent.com/pdlla/tinytools-vty/potato/MOTD.txt"
return $ Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 (forall a. Response a -> a
getResponseBody Response ByteString
resp)
fetchMOTDAsync :: forall t m. (MonadWidget t m) => Event t () -> m (Event t Text)
fetchMOTDAsync :: forall t (m :: * -> *).
MonadWidget t m =>
Event t () -> m (Event t Text)
fetchMOTDAsync Event t ()
ev = forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ()
ev forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ \Text -> IO ()
f -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
Text
motd <- IO Text
fetchMOTD
Text -> IO ()
f Text
motd
return ()
welcomeWidget :: forall t m. (MonadWidget t m)
=> m (Event t ())
welcomeWidget :: forall t (m :: * -> *). MonadWidget t m => m (Event t ())
welcomeWidget = do
Event t ()
postBuildEv <- forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
Event t Text
welcomeMessageEv <- forall t (m :: * -> *).
MonadWidget t m =>
Event t () -> m (Event t Text)
fetchMOTDAsync Event t ()
postBuildEv
Dynamic t Text
welcomeMessageDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
"loading..." Event t Text
welcomeMessageEv
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
"😱 tinytools-vty (beta) 😱" forall a b. (a -> b) -> a -> b
$ do
forall t (m :: * -> *) a.
(HasDisplayRegion t m, MonadFix m) =>
Layout t m a -> m a
initLayout 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
$ do
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout 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
1 forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *).
(Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m,
HasTheme t m) =>
Behavior t Text -> m ()
text (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Text
welcomeMessageDyn)
(forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasLayout t m, HasInput t m,
HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Constraint -> m a -> m a
grout 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} (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 (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Text
"bye")
focusWidgetNoMouse :: forall t m a. (MonadWidget t m)
=> Dynamic t Bool
-> m a
-> m a
focusWidgetNoMouse :: forall t (m :: * -> *) a.
MonadWidget t m =>
Dynamic t Bool -> m a -> m a
focusWidgetNoMouse Dynamic t Bool
f m a
child = do
forall {k} (t :: k) (m :: * -> *) a.
HasFocusReader t m =>
(Dynamic t Bool -> Dynamic t Bool) -> m a -> m a
localFocus (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) Dynamic t Bool
f) forall a b. (a -> b) -> a -> b
$
forall {k} (t :: k) (m :: * -> *) a.
HasInput t m =>
(Event t Event -> Event t Event) -> m a -> m a
localInput (forall {k} (t :: k) a.
Reflex t =>
Behavior t Bool -> Event t a -> Event t a
gate (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
f)) forall a b. (a -> b) -> a -> b
$
m a
child
ignoreMouseUnlessFocused :: forall t m a. (MonadWidget t m)
=> m a
-> m a
ignoreMouseUnlessFocused :: forall t (m :: * -> *) a. MonadWidget t m => m a -> m a
ignoreMouseUnlessFocused m a
child = do
Dynamic t Bool
f <- forall {k} (t :: k) (m :: * -> *).
HasFocusReader t m =>
m (Dynamic t Bool)
focus
forall t (m :: * -> *) a.
MonadWidget t m =>
Dynamic t Bool -> m a -> m a
focusWidgetNoMouse Dynamic t Bool
f m a
child
captureInputEvents :: forall t m a. (MonadWidget t m)
=> These (Event t ()) (Behavior t Bool)
-> m a
-> m a
captureInputEvents :: forall t (m :: * -> *) a.
MonadWidget t m =>
These (Event t ()) (Behavior t Bool) -> m a -> m a
captureInputEvents These (Event t ()) (Behavior t Bool)
capture m a
child = do
let
(Event t ()
ev, Behavior t Bool
beh) = forall a b. a -> b -> These a b -> (a, b)
fromThese forall {k} (t :: k) a. Reflex t => Event t a
never (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Bool
False) These (Event t ()) (Behavior t Bool)
capture
forall {k} (t :: k) (m :: * -> *) a.
HasInput t m =>
(Event t Event -> Event t Event) -> m a -> m a
localInput (\Event t Event
inp -> forall {k} (t :: k) a b.
Reflex t =>
Event t a -> Event t b -> Event t a
difference (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
beh) Event t Event
inp) Event t ()
ev) forall a b. (a -> b) -> a -> b
$
m a
child
data MainPFWidgetConfig = MainPFWidgetConfig {
MainPFWidgetConfig -> Maybe FilePath
_mainPFWidgetConfig_initialFile :: Maybe FP.FilePath
, MainPFWidgetConfig -> FilePath
_mainPFWidgetConfig_homeDirectory :: FP.FilePath
, MainPFWidgetConfig -> (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
, MainPFWidgetConfig -> Bool
_mainPFWidgetConfig_showWelcome :: Bool
}
instance Default MainPFWidgetConfig where
def :: MainPFWidgetConfig
def = MainPFWidgetConfig {
_mainPFWidgetConfig_initialFile :: Maybe FilePath
_mainPFWidgetConfig_initialFile = forall a. Maybe a
Nothing
, _mainPFWidgetConfig_homeDirectory :: FilePath
_mainPFWidgetConfig_homeDirectory = FilePath
"/home/minimaple/kitchen/faucet/potato-flow-vty"
, _mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState = (OwlPFState
emptyOwlPFState, ControllerMeta
emptyControllerMeta)
, _mainPFWidgetConfig_showWelcome :: Bool
_mainPFWidgetConfig_showWelcome = Bool
False
}
mainPFWidget :: forall t m. (MonadWidget t m)
=> MainPFWidgetConfig
-> m (Event t ())
mainPFWidget :: forall t (m :: * -> *).
MonadWidget t m =>
MainPFWidgetConfig -> m (Event t ())
mainPFWidget MainPFWidgetConfig
cfg = forall t (m :: * -> *).
MonadWidget t m =>
MainPFWidgetConfig -> Event t WSEvent -> m (Event t ())
mainPFWidgetWithBypass MainPFWidgetConfig
cfg forall {k} (t :: k) a. Reflex t => Event t a
never
mainPFWidgetWithBypass :: forall t m. (MonadWidget t m)
=> MainPFWidgetConfig
-> Event t WSEvent
-> m (Event t ())
mainPFWidgetWithBypass :: forall t (m :: * -> *).
MonadWidget t m =>
MainPFWidgetConfig -> Event t WSEvent -> m (Event t ())
mainPFWidgetWithBypass MainPFWidgetConfig {Bool
FilePath
Maybe FilePath
(OwlPFState, ControllerMeta)
_mainPFWidgetConfig_showWelcome :: Bool
_mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_homeDirectory :: FilePath
_mainPFWidgetConfig_initialFile :: Maybe FilePath
_mainPFWidgetConfig_showWelcome :: MainPFWidgetConfig -> Bool
_mainPFWidgetConfig_homeDirectory :: MainPFWidgetConfig -> FilePath
_mainPFWidgetConfig_initialFile :: MainPFWidgetConfig -> Maybe FilePath
_mainPFWidgetConfig_initialState :: MainPFWidgetConfig -> (OwlPFState, ControllerMeta)
..} Event t WSEvent
bypassEvent = mdo
Event t Event
flowInput <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t Event)
input
Event t ()
postBuildEv <- forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
forall t (m :: * -> *) a. Adjustable t m => Event t a -> m ()
tickOnEvent (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. GoatWidget t -> Dynamic t Selection
_goatWidget_selection forall a b. (a -> b) -> a -> b
$ GoatWidget t
everythingW)
let
tryOpenFileEv :: Event t FilePath
tryOpenFileEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t ()
postBuildEv (forall a b. a -> b -> a
const Maybe FilePath
_mainPFWidgetConfig_initialFile), Event t FilePath
openFileEv]
Event t (Either FilePath EverythingLoadState, FilePath)
eLoadFileEv <- forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t FilePath
tryOpenFileEv
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
FilePath
absfp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
FP.makeAbsolute FilePath
fp
Either FilePath EverythingLoadState
espf <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath EverythingLoadState)
Snake.decodeFile FilePath
absfp
return (Either FilePath EverythingLoadState
espf, FilePath
absfp)
let
loadFileFailAlertEv :: Event t Text
loadFileFailAlertEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (forall a b. Either a b -> Maybe a
leftToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Event t (Either FilePath EverythingLoadState, FilePath)
eLoadFileEv
loadFileEv :: Event t EverythingLoadState
loadFileEv = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (forall l r. Either l r -> Maybe r
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Event t (Either FilePath EverythingLoadState, FilePath)
eLoadFileEv
newEmptyFileEv :: Event t EverythingLoadState
newEmptyFileEv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow OwlPFState
owlpfstate_newProject, ControllerMeta
emptyControllerMeta)) Event t ()
_saveBeforeActionOutput_new
let
setOpenFileStateEv :: Event t (Maybe FilePath, Bool)
setOpenFileStateEv = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t (Maybe FilePath)
currentOpenFileDyn (forall t. GoatWidget t -> Dynamic t Bool
_goatWidget_unsavedChanges GoatWidget t
everythingW) (,)
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Maybe FilePath, Bool)
setOpenFileStateEv forall a b. (a -> b) -> a -> b
$ \(Maybe FilePath
mfn, Bool
dirty) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hSetTitle Handle
stdout forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe FilePath
"<>" Maybe FilePath
mfn forall a. Semigroup a => a -> a -> a
<> (if Bool
dirty then FilePath
"*" else FilePath
"")
let
performSaveEv :: Event t (GoatState, FilePath)
performSaveEv = forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ forall t. GoatWidget t -> Dynamic t GoatState
_goatWidget_DEBUG_goatState GoatWidget t
everythingW) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t FilePath
saveAsEv, Event t FilePath
clickSaveEv]
saveSuccessEv :: Event t FilePath
saveSuccessEv = forall a b. (a, b) -> b
snd (forall {k} (t :: k) a b.
Reflex t =>
Event t (Either a b) -> (Event t a, Event t b)
fanEither Event t (Either Text FilePath)
finishSaveEv)
Event t (Either Text FilePath)
finishSaveEv <- forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (GoatState, FilePath)
performSaveEv forall a b. (a -> b) -> a -> b
$ \(GoatState
gs,FilePath
fn) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let
spf :: SPotatoFlow
spf = OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> OwlPFWorkspace
_goatState_workspace forall a b. (a -> b) -> a -> b
$ GoatState
gs
cm :: ControllerMeta
cm = ControllerMeta {
_controllerMeta_pan :: XY
_controllerMeta_pan = GoatState -> XY
_goatState_pan GoatState
gs
, _controllerMeta_layers :: LayerMetaMap
_controllerMeta_layers = LayersState -> LayerMetaMap
_layersState_meta forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoatState -> LayersState
_goatState_layersState forall a b. (a -> b) -> a -> b
$ GoatState
gs
}
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"ERROR, Could not save to file " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show FilePath
fn forall a. Semigroup a => a -> a -> a
<> Text
" got exception \"" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show e
e forall a. Semigroup a => a -> a -> a
<> Text
"\"") forall a b. (a -> b) -> a -> b
$ do
FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
fn forall a b. (a -> b) -> a -> b
$ SnakeFormat -> EverythingLoadState -> ByteString
Snake.serialize SnakeFormat
Snake.SF_Json (SPotatoFlow
spf, ControllerMeta
cm)
return $ forall a b. b -> Either a b
Right FilePath
fn
let
debugKeyEv' :: Event t ()
debugKeyEv' = forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t Event
flowInput forall a b. (a -> b) -> a -> b
$ \case
V.EvKey (Key
V.KPageDown) [] -> forall a. a -> Maybe a
Just ()
Event
_ -> forall a. Maybe a
Nothing
debugKeyEv :: Event t (SomePotatoHandler, ())
debugKeyEv = forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GoatState -> SomePotatoHandler
_goatState_handler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. GoatWidget t -> Dynamic t GoatState
_goatWidget_DEBUG_goatState forall a b. (a -> b) -> a -> b
$ GoatWidget t
everythingW) Event t ()
debugKeyEv'
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (SomePotatoHandler, ())
debugKeyEv forall a b. (a -> b) -> a -> b
$ \(SomePotatoHandler
handler, ()
_) -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> Text -> IO ()
T.hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> Text
pHandlerDebugShow SomePotatoHandler
handler
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stderr
AppKbCmd {Event t ()
_appKbCmd_capturedInput :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_new :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_forceQuit :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_quit :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_print :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_open :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_save :: forall t. AppKbCmd t -> Event t ()
_appKbCmd_capturedInput :: Event t ()
_appKbCmd_new :: Event t ()
_appKbCmd_forceQuit :: Event t ()
_appKbCmd_quit :: Event t ()
_appKbCmd_print :: Event t ()
_appKbCmd_open :: Event t ()
_appKbCmd_save :: Event t ()
..} <- forall t (m :: * -> *) a.
MonadWidget t m =>
These (Event t ()) (Behavior t Bool) -> m a -> m a
captureInputEvents (forall a b. b -> These a b
That Behavior t Bool
inputCapturedByPopupBeh) forall t (m :: * -> *). MonadWidget t m => m (AppKbCmd t)
holdAppKbCmd
Dynamic t (Maybe FilePath)
currentOpenFileDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t FilePath
saveSuccessEv, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Event t (Either FilePath EverythingLoadState, FilePath)
eLoadFileEv]
let
potatoConfig :: PotatoConfig t
potatoConfig = PotatoConfig {
_potatoConfig_style :: Behavior t PotatoStyle
_potatoConfig_style = forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Default a => a
def
, _potatoConfig_appCurrentOpenFile :: Behavior t (Maybe FilePath)
_potatoConfig_appCurrentOpenFile = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe FilePath)
currentOpenFileDyn
, _potatoConfig_appCurrentDirectory :: Behavior t FilePath
_potatoConfig_appCurrentDirectory = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
_mainPFWidgetConfig_homeDirectory FilePath -> FilePath
FP.takeDirectory) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe FilePath)
currentOpenFileDyn
, _potatoConfig_appPrintFile :: Behavior t (Maybe FilePath)
_potatoConfig_appPrintFile = forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant forall a. Maybe a
Nothing
}
goatWidgetConfig :: GoatWidgetConfig t
goatWidgetConfig = GoatWidgetConfig {
_goatWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_goatWidgetConfig_initialState = (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState
, _goatWidgetConfig_load :: Event t EverythingLoadState
_goatWidgetConfig_load = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t EverythingLoadState
loadFileEv, Event t EverythingLoadState
newEmptyFileEv]
, _goatWidgetConfig_mouse :: Event t LMouseData
_goatWidgetConfig_mouse = forall t a. Reflex t => FilePath -> [Event t a] -> Event t a
leftmostWarn FilePath
"mouse" [(forall t. LayerWidget t -> Event t LMouseData
_layerWidget_mouse (forall t. LeftWidget t -> LayerWidget t
_leftWidget_layersW LeftWidget t
leftW)), (forall t. CanvasWidget t -> Event t LMouseData
_canvasWidget_mouse CanvasWidget t
canvasW)]
, _goatWidgetConfig_keyboard :: Event t KeyboardData
_goatWidgetConfig_keyboard = Event t KeyboardData
keyboardEv
, _goatWidgetConfig_canvasRegionDim :: Event t XY
_goatWidgetConfig_canvasRegionDim = forall t. CanvasWidget t -> Event t XY
_canvasWidget_regionDim CanvasWidget t
canvasW
, _goatWidgetConfig_selectTool :: Event t Tool
_goatWidgetConfig_selectTool = forall t. ToolWidget t -> Event t Tool
_toolWidget_setTool (forall t. LeftWidget t -> ToolWidget t
_leftWidget_toolsW LeftWidget t
leftW)
, _goatWidgetConfig_paramsEvent :: Event t Llama
_goatWidgetConfig_paramsEvent = forall t. ParamsWidget t -> Event t Llama
_paramsWidget_paramsEvent (forall t. LeftWidget t -> ParamsWidget t
_leftWidget_paramsW LeftWidget t
leftW)
, _goatWidgetConfig_canvasSize :: Event t XY
_goatWidgetConfig_canvasSize = forall t. ParamsWidget t -> Event t XY
_paramsWidget_canvasSizeEvent (forall t. LeftWidget t -> ParamsWidget t
_leftWidget_paramsW LeftWidget t
leftW)
, _goatWidgetConfig_newFolder :: Event t ()
_goatWidgetConfig_newFolder = forall t. LayerWidget t -> Event t ()
_layerWidget_newFolderEv (forall t. LeftWidget t -> LayerWidget t
_leftWidget_layersW LeftWidget t
leftW)
, _goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters
_goatWidgetConfig_setPotatoDefaultParameters = forall t. ParamsWidget t -> Event t SetPotatoDefaultParameters
_paramsWidget_setDefaultParamsEvent (forall t. LeftWidget t -> ParamsWidget t
_leftWidget_paramsW LeftWidget t
leftW)
, _goatWidgetConfig_markSaved :: Event t ()
_goatWidgetConfig_markSaved = forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t FilePath
saveSuccessEv
, _goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea
_goatWidgetConfig_setFocusedArea = forall t. LeftWidget t -> Event t GoatFocusedArea
_leftWidget_setFocusEvent LeftWidget t
leftW
, _goatWidgetConfig_setDebugLabel :: Event t Text
_goatWidgetConfig_setDebugLabel = forall {k} (t :: k) a. Reflex t => Event t a
never
, _goatWidgetConfig_bypassEvent :: Event t WSEvent
_goatWidgetConfig_bypassEvent = Event t WSEvent
bypassEvent
}
GoatWidget t
everythingW <- forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m) =>
GoatWidgetConfig t -> m (GoatWidget t)
holdGoatWidget GoatWidgetConfig t
goatWidgetConfig
let
leftPanel :: PotatoReader t m (LeftWidget t)
leftPanel = forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
LeftWidgetConfig t -> m (LeftWidget t)
holdLeftWidget LeftWidgetConfig {
_layersWidgetConfig_goatW :: GoatWidget t
_layersWidgetConfig_goatW = GoatWidget t
everythingW
}
rightPanel :: PotatoReader t m (CanvasWidget t)
rightPanel = do
Dynamic t Region
dreg' <- forall {k} (t :: k) (m :: * -> *).
HasDisplayRegion t m =>
m (Dynamic t Region)
askRegion
let dreg :: Dynamic t Region
dreg = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Region
region -> Region
region { _region_left :: Int
_region_left = Int
0, _region_top :: Int
_region_top = Int
0}) Dynamic t Region
dreg'
Dynamic t Bool
f <- forall {k} (t :: k) (m :: * -> *).
HasFocusReader t m =>
m (Dynamic t Bool)
focus
forall {k} (m :: * -> *) (t :: k) a.
(MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m,
HasDisplayRegion t m, HasFocusReader t m) =>
Dynamic t Region -> Dynamic t Bool -> m a -> m a
pane Dynamic t Region
dreg Dynamic t Bool
f forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
CanvasWidgetConfig t -> m (CanvasWidget t)
holdCanvasWidget forall a b. (a -> b) -> a -> b
$ CanvasWidgetConfig {
_canvasWidgetConfig_pan :: Dynamic t XY
_canvasWidgetConfig_pan = forall t. GoatWidget t -> Dynamic t XY
_goatWidget_pan GoatWidget t
everythingW
, _canvasWidgetConfig_broadPhase :: Dynamic t BroadPhaseState
_canvasWidgetConfig_broadPhase = forall t. GoatWidget t -> Dynamic t BroadPhaseState
_goatWidget_broadPhase GoatWidget t
everythingW
, _canvasWidgetConfig_renderedCanvas :: Dynamic t RenderedCanvasRegion
_canvasWidgetConfig_renderedCanvas = forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedCanvas GoatWidget t
everythingW
, _canvasWidgetConfig_renderedSelection :: Dynamic t RenderedCanvasRegion
_canvasWidgetConfig_renderedSelection = forall t. GoatWidget t -> Dynamic t RenderedCanvasRegion
_goatWidget_renderedSelection GoatWidget t
everythingW
, _canvasWidgetConfig_canvas :: Dynamic t SCanvas
_canvasWidgetConfig_canvas = forall t. GoatWidget t -> Dynamic t SCanvas
_goatWidget_canvas GoatWidget t
everythingW
, _canvasWidgetConfig_handles :: Dynamic t HandlerRenderOutput
_canvasWidgetConfig_handles = forall t. GoatWidget t -> Dynamic t HandlerRenderOutput
_goatWidget_handlerRenderOutput GoatWidget t
everythingW
}
(Event t KeyboardData
keyboardEv, (LeftWidget t
leftW, CanvasWidget t
canvasW)) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoConfig t
potatoConfig forall a b. (a -> b) -> a -> b
$
forall t (m :: * -> *) a.
MonadWidget t m =>
These (Event t ()) (Behavior t Bool) -> m a -> m a
captureInputEvents (forall a b. a -> b -> These a b
These Event t ()
_appKbCmd_capturedInput Behavior t Bool
inputCapturedByPopupBeh) forall a b. (a -> b) -> a -> b
$ do
(LeftWidget t, CanvasWidget t)
stuff <- forall t (m :: * -> *) a b.
(Reflex t, MonadFix m, MonadHold t m, HasDisplayRegion t m,
HasInput t m, HasImageWriter t m, HasFocusReader t m) =>
Int -> m () -> m a -> m b -> m (a, b)
splitHDrag Int
35 (forall {k} (t :: k) (m :: * -> *).
(HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) =>
Behavior t Char -> m ()
fill (forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant Char
'*')) PotatoReader t m (LeftWidget t)
leftPanel PotatoReader t m (CanvasWidget t)
rightPanel
Event t KeyboardData
kb <- forall t (m :: * -> *) a.
MonadWidget t m =>
These (Event t ()) (Behavior t Bool) -> m a -> m a
captureInputEvents (forall a b. a -> These a b
This (forall t. ParamsWidget t -> Event t ()
_paramsWidget_captureInputEv (forall t. LeftWidget t -> ParamsWidget t
_leftWidget_paramsW LeftWidget t
leftW))) forall a b. (a -> b) -> a -> b
$ do
Event t Event
inp <- forall {k} (t :: k) (m :: * -> *).
HasInput t m =>
m (Event t Event)
input
return $ forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t Event
inp forall a b. (a -> b) -> a -> b
$ \case
V.EvKey Key
k [Modifier]
mods -> Key -> Maybe KeyboardKey
convertKey Key
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\KeyboardKey
kbd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ KeyboardKey -> [KeyModifier] -> KeyboardData
KeyboardData KeyboardKey
kbd ([Modifier] -> [KeyModifier]
convertModifiers [Modifier]
mods))
V.EvPaste ByteString
bs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ KeyboardKey -> [KeyModifier] -> KeyboardData
KeyboardData (Text -> KeyboardKey
KeyboardKey_Paste (ByteString -> Text
T.decodeUtf8 ByteString
bs)) []
Event
_ -> forall a. Maybe a
Nothing
return (Event t KeyboardData
kb, (LeftWidget t, CanvasWidget t)
stuff)
let
(Event t FilePath
clickSaveEv, Event t ()
nothingClickSaveEv) = forall t a.
Reflex t =>
Event t (Maybe a) -> (Event t a, Event t ())
fanMaybe forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall t. PotatoConfig t -> Behavior t (Maybe FilePath)
_potatoConfig_appCurrentOpenFile PotatoConfig t
potatoConfig) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_saveEv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW forall a b. (a -> b) -> a -> b
$ LeftWidget t
leftW, Event t ()
_appKbCmd_save, Event t ()
_saveBeforeActionOutput_save]
clickSaveAsEv :: Event t ()
clickSaveAsEv = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost forall a b. (a -> b) -> a -> b
$ [forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_saveAsEv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW forall a b. (a -> b) -> a -> b
$ LeftWidget t
leftW, Event t ()
nothingClickSaveEv, Event t ()
_saveBeforeActionOutput_saveAs]
let
showWelcomeEv :: Event t ()
showWelcomeEv = if Bool
_mainPFWidgetConfig_showWelcome then Event t ()
postBuildEv else forall {k} (t :: k) a. Reflex t => Event t a
never
(Event t ()
_, Dynamic t Bool
popupStateDyn1) <- forall t (m :: * -> *) a.
MonadWidget t m =>
PopupPaneSize
-> Event t (m (Event t a)) -> m (Event t a, Dynamic t Bool)
popupPaneSimple forall a. Default a => a
def (Event t ()
showWelcomeEv forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall t (m :: * -> *). MonadWidget t m => m (Event t ())
welcomeWidget)
(Event t FilePath
saveAsEv, Dynamic t Bool
popupStateDyn2) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoConfig t
potatoConfig forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SaveAsWindowConfig t -> m (Event t FilePath, Dynamic t Bool)
popupSaveAsWindow forall a b. (a -> b) -> a -> b
$ forall t. Event t FilePath -> SaveAsWindowConfig t
SaveAsWindowConfig (forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall t. PotatoConfig t -> Behavior t FilePath
_potatoConfig_appCurrentDirectory PotatoConfig t
potatoConfig) Event t ()
clickSaveAsEv)
let
saveFailAlertEv :: Event t Text
saveFailAlertEv = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a b. Either a b -> Maybe a
maybeLeft Event t (Either Text FilePath)
finishSaveEv
Dynamic t Bool
popupStateDyn3 <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoConfig t
potatoConfig forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t Text -> m (Dynamic t Bool)
popupAlert (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Text
saveFailAlertEv, Event t Text
loadFileFailAlertEv])
(SaveBeforeActionOutput {Event t ()
_saveBeforeActionOutput_exit :: forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_open :: forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_new :: forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_saveAs :: forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_save :: forall t. SaveBeforeActionOutput t -> Event t ()
_saveBeforeActionOutput_exit :: Event t ()
_saveBeforeActionOutput_open :: Event t ()
_saveBeforeActionOutput_saveAs :: Event t ()
_saveBeforeActionOutput_save :: Event t ()
_saveBeforeActionOutput_new :: Event t ()
..}, Dynamic t Bool
popupStateDyn4) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoConfig t
potatoConfig forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
SaveBeforeActionConfig t
-> m (SaveBeforeActionOutput t, Dynamic t Bool)
popupSaveBeforeExit forall a b. (a -> b) -> a -> b
$
SaveBeforeActionConfig {
_saveBeforeActionConfig_unsavedChangesBeh :: Behavior t Bool
_saveBeforeActionConfig_unsavedChangesBeh = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ forall t. GoatWidget t -> Dynamic t Bool
_goatWidget_unsavedChanges GoatWidget t
everythingW
, _saveBeforeActionConfig_open :: Event t ()
_saveBeforeActionConfig_open = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
_appKbCmd_open, forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_openEv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW forall a b. (a -> b) -> a -> b
$ LeftWidget t
leftW]
, _saveBeforeActionConfig_new :: Event t ()
_saveBeforeActionConfig_new = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
_appKbCmd_new, forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_newEv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW forall a b. (a -> b) -> a -> b
$ LeftWidget t
leftW]
, _saveBeforeActionConfig_exit :: Event t ()
_saveBeforeActionConfig_exit = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
_appKbCmd_quit, forall t. MenuButtonsWidget t -> Event t ()
_menuButtonsWidget_quitEv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. LeftWidget t -> MenuButtonsWidget t
_leftWidget_menuButtonsW forall a b. (a -> b) -> a -> b
$ LeftWidget t
leftW]
, _saveBeforeActionConfig_saveOutcomeEv :: Event t (Either Text FilePath)
_saveBeforeActionConfig_saveOutcomeEv = Event t (Either Text FilePath)
finishSaveEv
}
(Event t FilePath
openFileEv, Dynamic t Bool
popupStateDyn5) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t (m :: * -> *) a.
(Reflex t, Monad m) =>
PotatoReader t m a -> PotatoConfig t -> m a
runPotatoReader PotatoConfig t
potatoConfig forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
OpenWindowConfig t -> m (Event t FilePath, Dynamic t Bool)
popupOpenWindow forall a b. (a -> b) -> a -> b
$ forall t. Event t FilePath -> OpenWindowConfig t
OpenWindowConfig (forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall t. PotatoConfig t -> Behavior t FilePath
_potatoConfig_appCurrentDirectory PotatoConfig t
potatoConfig) Event t ()
_saveBeforeActionOutput_open)
let
inputCapturedByPopupBeh :: Behavior t Bool
inputCapturedByPopupBeh = forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Any
Any) forall a b. (a -> b) -> a -> b
$ [Dynamic t Bool
popupStateDyn1, Dynamic t Bool
popupStateDyn2, Dynamic t Bool
popupStateDyn3, Dynamic t Bool
popupStateDyn4, Dynamic t Bool
popupStateDyn5]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
_appKbCmd_forceQuit, Event t ()
_saveBeforeActionOutput_exit]