{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo     #-}

module Potato.Flow.Vty.Alert where

import           Relude

import           Potato.Flow
import           Potato.Flow.Vty.Common
import           Potato.Reflex.Vty.Helpers
import Potato.Flow.Vty.PotatoReader
import Potato.Flow.Vty.Attrs
import Potato.Reflex.Vty.Widget.FileExplorer
import Potato.Reflex.Vty.Widget.Popup


import           Control.Monad.Fix
import qualified Data.Text                         as T

import qualified Graphics.Vty                      as V
import           Reflex
import           Reflex.Potato.Helpers
import           Reflex.Vty

-- UNTESTED
popupAlert :: forall t m. (MonadWidget t m, HasPotato t m)
  => Event t Text
  -> m (Dynamic t Bool) -- ^ (popup state)
popupAlert :: forall t (m :: * -> *).
(MonadWidget t m, HasPotato t m) =>
Event t Text -> m (Dynamic t Bool)
popupAlert Event t Text
alertEv = do
  -- TODO style
  let
    fmapfn :: Text -> Event t () -> p -> f (Event t (), Event t a)
fmapfn Text
alert = \Event t ()
escEv p
clickOutsideEv -> do
      Event t ()
okEv <- 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
"😱ALERT😱" 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 => a -> Behavior t a
constant Text
alert)
          (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
"OK")
      return (forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t ()
escEv, Event t ()
okEv], forall {k} (t :: k) a. Reflex t => Event t a
never)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *) a.
MonadWidget t m =>
PopupPaneSize
-> Event t (PopupInputWidget t m a)
-> m (Event t a, Dynamic t Bool)
popupPane forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {f :: * -> *} {t} {t} {p} {a}.
(MonadNodeId f, HasDisplayRegion t f, HasTheme t f,
 HasFocusReader t f, HasInput t f, HasImageWriter t f, Reflex t,
 MonadHold t f, MonadFix f) =>
Text -> Event t () -> p -> f (Event t (), Event t a)
fmapfn Event t Text
alertEv)