{-# 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 #-}

-- The Displayable typeclass is used to define the display function.
-- The display function is used to convert a datatype to Text.
class Stable a => Displayable a where
      display :: a -> Text

-- The AppModel datatype used to contain the Widget passed to runApplication. 
-- The associated clock is a set of timers. 
-- Any timers created with mkTimerEvent will be added to the clock.
data AppModel where
    AppModel :: IsWidget a => !a -> !Clock -> AppModel



instance (Eq AppModel) where
      AppModel
_ == :: AppModel -> AppModel -> Bool
== AppModel
_ = Bool
False


-- AppEvent data type used to convert channels into events.
data AppEvent where
      AppEvent :: !(Chan a) -> !a -> AppEvent

-- The IsWidget typeclass is used to define the mkWidgetNode function.
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

-- Custom data types for widgets.
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 = Popup {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)} 

-- Template Haskell code for generating instances of Continous.
continuous ''Button
continuous ''TextField
continuous ''Label
continuous ''Widget
continuous ''HStack
continuous ''VStack
continuous ''TextDropdown
continuous ''Popup
continuous ''Slider

-- isWidget Instance declerations for Widgets.
-- Here widgget data types are passed to Monomer constructors.
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