ViewAction.hs

{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.View.ViewAction where

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


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

@
#EMBED Example.Simple instance HyperView Message
@
-}

{- | 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 = genericToEncoded


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


instance ViewAction () where
  toAction _ = mempty
  parseAction _ = pure ()


encodeAction :: (ViewAction act) => act -> Text
encodeAction = encodedToText . toAction


decodeAction :: (ViewAction act) => Text -> Maybe act
decodeAction t = do
  case parseAction =<< encodedParseText t of
    Left _ -> Nothing
    Right a -> pure a