{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.HyperView.Types where

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


-- HyperView --------------------------------------------

{- | 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 = Message1 | Message2
  deriving (Generic, 'ViewId')

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

  'update' (Louder msg) = do
    let new = msg <> \"!\"
    pure $ messageView new
@
-}
class (ViewId id, ViewAction (Action id), ConcurrencyValue (Concurrency 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 Messages = '[ChildView]
  type Require id :: [Type]


  type Require id = '[]


  -- type ViewState id :: Type
  -- type ViewState id = ()

  -- | Control how overlapping actions are handled. 'Drop' by default
  --
  -- > type Concurrency Autocomplete = Replace
  type Concurrency id :: ConcurrencyMode


  type Concurrency id = Drop


  -- | 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 : State (ViewState id) : es) (View id ())


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


-- convert the type to a value
class ConcurrencyValue a where
  concurrencyMode :: ConcurrencyMode
instance ConcurrencyValue 'Drop where
  concurrencyMode :: ConcurrencyMode
concurrencyMode = ConcurrencyMode
Drop
instance ConcurrencyValue 'Replace where
  concurrencyMode :: ConcurrencyMode
concurrencyMode = ConcurrencyMode
Replace


data ConcurrencyMode
  = -- | Do not send any actions that occur while one is active. Prevents double-submitting writes or expensive operations
    Drop
  | -- | Ignore the results of older actions in favor of new ones. Use for read-only views with fast-firing interactions, like autocomplete, sliders, etc
    Replace
  deriving ((forall x. ConcurrencyMode -> Rep ConcurrencyMode x)
-> (forall x. Rep ConcurrencyMode x -> ConcurrencyMode)
-> Generic ConcurrencyMode
forall x. Rep ConcurrencyMode x -> ConcurrencyMode
forall x. ConcurrencyMode -> Rep ConcurrencyMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConcurrencyMode -> Rep ConcurrencyMode x
from :: forall x. ConcurrencyMode -> Rep ConcurrencyMode x
$cto :: forall x. Rep ConcurrencyMode x -> ConcurrencyMode
to :: forall x. Rep ConcurrencyMode x -> ConcurrencyMode
Generic, ConcurrencyMode -> Encoded
(ConcurrencyMode -> Encoded) -> ToEncoded ConcurrencyMode
forall a. (a -> Encoded) -> ToEncoded a
$ctoEncoded :: ConcurrencyMode -> Encoded
toEncoded :: ConcurrencyMode -> Encoded
ToEncoded, Encoded -> Either String ConcurrencyMode
(Encoded -> Either String ConcurrencyMode)
-> FromEncoded ConcurrencyMode
forall a. (Encoded -> Either String a) -> FromEncoded a
$cparseEncoded :: Encoded -> Either String ConcurrencyMode
parseEncoded :: Encoded -> Either String ConcurrencyMode
FromEncoded)


-- | 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) : State (ViewState (Root views)) : es)
     (View (Root views) ())
update Action (Root views)
_ = View (Root views) ()
-> Eff (Reader (Root views) : State () : es) (View (Root views) ())
forall a. a -> Eff (Reader (Root views) : State () : es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure View (Root views) ()
forall c. View c ()
none