{-# OPTIONS -fplugin=WidgetRattus.Plugin #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
module WidgetRattus.Widgets.InternalTypes where
import WidgetRattus
import WidgetRattus.InternalPrimitives
import WidgetRattus.Signal
import Data.Text
import qualified Monomer as M
{-# ANN module AllowLazyData #-}
class Stable a => Displayable a where
display :: a -> Text
data AppModel where
AppModel :: IsWidget a => !a -> !Clock -> AppModel
instance (Eq AppModel) where
AppModel
_ == :: AppModel -> AppModel -> Bool
== AppModel
_ = Bool
False
data AppEvent where
AppEvent :: !(Chan a) -> !a -> AppEvent
class Continuous a => IsWidget a where
mkWidgetNode :: a -> M.WidgetNode AppModel AppEvent
mkWidget :: a -> Widget
mkWidget a
w = a -> Sig Bool -> Widget
forall a. IsWidget a => a -> Sig Bool -> Widget
Widget a
w (Bool -> Sig Bool
forall a. a -> Sig a
WidgetRattus.Signal.const Bool
True)
setEnabled :: a -> Sig Bool -> Widget
setEnabled = a -> Sig Bool -> Widget
forall a. IsWidget a => a -> Sig Bool -> Widget
Widget
data Widget where
Widget :: IsWidget a => !a -> !(Sig Bool) -> Widget
data HStack where
HStack :: IsWidget a => !(Sig (List a)) -> HStack
data VStack where
VStack :: IsWidget a => !(Sig (List a)) -> VStack
data TextDropdown = TextDropdown {TextDropdown -> Sig Text
tddCurr :: !(Sig Text), TextDropdown -> Chan Text
tddEvent :: !(Chan Text), TextDropdown -> Sig (List Text)
tddList :: !(Sig (List Text))}
data = {Popup -> Sig Bool
popCurr :: !(Sig Bool), Popup -> Chan Bool
popEvent :: !(Chan Bool), Popup -> Sig Widget
popChild :: !(Sig Widget)}
data Slider = Slider {Slider -> Sig Int
sldCurr :: !(Sig Int), Slider -> Chan Int
sldEvent :: !(Chan Int), Slider -> Sig Int
sldMin :: !(Sig Int), Slider -> Sig Int
sldMax :: !(Sig Int)}
data Button where
Button :: (Displayable a) => {()
btnContent :: !(Sig a) , Button -> Chan ()
btnClick :: !(Chan ())} -> Button
data Label where
Label :: (Displayable a) => {()
labText :: !(Sig a)} -> Label
data TextField = TextField {TextField -> Sig Text
tfContent :: !(Sig Text), TextField -> Chan Text
tfInput :: !(Chan Text)}
continuous ''Button
continuous ''TextField
continuous ''Label
continuous ''Widget
continuous ''HStack
continuous ''VStack
continuous ''TextDropdown
continuous ''Popup
continuous ''Slider
instance IsWidget Button where
mkWidgetNode :: Button -> WidgetNode AppModel AppEvent
mkWidgetNode Button{btnContent :: ()
btnContent = a
txt ::: O (Sig a)
_ , btnClick :: Button -> Chan ()
btnClick = Chan ()
click} =
Text -> AppEvent -> WidgetNode AppModel AppEvent
forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
M.button (a -> Text
forall a. Displayable a => a -> Text
display a
txt) (Chan () -> () -> AppEvent
forall a. Chan a -> a -> AppEvent
AppEvent Chan ()
click ())
instance IsWidget TextField where
mkWidgetNode :: TextField -> WidgetNode AppModel AppEvent
mkWidgetNode TextField{tfContent :: TextField -> Sig Text
tfContent = Text
txt ::: O (Sig Text)
_, tfInput :: TextField -> Chan Text
tfInput = Chan Text
inp} =
Text -> (Text -> AppEvent) -> WidgetNode AppModel AppEvent
forall e s. WidgetEvent e => Text -> (Text -> e) -> WidgetNode s e
M.textFieldV Text
txt (Chan Text -> Text -> AppEvent
forall a. Chan a -> a -> AppEvent
AppEvent Chan Text
inp)
instance IsWidget Label where
mkWidgetNode :: Label -> WidgetNode AppModel AppEvent
mkWidgetNode Label{labText :: ()
labText = a
txt ::: O (Sig a)
_} = Text -> WidgetNode AppModel AppEvent
forall s e. Text -> WidgetNode s e
M.label (a -> Text
forall a. Displayable a => a -> Text
display a
txt)
instance IsWidget HStack where
mkWidgetNode :: HStack -> WidgetNode AppModel AppEvent
mkWidgetNode (HStack Sig (List a)
ws) = [StackCfg]
-> List (WidgetNode AppModel AppEvent)
-> WidgetNode AppModel AppEvent
forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
M.hstack_ [ Double -> StackCfg
forall t. CmbChildSpacing t => Double -> t
M.childSpacing_ Double
2] (List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent)
forall a. List a -> List a
reverse' (List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent))
-> List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent)
forall a b. (a -> b) -> a -> b
$ (a -> WidgetNode AppModel AppEvent)
-> List a -> List (WidgetNode AppModel AppEvent)
forall a b. (a -> b) -> List a -> List b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WidgetNode AppModel AppEvent
forall a. IsWidget a => a -> WidgetNode AppModel AppEvent
mkWidgetNode (Sig (List a) -> List a
forall a. Sig a -> a
current Sig (List a)
ws))
instance IsWidget VStack where
mkWidgetNode :: VStack -> WidgetNode AppModel AppEvent
mkWidgetNode (VStack Sig (List a)
ws) = [StackCfg]
-> List (WidgetNode AppModel AppEvent)
-> WidgetNode AppModel AppEvent
forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
M.vstack_ [ Double -> StackCfg
forall t. CmbChildSpacing t => Double -> t
M.childSpacing_ Double
2] (List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent)
forall a. List a -> List a
reverse' (List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent))
-> List (WidgetNode AppModel AppEvent)
-> List (WidgetNode AppModel AppEvent)
forall a b. (a -> b) -> a -> b
$ (a -> WidgetNode AppModel AppEvent)
-> List a -> List (WidgetNode AppModel AppEvent)
forall a b. (a -> b) -> List a -> List b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> WidgetNode AppModel AppEvent
forall a. IsWidget a => a -> WidgetNode AppModel AppEvent
mkWidgetNode (Sig (List a) -> List a
forall a. Sig a -> a
current Sig (List a)
ws))
instance IsWidget TextDropdown where
mkWidgetNode :: TextDropdown -> WidgetNode AppModel AppEvent
mkWidgetNode TextDropdown{tddList :: TextDropdown -> Sig (List Text)
tddList = List Text
opts ::: O (Sig (List Text))
_, tddCurr :: TextDropdown -> Sig Text
tddCurr = Text
curr ::: O (Sig Text)
_, tddEvent :: TextDropdown -> Chan Text
tddEvent = Chan Text
ch}
= Text
-> (Text -> AppEvent) -> List Text -> WidgetNode AppModel AppEvent
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, TextDropdownItem a,
TextShow a) =>
a -> (a -> e) -> t a -> WidgetNode s e
M.textDropdownV Text
curr (Chan Text -> Text -> AppEvent
forall a. Chan a -> a -> AppEvent
AppEvent Chan Text
ch) List Text
opts
instance IsWidget Popup where
mkWidgetNode :: Popup -> WidgetNode AppModel AppEvent
mkWidgetNode Popup{popCurr :: Popup -> Sig Bool
popCurr = Bool
curr ::: O (Sig Bool)
_, popEvent :: Popup -> Chan Bool
popEvent = Chan Bool
ch, popChild :: Popup -> Sig Widget
popChild = Sig Widget
child}
= Bool
-> (Bool -> AppEvent)
-> WidgetNode AppModel AppEvent
-> WidgetNode AppModel AppEvent
forall s e.
(WidgetModel s, WidgetEvent e) =>
Bool -> (Bool -> e) -> WidgetNode s e -> WidgetNode s e
M.popupV Bool
curr (Chan Bool -> Bool -> AppEvent
forall a. Chan a -> a -> AppEvent
AppEvent Chan Bool
ch) (Widget -> WidgetNode AppModel AppEvent
forall a. IsWidget a => a -> WidgetNode AppModel AppEvent
mkWidgetNode (Sig Widget -> Widget
forall a. Sig a -> a
current Sig Widget
child))
instance IsWidget Slider where
mkWidgetNode :: Slider -> WidgetNode AppModel AppEvent
mkWidgetNode Slider{sldCurr :: Slider -> Sig Int
sldCurr = Int
curr ::: O (Sig Int)
_, sldEvent :: Slider -> Chan Int
sldEvent = Chan Int
ch, sldMin :: Slider -> Sig Int
sldMin = Int
min ::: O (Sig Int)
_, sldMax :: Slider -> Sig Int
sldMax = Int
max ::: O (Sig Int)
_}
= Int
-> (Int -> AppEvent) -> Int -> Int -> WidgetNode AppModel AppEvent
forall a e s.
(SliderValue a, WidgetEvent e) =>
a -> (a -> e) -> a -> a -> WidgetNode s e
M.hsliderV Int
curr (Chan Int -> Int -> AppEvent
forall a. Chan a -> a -> AppEvent
AppEvent Chan Int
ch) Int
min Int
max
instance IsWidget Widget where
mkWidgetNode :: Widget -> WidgetNode AppModel AppEvent
mkWidgetNode (Widget a
w (Bool
e ::: O (Sig Bool)
_)) = WidgetNode AppModel AppEvent
-> Bool -> WidgetNode AppModel AppEvent
forall s e. WidgetNode s e -> Bool -> WidgetNode s e
M.nodeEnabled (a -> WidgetNode AppModel AppEvent
forall a. IsWidget a => a -> WidgetNode AppModel AppEvent
mkWidgetNode a
w) Bool
e
mkWidget :: Widget -> Widget
mkWidget Widget
w = Widget
w
setEnabled :: Widget -> Sig Bool -> Widget
setEnabled (Widget a
w Sig Bool
_) Sig Bool
es = a -> Sig Bool -> Widget
forall a. IsWidget a => a -> Sig Bool -> Widget
Widget a
w Sig Bool
es