{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.HyperView.Types where

import Data.Kind (Type)
import Effectful
import Effectful.Reader.Dynamic
import GHC.Generics
import Web.Hyperbole.Effect.Hyperbole (Hyperbole)
import Web.Hyperbole.HyperView.ViewAction
import Web.Hyperbole.HyperView.ViewId
import Web.Hyperbole.View (View, none)


{- | HyperViews are interactive subsections of a 'Page'

Create an instance with a unique view id type and a sum type describing the actions the HyperView supports. The View Id can contain context (a database id, for example)

@
data Message = Message
  deriving (Generic, 'ViewId')

instance 'HyperView' Message es where
  data 'Action' Message
    = SetMessage Text
    deriving (Generic, 'ViewAction')

  'update' (SetMessage msg) =
    pure $ messageView msg
@
-}
class (ViewId id, ViewAction (Action id)) => HyperView id es where
  -- | Outline all actions that are permitted in this HyperView
  --
  -- > data Action Message = SetMessage Text | ClearMessage
  -- >   deriving (Generic, ViewAction)
  data Action id


  -- | Include any child hyperviews here. The compiler will make sure that the page knows how to handle them
  --
  -- > type Require = '[ChildView]
  type Require id :: [Type]


  type Require id = '[]


  -- | Specify how the view should be updated for each Action
  --
  -- > update (SetMessage msg) = pure $ messageView msg
  -- > update ClearMessage = pure $ messageView ""
  update :: (Hyperbole :> es) => Action id -> Eff (Reader id : es) (View id ())


-- | The top-level view returned by a 'Page'. It carries a type-level list of every 'HyperView' used in our 'Page' so the compiler can check our work and wire everything together.
data Root (views :: [Type]) = Root
  deriving ((forall x. Root views -> Rep (Root views) x)
-> (forall x. Rep (Root views) x -> Root views)
-> Generic (Root views)
forall (views :: [*]) x. Rep (Root views) x -> Root views
forall (views :: [*]) x. Root views -> Rep (Root views) x
forall x. Rep (Root views) x -> Root views
forall x. Root views -> Rep (Root views) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (views :: [*]) x. Root views -> Rep (Root views) x
from :: forall x. Root views -> Rep (Root views) x
$cto :: forall (views :: [*]) x. Rep (Root views) x -> Root views
to :: forall x. Rep (Root views) x -> Root views
Generic, Encoded -> Either String (Root views)
Root views -> Encoded
(Root views -> Encoded)
-> (Encoded -> Either String (Root views)) -> ViewId (Root views)
forall (views :: [*]). Encoded -> Either String (Root views)
forall (views :: [*]). Root views -> Encoded
forall a.
(a -> Encoded) -> (Encoded -> Either String a) -> ViewId a
$ctoViewId :: forall (views :: [*]). Root views -> Encoded
toViewId :: Root views -> Encoded
$cparseViewId :: forall (views :: [*]). Encoded -> Either String (Root views)
parseViewId :: Encoded -> Either String (Root views)
ViewId)


instance HyperView (Root views) es where
  data Action (Root views) = RootNone
    deriving ((forall x. Action (Root views) -> Rep (Action (Root views)) x)
-> (forall x. Rep (Action (Root views)) x -> Action (Root views))
-> Generic (Action (Root views))
forall (views :: [*]) x.
Rep (Action (Root views)) x -> Action (Root views)
forall (views :: [*]) x.
Action (Root views) -> Rep (Action (Root views)) x
forall x. Rep (Action (Root views)) x -> Action (Root views)
forall x. Action (Root views) -> Rep (Action (Root views)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (views :: [*]) x.
Action (Root views) -> Rep (Action (Root views)) x
from :: forall x. Action (Root views) -> Rep (Action (Root views)) x
$cto :: forall (views :: [*]) x.
Rep (Action (Root views)) x -> Action (Root views)
to :: forall x. Rep (Action (Root views)) x -> Action (Root views)
Generic, Encoded -> Either String (Action (Root views))
Action (Root views) -> Encoded
(Action (Root views) -> Encoded)
-> (Encoded -> Either String (Action (Root views)))
-> ViewAction (Action (Root views))
forall (views :: [*]).
Encoded -> Either String (Action (Root views))
forall (views :: [*]). Action (Root views) -> Encoded
forall a.
(a -> Encoded) -> (Encoded -> Either String a) -> ViewAction a
$ctoAction :: forall (views :: [*]). Action (Root views) -> Encoded
toAction :: Action (Root views) -> Encoded
$cparseAction :: forall (views :: [*]).
Encoded -> Either String (Action (Root views))
parseAction :: Encoded -> Either String (Action (Root views))
ViewAction)
  type Require (Root views) = views
  update :: (Hyperbole :> es) =>
Action (Root views)
-> Eff (Reader (Root views) : es) (View (Root views) ())
update Action (Root views)
_ = View (Root views) ()
-> Eff (Reader (Root views) : es) (View (Root views) ())
forall a. a -> Eff (Reader (Root views) : es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure View (Root views) ()
forall c. View c ()
none