{-# 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 qualified Graphics.Vty.UnicodeWidthTable.IO as V
import           Reflex
import           Reflex.Potato.Helpers
import           Reflex.Vty



-- TODO move all this into Potato.Reflex.Vty.Host or something whatever
-- | Sets up the top-level context for a 'VtyWidget' and runs it with that context
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/")


-- | run a VtyWidget using term width map written to disk with write-term-width for the current terminal
-- uses default if the file does not exist
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


-- | tick once (redraw widgets) upon event firing
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 ())

-- | TODO move to ReflexHelpers
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

-- TODO move to Data.Either.Extra
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_initialFile = Just "potato.flow"
    _mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState = (OwlPFState
owlpfstate_newProject, ControllerMeta
emptyControllerMeta)
  }

{-
verifyInput :: (Reflex t, MonadHold t m) => Event t VtyEvent -> m (Event t VtyEvent)
verifyInput ev = do
  let
    foldDynMaybeFn = \case
      EvMouseDown _ _ _ _ -> Just True
      EvMouseUp _ _ _ -> Just False
      _ -> Nothing
  isMouseDownDyn <- foldDynMaybe foldDynMaybeFn False ev
  -- TODO check for invalid key presses based on mouse state
-}

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 ()

-- NOTE, this will query welcome message each time you recreate this
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")




-- TODO DELETE OR MOVE UNUSED
-- | toggle the focus of a widget
-- also forces unfocused widget to ignore mouse inputs
focusWidgetNoMouse :: forall t m a. (MonadWidget t m)
  => Dynamic t Bool -- ^ whether widget should be focused or not, note events that change focus are not captured!
  -> 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

-- TODO DELETE OR MOVE UNUSED
-- | ignores mouse input unless widget is focused
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



-- | block all or some input events, always focused if parent is focused
captureInputEvents :: forall t m a. (MonadWidget t m)
  => These (Event t ()) (Behavior t Bool) -- ^ This ev is event indicating input should be capture. That beh is behavior gating input (true means captured)
  -> 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
  -- should this include controller meta too?
  , MainPFWidgetConfig -> (OwlPFState, ControllerMeta)
_mainPFWidgetConfig_initialState :: (OwlPFState, ControllerMeta) -- ^ will be overriden by initialFile if set
  , 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 = "/"
      , _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
  -- external inputs
  --currentTime <- liftIO $ getCurrentTime

  -- note tickEv triggers 2 ticks
  --tickEv <- tickLossy 1 currentTime
  --ticks <- foldDyn (+) (0 :: Int) (fmap (const 1) tickEv)

  --flowInput <- input >>= return . traceEvent "input: "
  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

  -- need this to force redraw of handles in some cases
  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
    -- load file on start
    -- TODO load file from open file dialog
    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]

  -- load file on start
  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)

  -- empty project event
  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
      -- a little silly to route a new empty project through the load file event but it's easy whatever
      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


  -- set the title
  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
    -- this only seems to sometimes work 🤷🏼‍♀️
    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

  -- debug stuff (temp)
  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

  -- application level hotkeys
  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

  -- setup PotatoConfig
  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
        -- TODO
        , _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]

        -- canvas direct input
        , _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

        -- TODO
        --, _goatWidgetConfig_unicodeWidthFn =

        -- debugging stuff
        , _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



  -- define main panels
  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
        }

  -- render main panels
  (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
      -- left panel may capture inputs, rigth panel never captures inputs
      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]

  -- 1 welcome popup
  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)

  -- 2 save as popup
  (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])

  -- 4 unsaved changes on action popup
  (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
      }

  -- 5 open popup
  (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
    -- TODO assert that we never have more than 1 popup open at once
    -- block input if any popup is currently open
    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]


  -- handle escape event
  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]