{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.HyperView.ViewAction where

import Data.Text (Text)
import GHC.Generics
import Web.Hyperbole.Data.Encoded as Encoded


{- | Define every action possible for a given 'HyperView'

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

  'update' (Louder msg) = do
    let new = msg <> \"!\"
    pure $ messageView new
@
-}
class ViewAction a where
  toAction :: a -> Encoded
  default toAction :: (Generic a, GToEncoded (Rep a)) => a -> Encoded
  toAction = a -> Encoded
forall a. (Generic a, GToEncoded (Rep a)) => a -> Encoded
genericToEncoded


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


instance ViewAction () where
  toAction :: () -> Encoded
toAction ()
_ = Encoded
forall a. Monoid a => a
mempty
  parseAction :: Encoded -> Either String ()
parseAction Encoded
_ = () -> Either String ()
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


encodeAction :: (ViewAction act) => act -> Text
encodeAction :: forall act. ViewAction act => act -> Text
encodeAction = Encoded -> Text
encodedToText (Encoded -> Text) -> (act -> Encoded) -> act -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. act -> Encoded
forall a. ViewAction a => a -> Encoded
toAction


decodeAction :: (ViewAction act) => Text -> Maybe act
decodeAction :: forall act. ViewAction act => Text -> Maybe act
decodeAction Text
t = do
  case Encoded -> Either String act
forall a. ViewAction a => Encoded -> Either String a
parseAction (Encoded -> Either String act)
-> Either String Encoded -> Either String act
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Either String Encoded
encodedParseText Text
t of
    Left String
_ -> Maybe act
forall a. Maybe a
Nothing
    Right act
a -> act -> Maybe act
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure act
a