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 :: forall id (es :: [Effect]).
(HyperView id es, Hyperbole :> es) =>
Eff es (Maybe (Event id (Action id)))
getEvent = do
  Query
q <- (.query) (Request -> Query) -> Eff es Request -> Eff es Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Request
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Request
request
  Maybe (Event id (Action id))
-> Eff es (Maybe (Event id (Action id)))
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Event id (Action id))
 -> Eff es (Maybe (Event id (Action id))))
-> Maybe (Event id (Action id))
-> Eff es (Maybe (Event id (Action id)))
forall a b. (a -> b) -> a -> b
$ do
    Event Text
ti Text
ta <- Query -> Maybe (Event Text Text)
lookupEvent Query
q
    id
vid <- Text -> Maybe id
forall a. ViewId a => Text -> Maybe a
parseViewId Text
ti
    Action id
act <- Text -> Maybe (Action id)
forall a. ViewAction a => Text -> Maybe a
parseAction Text
ta
    Event id (Action id) -> Maybe (Event id (Action id))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event id (Action id) -> Maybe (Event id (Action id)))
-> Event id (Action id) -> Maybe (Event id (Action id))
forall a b. (a -> b) -> a -> b
$ id -> Action id -> Event id (Action id)
forall id act. id -> act -> Event id act
Event id
vid Action id
act


lookupEvent :: Query -> Maybe (Event Text Text)
lookupEvent :: Query -> Maybe (Event Text Text)
lookupEvent Query
q = do
  Text
viewId <- ByteString -> Query -> Maybe Text
lookupParam ByteString
"hyp-id" Query
q
  Text
action <- ByteString -> Query -> Maybe Text
lookupParam ByteString
"hyp-action" Query
q
  Event Text Text -> Maybe (Event Text Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event Text Text -> Maybe (Event Text Text))
-> Event Text Text -> Maybe (Event Text Text)
forall a b. (a -> b) -> a -> b
$ Event{Text
viewId :: Text
viewId :: Text
viewId, Text
action :: Text
action :: Text
action}


-- | Lower-level lookup straight from the request
lookupParam :: ByteString -> Query -> Maybe Text
lookupParam :: ByteString -> Query -> Maybe Text
lookupParam ByteString
key Query
q = do
  Maybe ByteString
mval <- ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
key Query
q
  ByteString
val <- Maybe ByteString
mval
  Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
val