packages feed

hyperbole-0.4.2: src/Web/Hyperbole/Effect/Event.hs

module Web.Hyperbole.Effect.Event where

import Data.ByteString (ByteString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Effectful
import Network.HTTP.Types (Query)
import Web.Hyperbole.Effect.Hyperbole (Hyperbole)
import Web.Hyperbole.Effect.Request (request)
import Web.Hyperbole.Effect.Server (Event (..), Request (..))
import Web.Hyperbole.HyperView (HyperView (..), ViewAction (..), ViewId (..))


getEvent :: (HyperView id es, Hyperbole :> es) => Eff es (Maybe (Event id (Action id)))
getEvent = do
  q <- (.query) <$> request
  pure $ do
    Event ti ta <- lookupEvent q
    vid <- parseViewId ti
    act <- parseAction ta
    pure $ Event vid act


lookupEvent :: Query -> Maybe (Event Text Text)
lookupEvent q = do
  viewId <- lookupParam "hyp-id" q
  action <- lookupParam "hyp-action" q
  pure $ Event{viewId, action}


-- | Lower-level lookup straight from the request
lookupParam :: ByteString -> Query -> Maybe Text
lookupParam key q = do
  mval <- lookup key q
  val <- mval
  pure $ cs val