module Web.Hyperbole.Effect.Query where

import Data.ByteString qualified as BS
import Data.Default (Default (..))
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Effectful
import Effectful.Dispatch.Dynamic (send)
import Web.Hyperbole.Data.Param (FromParam (..), Param, ToParam (..))
import Web.Hyperbole.Data.QueryData (FromQuery (..), QueryData (..), ToQuery (..), queryData)
import Web.Hyperbole.Data.QueryData qualified as QueryData
import Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))
import Web.Hyperbole.Effect.Request (request)
import Web.Hyperbole.Types.Client (Client (..), clientSetQuery)
import Web.Hyperbole.Types.Request
import Web.Hyperbole.Types.Response
import Prelude


{- | Parse querystring from the 'Request' into a datatype. See 'FromQuery'

@
data Filters = Filters
  { search :: Text
  }
  deriving ('ToQuery', 'FromQuery', Generic)

page :: ('Hyperbole' :> es) => 'Page' es '[Todos]
page = do
  filters <- query @Filters
  todos <- loadTodos filters
  pure $ do
    'hyper' Todos $ todosView todos
@
-}
query :: (FromQuery a, Hyperbole :> es) => Eff es a
query :: forall a (es :: [Effect]).
(FromQuery a, Hyperbole :> es) =>
Eff es a
query = do
  QueryData
q <- Eff es QueryData
forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
queryParams
  case QueryData -> Either String a
forall a. FromQuery a => QueryData -> Either String a
parseQuery QueryData
q of
    Left String
e -> Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> Hyperbole (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> Response -> Hyperbole (Eff es) a
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err (ResponseError -> Response) -> ResponseError -> Response
forall a b. (a -> b) -> a -> b
$ String -> ResponseError
ErrQuery (String -> ResponseError) -> String -> ResponseError
forall a b. (a -> b) -> a -> b
$ String
"Query Parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" from " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a b. ConvertibleStrings a b => a -> b
cs (QueryData -> String
forall a. Show a => a -> String
show QueryData
q)
    Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


{- | Update the client's querystring to an encoded datatype. See 'ToQuery'

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

  'update' (SetSearch term) = do
    let filters = Filters term
    setQuery filters
    todos <- loadTodos filters
    pure $ todosView todos
@
-}
setQuery :: (ToQuery a, Hyperbole :> es) => a -> Eff es ()
setQuery :: forall a (es :: [Effect]).
(ToQuery a, Hyperbole :> es) =>
a -> Eff es ()
setQuery a
a = do
  (QueryData -> QueryData) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(QueryData -> QueryData) -> Eff es ()
modifyQueryData (QueryData -> QueryData -> QueryData
forall a b. a -> b -> a
const (QueryData -> QueryData -> QueryData)
-> QueryData -> QueryData -> QueryData
forall a b. (a -> b) -> a -> b
$ a -> QueryData
forall a. ToQuery a => a -> QueryData
toQuery a
a)


modifyQuery :: (ToQuery a, FromQuery a, Default a, Hyperbole :> es) => (a -> a) -> Eff es a
modifyQuery :: forall a (es :: [Effect]).
(ToQuery a, FromQuery a, Default a, Hyperbole :> es) =>
(a -> a) -> Eff es a
modifyQuery a -> a
f = do
  a
s <- Eff es a
forall a (es :: [Effect]).
(FromQuery a, Hyperbole :> es) =>
Eff es a
query
  let updated :: a
updated = a -> a
f a
s
  a -> Eff es ()
forall a (es :: [Effect]).
(ToQuery a, Hyperbole :> es) =>
a -> Eff es ()
setQuery a
updated
  a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
updated


{- | Parse a single query parameter. Return a 400 status if missing or if parsing fails. See 'FromParam'

@
page' :: ('Hyperbole' :> es) => 'Page' es '[Message]
page' = do
  msg <- param \"message\"
  pure $ do
    'hyper' Message $ messageView msg
@
-}
param :: (FromParam a, Hyperbole :> es) => Param -> Eff es a
param :: forall a (es :: [Effect]).
(FromParam a, Hyperbole :> es) =>
Param -> Eff es a
param Param
p = do
  QueryData
q <- Eff es QueryData
forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
queryParams
  case Param -> QueryData -> Either String a
forall a. FromParam a => Param -> QueryData -> Either String a
QueryData.require Param
p QueryData
q of
    Left String
e -> Hyperbole (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) a -> Eff es a)
-> Hyperbole (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Response -> Hyperbole (Eff es) a
forall (a :: * -> *) b. Response -> Hyperbole a b
RespondNow (Response -> Hyperbole (Eff es) a)
-> Response -> Hyperbole (Eff es) a
forall a b. (a -> b) -> a -> b
$ ResponseError -> Response
Err (ResponseError -> Response) -> ResponseError -> Response
forall a b. (a -> b) -> a -> b
$ String -> ResponseError
ErrQuery (String -> String
forall a b. ConvertibleStrings a b => a -> b
cs String
e)
    Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


{- | Parse a single parameter from the query string if available


@
page :: ('Hyperbole' :> es) => 'Page' es '[Message]
page = do
  prm <- 'lookupParam' \"msg\"
  let msg = fromMaybe \"hello\" prm
  pure $ do
    'hyper' Message $ messageView msg
@
-}
lookupParam :: (FromParam a, Hyperbole :> es) => Param -> Eff es (Maybe a)
lookupParam :: forall a (es :: [Effect]).
(FromParam a, Hyperbole :> es) =>
Param -> Eff es (Maybe a)
lookupParam Param
p = do
  Param -> QueryData -> Maybe a
forall a. FromParam a => Param -> QueryData -> Maybe a
QueryData.lookup Param
p (QueryData -> Maybe a) -> Eff es QueryData -> Eff es (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es QueryData
forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
queryParams


{- | Modify the client's querystring to set a single parameter. See 'ToParam'

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

  'update' (SetMessage msg) = do
    'setParam' \"message\" msg
    pure $ messageView msg
@
-}
setParam :: (ToParam a, Hyperbole :> es) => Param -> a -> Eff es ()
setParam :: forall a (es :: [Effect]).
(ToParam a, Hyperbole :> es) =>
Param -> a -> Eff es ()
setParam Param
key a
a = do
  (QueryData -> QueryData) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(QueryData -> QueryData) -> Eff es ()
modifyQueryData (Param -> a -> QueryData -> QueryData
forall a. ToParam a => Param -> a -> QueryData -> QueryData
QueryData.insert Param
key a
a)


-- | Delete a single parameter from the query string
deleteParam :: (Hyperbole :> es) => Param -> Eff es ()
deleteParam :: forall (es :: [Effect]). (Hyperbole :> es) => Param -> Eff es ()
deleteParam Param
key = do
  (QueryData -> QueryData) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(QueryData -> QueryData) -> Eff es ()
modifyQueryData (Param -> QueryData -> QueryData
QueryData.delete Param
key)


-- | Return the querystring from 'Request' as a 'QueryData'
queryParams :: (Hyperbole :> es) => Eff es QueryData
queryParams :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
queryParams = do
  Maybe QueryData
cq <- Eff es (Maybe QueryData)
clientQuery
  QueryData
rq <- Eff es QueryData
forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
requestQuery
  QueryData -> Eff es QueryData
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryData -> Eff es QueryData) -> QueryData -> Eff es QueryData
forall a b. (a -> b) -> a -> b
$ QueryData -> Maybe QueryData -> QueryData
forall a. a -> Maybe a -> a
fromMaybe QueryData
rq Maybe QueryData
cq
 where
  clientQuery :: Eff es (Maybe QueryData)
clientQuery = (.query) (Client -> Maybe QueryData)
-> Eff es Client -> Eff es (Maybe QueryData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hyperbole (Eff es) Client -> Eff es Client
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Hyperbole (Eff es) Client
forall (a :: * -> *). Hyperbole a Client
GetClient

  requestQuery :: (Hyperbole :> es) => Eff es QueryData
  requestQuery :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
requestQuery = do
    Request
r <- Eff es Request
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Request
request
    QueryData -> Eff es QueryData
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryData -> Eff es QueryData) -> QueryData -> Eff es QueryData
forall a b. (a -> b) -> a -> b
$ [QueryItem] -> QueryData
queryData ([QueryItem] -> QueryData) -> [QueryItem] -> QueryData
forall a b. (a -> b) -> a -> b
$ (QueryItem -> Bool) -> [QueryItem] -> [QueryItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (QueryItem -> Bool) -> QueryItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryItem -> Bool
forall {b}. (ByteString, b) -> Bool
isSystemParam) Request
r.query

  isSystemParam :: (ByteString, b) -> Bool
isSystemParam (ByteString
key, b
_) =
    ByteString
"hyp-" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
key


modifyQueryData :: (Hyperbole :> es) => (QueryData -> QueryData) -> Eff es ()
modifyQueryData :: forall (es :: [Effect]).
(Hyperbole :> es) =>
(QueryData -> QueryData) -> Eff es ()
modifyQueryData QueryData -> QueryData
f = do
  QueryData
q <- Eff es QueryData
forall (es :: [Effect]). (Hyperbole :> es) => Eff es QueryData
queryParams
  Hyperbole (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Hyperbole (Eff es) () -> Eff es ())
-> Hyperbole (Eff es) () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ (Client -> Client) -> Hyperbole (Eff es) ()
forall (a :: * -> *). (Client -> Client) -> Hyperbole a ()
ModClient ((Client -> Client) -> Hyperbole (Eff es) ())
-> (Client -> Client) -> Hyperbole (Eff es) ()
forall a b. (a -> b) -> a -> b
$ QueryData -> Client -> Client
clientSetQuery (QueryData -> QueryData
f QueryData
q)