{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.HyperView.ViewId where

import Data.Text (Text)
import Effectful
import Effectful.Reader.Dynamic
import GHC.Generics
import Web.Hyperbole.Data.Encoded as Encoded
import Web.Hyperbole.View (View, context)


{- | A unique identifier for a 'HyperView'

@
data Message = Message1 | Message2
  deriving (Generic, 'ViewId')
@
-}
class ViewId a where
  toViewId :: a -> Encoded
  default toViewId :: (Generic a, GToEncoded (Rep a)) => a -> Encoded
  toViewId = a -> Encoded
forall a. (Generic a, GToEncoded (Rep a)) => a -> Encoded
genericToEncoded


  parseViewId :: Encoded -> Either String a
  default parseViewId :: (Generic a, GFromEncoded (Rep a)) => Encoded -> Either String a
  parseViewId = Encoded -> Either String a
forall a.
(Generic a, GFromEncoded (Rep a)) =>
Encoded -> Either String a
genericParseEncoded


{- | Access the 'viewId' in a 'View' or 'update'

@
data LazyData = LazyData TaskId
  deriving (Generic, 'ViewId')

instance (Debug :> es, GenRandom :> es) => 'HyperView' LazyData es where
  data 'Action' LazyData
    = Details
    deriving (Generic, 'ViewAction')

  'update' Details = do
    LazyData taskId <- 'viewId'
    task <- pretendLoadTask taskId
    pure $ viewTaskDetails task
@
-}
class HasViewId m view where
  viewId :: m view


instance HasViewId (View ctx) ctx where
  viewId :: View ctx ctx
viewId = View ctx ctx
forall ctx. View ctx ctx
context
instance HasViewId (Eff (Reader view : es)) view where
  viewId :: Eff (Reader view : es) view
viewId = Eff (Reader view : es) view
forall r (es :: [(* -> *) -> * -> *]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask


encodeViewId :: (ViewId id) => id -> Text
encodeViewId :: forall id. ViewId id => id -> Text
encodeViewId = Encoded -> Text
encodedToText (Encoded -> Text) -> (id -> Encoded) -> id -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id -> Encoded
forall a. ViewId a => a -> Encoded
toViewId


decodeViewId :: (ViewId id) => Text -> Maybe id
decodeViewId :: forall id. ViewId id => Text -> Maybe id
decodeViewId Text
t = do
  case Encoded -> Either String id
forall a. ViewId a => Encoded -> Either String a
parseViewId (Encoded -> Either String id)
-> Either String Encoded -> Either String id
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Either String Encoded
encodedParseText Text
t of
    Left String
_ -> Maybe id
forall a. Maybe a
Nothing
    Right id
a -> id -> Maybe id
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure id
a