Widget.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Glazier.React.Widget where

import qualified Control.Disposable as CD
import Control.Lens
import Control.Monad.Free.Church
import qualified Data.DList as D
import qualified Glazier as G
import qualified Glazier.React.Maker as R
import qualified Glazier.React.Markup as R
import qualified Glazier.React.Model as R

type family CommandOf w where
    CommandOf (Widget c a m p) = c

type family ActionOf w where
    ActionOf (Widget c a m p) = a

type family ModelOf w where
    ModelOf (Widget c a m p) = m

type family PlanOf w where
    PlanOf (Widget c a m p) = p

-- | Undecidable instances! But this is safe because 'ModelOf w' and 'PlanOf w'
-- is guaranteed to be smaller than closed type family 'DesignOf w'.
type family DesignOf w where
    DesignOf w = R.Design (ModelOf w) (PlanOf w)

-- | Undecidable instances! But this is safe because 'ModelOf w' and 'PlanOf w'
-- is guaranteed to be smaller than closed type family 'FrameOf w'.
type family FrameOf w where
    FrameOf w = R.Frame (ModelOf w) (PlanOf w)

-- | Undecidable instances! But this is safe because 'ModelOf w' and 'PlanOf w'
-- is guaranteed to be smaller than closed type family 'SuperModelOf w'.
type family SuperModelOf w where
    SuperModelOf w = R.SuperModel (ModelOf w) (PlanOf w)

-- | Record of functions for a widget. Contains everything you need to make the model,
-- render, and run the event processing.
data Widget c a m p = Widget
    (R.Frame m p -> F (R.Maker a) p)
    (G.WindowT (R.Design m p) (R.ReactMlT Identity) ())
    (G.GadgetT a (R.SuperModel m p) Identity (D.DList c))

-- | This typeclass is convenient as it carries the 'Disposing Model' and 'Disposing Plan' constraints
-- and allows treating 'Widget c a m p' as a type 'w'
class (CD.Disposing (ModelOf w)
      , CD.Disposing (PlanOf w)) => IsWidget w where
    mkPlan :: w -> R.Frame (ModelOf w) (PlanOf w) -> F (R.Maker (ActionOf w)) (PlanOf w)
    window :: w -> G.WindowT (R.Design (ModelOf w) (PlanOf w)) (R.ReactMlT Identity) ()
    gadget :: w -> G.GadgetT (ActionOf w) (R.SuperModel (ModelOf w) (PlanOf w)) Identity (D.DList (CommandOf w))

instance (CD.Disposing m, CD.Disposing p) => IsWidget (Widget c a m p) where
    mkPlan (Widget f _ _) = f
    window (Widget _ f _) = f
    gadget (Widget _ _ f) = f

-- data Widget c a m p where
--     Widget :: (CD.Disposing m, CD.Disposing p) =>
--         (R.Frame m p -> F (R.Maker a) p)
--         -> G.WindowT (R.Design m p) (R.ReactMlT Identity) ()
--         -> G.GadgetT a (R.SuperModel m p) Identity (D.DList c)
--         -> Widget c a m p

-- mkPlan :: Widget c a m p -> R.Frame m p -> F (R.Maker a) p
-- mkPlan (Widget f _ _) = f

-- window :: Widget c a m p -> G.WindowT (R.Design m p) (R.ReactMlT Identity) ()
-- window (Widget _ f _) = f

-- gadget :: Widget c a m p -> G.GadgetT a (R.SuperModel m p) Identity (D.DList c)
-- gadget (Widget _ _ f) = f

mkSuperModel :: IsWidget w => w -> ModelOf w -> F (R.Maker (ActionOf w)) (R.SuperModel (ModelOf w) (PlanOf w))
mkSuperModel w mdl = do
    frm <- R.mkEmptyFrame
    dsn <- R.Design mdl <$> mkPlan w frm
    R.putFrame frm dsn
    pure (R.SuperModel dsn frm)