{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.HyperView.Hyper where

import Data.Aeson (ToJSON)
import Data.Aeson qualified as A
import Data.String.Conversions (cs)
import Web.Atomic.Types
import Web.Hyperbole.Data.Encoded as Encoded
import Web.Hyperbole.HyperView.Handled (HyperViewHandled)
import Web.Hyperbole.HyperView.Types
import Web.Hyperbole.View (View, runViewContext, tag)
import Web.Hyperbole.View.ViewId


{- ! Embed a 'HyperView' into a page or another 'View'

@
#EMBED Example.Docs.Interactive page
@
-}

{- | Embed a 'HyperView' into a page or another 'View'

@
page :: 'Page' es '[Message]
page = do
  pure $ do
    'el' \"Unchanging Header\"
    'hyper' Message1 $ messageView \"Hello\"
    'hyper' Message2 $ messageView \"World\"
@
-}
hyper
  :: forall id ctx
   . (HyperViewHandled id ctx, ViewId id, ViewState id ~ (), ConcurrencyValue (Concurrency id))
  => id
  -> View id ()
  -> View ctx ()
hyper :: forall id ctx.
(HyperViewHandled id ctx, ViewId id, ViewState id ~ (),
 ConcurrencyValue (Concurrency id)) =>
id -> View id () -> View ctx ()
hyper id
vid = id -> ViewState id -> View id () -> View ctx ()
forall id ctx.
(HyperViewHandled id ctx, ViewId id, ToJSON (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperState id
vid ()


{- ! Embed a 'HyperView' into a page or another 'View' with a starting 'ViewState'

@
#EMBED Example.State.ViewState page
@
-}

{- | Embed a 'HyperView' into a page or another 'View' with a starting 'ViewState'

@
page :: ('Hyperbole' :> es) => 'Page' es '[Counter]
page = do
  pure $ do
    hyperState CounterState 10 viewCount
@
-}
hyperState
  :: forall id ctx
   . (HyperViewHandled id ctx, ViewId id, ToJSON (ViewState id), ConcurrencyValue (Concurrency id))
  => id
  -> ViewState id
  -> View id ()
  -> View ctx ()
hyperState :: forall id ctx.
(HyperViewHandled id ctx, ViewId id, ToJSON (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperState = id -> ViewState id -> View id () -> View ctx ()
forall id ctx.
(ViewId id, ViewState id ~ ViewState id, ToJSON (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperUnsafe


hyperUnsafe :: forall id ctx. (ViewId id, ViewState id ~ ViewState id, ToJSON (ViewState id), ConcurrencyValue (Concurrency id)) => id -> ViewState id -> View id () -> View ctx ()
hyperUnsafe :: forall id ctx.
(ViewId id, ViewState id ~ ViewState id, ToJSON (ViewState id),
 ConcurrencyValue (Concurrency id)) =>
id -> ViewState id -> View id () -> View ctx ()
hyperUnsafe id
vid ViewState id
st View id ()
vw = do
  Name -> View ctx () -> View ctx ()
forall c. Name -> View c () -> View c ()
tag Name
"div" (View ctx () -> View ctx ())
-> (Attributes (View ctx () -> View ctx ())
    -> Attributes (View ctx () -> View ctx ()))
-> View ctx ()
-> View ctx ()
forall h.
Attributable h =>
h -> (Attributes h -> Attributes h) -> h
@ Name
-> Name
-> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"id" (Encoded -> Name
encodedToText (Encoded -> Name) -> Encoded -> Name
forall a b. (a -> b) -> a -> b
$ id -> Encoded
forall a. ViewId a => a -> Encoded
toViewId id
vid) (Attributes (View ctx () -> View ctx ())
 -> Attributes (View ctx () -> View ctx ()))
-> (Attributes (View ctx () -> View ctx ())
    -> Attributes (View ctx () -> View ctx ()))
-> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
state (Attributes (View ctx () -> View ctx ())
 -> Attributes (View ctx () -> View ctx ()))
-> (Attributes (View ctx () -> View ctx ())
    -> Attributes (View ctx () -> View ctx ()))
-> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
concurrency (View ctx () -> View ctx ()) -> View ctx () -> View ctx ()
forall a b. (a -> b) -> a -> b
$
    id -> ViewState id -> View id () -> View ctx ()
forall ctx c. ctx -> ViewState ctx -> View ctx () -> View c ()
runViewContext id
vid ViewState id
st View id ()
vw
 where
  concurrency :: Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
concurrency =
    case forall {k} (a :: k). ConcurrencyValue a => ConcurrencyMode
forall (a :: ConcurrencyMode).
ConcurrencyValue a =>
ConcurrencyMode
concurrencyMode @(Concurrency id) of
      ConcurrencyMode
Drop -> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall a. a -> a
id
      ConcurrencyMode
Replace -> Name
-> Name
-> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-concurrency" (ConcurrencyMode -> Name
forall a. ToEncoded a => a -> Name
encode ConcurrencyMode
Replace)

  state :: Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
state =
    let enc :: ByteString
enc = ViewState id -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode ViewState id
st
     in if ByteString
enc ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty
          then Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall a. a -> a
id
          else Name
-> Name
-> Attributes (View ctx () -> View ctx ())
-> Attributes (View ctx () -> View ctx ())
forall h.
Attributable h =>
Name -> Name -> Attributes h -> Attributes h
att Name
"data-state" (ByteString -> Name
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
enc)