{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeOperators          #-}

-- | A 'Widget' value can wrap any 'Patchable' widget, hiding the underlying
-- widget type, such that you can embed heterogeneous collections of widgets in
-- containers.
module GI.Gtk.Declarative.Widget
  ( Widget(..)
  -- * Widget to Markup conversion
  , FromWidget(..)
  )
where

import           Data.Typeable

import           GI.Gtk.Declarative.EventSource
import           GI.Gtk.Declarative.Patch

-- | A 'Widget' value wraps a 'Patchable' and 'EventSource' widget, providing
-- a constrained equivalent of a 'Dynamic' value. It is used to support
-- heterogeneous containers of widgets, and to support equality
-- checks on different types of widgets when calculating patches.
data Widget event where
  Widget
    ::( Typeable widget
       , Patchable widget
       , Functor widget
       , EventSource widget
       )
    => widget event
    -> Widget event

instance Functor Widget where
  fmap :: (a -> b) -> Widget a -> Widget b
fmap f :: a -> b
f (Widget w :: widget a
w) = widget b -> Widget b
forall (widget :: * -> *) event.
(Typeable widget, Patchable widget, Functor widget,
 EventSource widget) =>
widget event -> Widget event
Widget ((a -> b) -> widget a -> widget b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f widget a
w)

-- | 'Widget' is itself patchable, by delegating to the underlying
-- widget instances.
instance Patchable Widget where
  create :: Widget e -> IO SomeState
create (Widget w :: widget e
w) = widget e -> IO SomeState
forall (widget :: * -> *) e.
Patchable widget =>
widget e -> IO SomeState
create widget e
w
  patch :: SomeState -> Widget e1 -> Widget e2 -> Patch
patch s :: SomeState
s (Widget (widget e1
w1 :: t1 e1)) (Widget (widget e2
w2 :: t2 e2)) = case (Typeable widget, Typeable widget) => Maybe (widget :~: widget)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @t1 @t2 of
    Just Refl -> SomeState -> widget e1 -> widget e2 -> Patch
forall (widget :: * -> *) e1 e2.
Patchable widget =>
SomeState -> widget e1 -> widget e2 -> Patch
patch SomeState
s widget e1
w1 widget e2
widget e2
w2
    _         -> IO SomeState -> Patch
Replace (widget e2 -> IO SomeState
forall (widget :: * -> *) e.
Patchable widget =>
widget e -> IO SomeState
create widget e2
w2)

instance EventSource Widget where
  subscribe :: Widget event -> SomeState -> (event -> IO ()) -> IO Subscription
subscribe (Widget w :: widget event
w) = widget event -> SomeState -> (event -> IO ()) -> IO Subscription
forall (widget :: * -> *) event.
EventSource widget =>
widget event -> SomeState -> (event -> IO ()) -> IO Subscription
subscribe widget event
w

-- | Convert a widget to a target type. This is deliberately unconstrained in
-- it's types, and is used by smart constructors to implement return type
-- polymorphism, so that a smart contructor can return either a 'Widget', or
-- some specifically typed widget, depending on the context in which it's
-- used.
class FromWidget widget target where
  fromWidget :: widget event -> target event

instance ( Typeable parent
         , Typeable child
         , Patchable (parent child)
         , Functor (parent child)
         , EventSource (parent child)
         )
         => FromWidget (parent child) Widget where
  fromWidget :: parent child event -> Widget event
fromWidget = parent child event -> Widget event
forall (widget :: * -> *) event.
(Typeable widget, Patchable widget, Functor widget,
 EventSource widget) =>
widget event -> Widget event
Widget