{-# LANGUAGE AllowAmbiguousTypes #-}

module Web.Hyperbole.Effect.Session where

import Data.Maybe (fromMaybe)
import Effectful
import Effectful.Dispatch.Dynamic
import Web.Hyperbole.Data.QueryData
import Web.Hyperbole.Data.Session as Cookies
import Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))
import Web.Hyperbole.Effect.Request (request)
import Web.Hyperbole.Effect.Server (Client (..), Request (..), Response (..), ResponseError (..))
import Prelude


{- | Persist datatypes in browser cookies. If the session doesn't exist, the 'DefaultParam' is used

@
data Preferences = Preferences
  { color :: AppColor
  }
  deriving (Generic, Show, Read, 'ToParam', 'FromParam', 'Session')

instance 'DefaultParam' Preferences where
  defaultParam = Preferences White

page :: ('Hyperbole' :> es) => 'Eff' es ('Page' '[Content])
page = do
  prefs <- session @Preferences
  pure $ 'el' (bg prefs.color) \"Custom Background\"
@
-}
session :: (Session a, DefaultParam a, FromParam a, Hyperbole :> es) => Eff es a
session :: forall a (es :: [Effect]).
(Session a, DefaultParam a, FromParam a, Hyperbole :> es) =>
Eff es a
session = do
  Maybe a
ms <- Eff es (Maybe a)
forall a (es :: [Effect]).
(Session a, FromParam a, Hyperbole :> es) =>
Eff es (Maybe a)
lookupSession
  a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Eff es a) -> a -> Eff es a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. DefaultParam a => a
defaultParam Maybe a
ms


-- | Return a session if it exists
lookupSession :: forall a es. (Session a, FromParam a, Hyperbole :> es) => Eff es (Maybe a)
lookupSession :: forall a (es :: [Effect]).
(Session a, FromParam a, Hyperbole :> es) =>
Eff es (Maybe a)
lookupSession = do
  let key :: Param
key = forall a. Session a => Param
sessionKey @a
  Maybe ParamValue
mck <- Param -> Cookies -> Maybe ParamValue
Cookies.lookup Param
key (Cookies -> Maybe ParamValue)
-> Eff es Cookies -> Eff es (Maybe ParamValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Cookies
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
sessionCookies
  case Maybe ParamValue
mck of
    Maybe ParamValue
Nothing -> Maybe a -> Eff es (Maybe a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just ParamValue
val -> Param -> ParamValue -> Eff es (Maybe a)
forall a (es :: [Effect]).
(FromParam a, Hyperbole :> es) =>
Param -> ParamValue -> Eff es a
parseSession Param
key ParamValue
val


{- | Persist datatypes in browser cookies

@
data Preferences = Preferences
  { color :: AppColor
  }
  deriving (Generic, Show, Read, 'ToParam', 'FromParam', 'Session')

instance 'DefaultParam' Preferences where
  defaultParam = Preferences White

instance 'HyperView' Content es where
  data 'Action' Content
    = SetColor AppColor
    deriving (Show, Read, 'ViewAction')

  'update' (SetColor clr) = do
    let prefs = Preferences clr
    saveSession prefs
    pure $ 'el' (bg prefs.color) \"Custom Background\"
@
-}
saveSession :: (Session a, ToParam a, Hyperbole :> es) => a -> Eff es ()
saveSession :: forall a (es :: [Effect]).
(Session a, ToParam a, Hyperbole :> es) =>
a -> Eff es ()
saveSession a
a = do
  (Cookies -> Cookies) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(Cookies -> Cookies) -> Eff es ()
modifyCookies ((Cookies -> Cookies) -> Eff es ())
-> (Cookies -> Cookies) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Cookie -> Cookies -> Cookies
Cookies.insert (a -> Cookie
forall a. (Session a, ToParam a) => a -> Cookie
sessionCookie a
a)


modifySession :: (Session a, DefaultParam a, ToParam a, FromParam a, Hyperbole :> es) => (a -> a) -> Eff es a
modifySession :: forall a (es :: [Effect]).
(Session a, DefaultParam a, ToParam a, FromParam a,
 Hyperbole :> es) =>
(a -> a) -> Eff es a
modifySession a -> a
f = do
  a
s <- Eff es a
forall a (es :: [Effect]).
(Session a, DefaultParam a, FromParam a, Hyperbole :> es) =>
Eff es a
session
  let updated :: a
updated = a -> a
f a
s
  a -> Eff es ()
forall a (es :: [Effect]).
(Session a, ToParam a, Hyperbole :> es) =>
a -> Eff es ()
saveSession a
updated
  a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
updated


modifySession_ :: (Session a, DefaultParam a, ToParam a, FromParam a, Hyperbole :> es) => (a -> a) -> Eff es ()
modifySession_ :: forall a (es :: [Effect]).
(Session a, DefaultParam a, ToParam a, FromParam a,
 Hyperbole :> es) =>
(a -> a) -> Eff es ()
modifySession_ a -> a
f = do
  a
_ <- (a -> a) -> Eff es a
forall a (es :: [Effect]).
(Session a, DefaultParam a, ToParam a, FromParam a,
 Hyperbole :> es) =>
(a -> a) -> Eff es a
modifySession a -> a
f
  () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Remove a single 'Session' from the browser cookies
deleteSession :: forall a es. (Session a, Hyperbole :> es) => Eff es ()
deleteSession :: forall a (es :: [Effect]).
(Session a, Hyperbole :> es) =>
Eff es ()
deleteSession = do
  (Cookies -> Cookies) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(Cookies -> Cookies) -> Eff es ()
modifyCookies ((Cookies -> Cookies) -> Eff es ())
-> (Cookies -> Cookies) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Cookie -> Cookies -> Cookies
Cookies.insert (forall a. Session a => Cookie
deletedCookie @a)


parseSession :: (FromParam a, Hyperbole :> es) => Param -> ParamValue -> Eff es a
parseSession :: forall a (es :: [Effect]).
(FromParam a, Hyperbole :> es) =>
Param -> ParamValue -> Eff es a
parseSession Param
prm ParamValue
val = do
  case ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam ParamValue
val of
    Left Text
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
RespondEarly (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
$ Param -> Text -> ResponseError
ErrSession Param
prm Text
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


-- | save a single datatype to a specific key in the session
setCookie :: (ToParam a, Hyperbole :> es) => Cookie -> Eff es ()
setCookie :: forall a (es :: [Effect]).
(ToParam a, Hyperbole :> es) =>
Cookie -> Eff es ()
setCookie Cookie
ck = do
  (Cookies -> Cookies) -> Eff es ()
forall (es :: [Effect]).
(Hyperbole :> es) =>
(Cookies -> Cookies) -> Eff es ()
modifyCookies (Cookie -> Cookies -> Cookies
Cookies.insert Cookie
ck)


-- | Modify the client cookies
modifyCookies :: (Hyperbole :> es) => (Cookies -> Cookies) -> Eff es ()
modifyCookies :: forall (es :: [Effect]).
(Hyperbole :> es) =>
(Cookies -> Cookies) -> Eff es ()
modifyCookies Cookies -> Cookies
f =
  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
$ \Client
client ->
    Client{session :: Cookies
session = Cookies -> Cookies
f Client
client.session, query :: Maybe QueryData
query = Client
client.query}


-- | Return all the cookies, both those sent in the request and others added by the page
sessionCookies :: (Hyperbole :> es) => Eff es Cookies
sessionCookies :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
sessionCookies = do
  Cookies
clt <- Eff es Cookies
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
clientSessionCookies
  Cookies
req <- Eff es Cookies
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
requestSessionCookies
  Cookies -> Eff es Cookies
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cookies -> Eff es Cookies) -> Cookies -> Eff es Cookies
forall a b. (a -> b) -> a -> b
$ Cookies
clt Cookies -> Cookies -> Cookies
forall a. Semigroup a => a -> a -> a
<> Cookies
req


-- | Return the session from the Client cookies
clientSessionCookies :: (Hyperbole :> es) => Eff es Cookies
clientSessionCookies :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
clientSessionCookies = do
  (.session) (Client -> Cookies) -> Eff es Client -> Eff es Cookies
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


-- | Return the session from the 'Request' cookies
requestSessionCookies :: (Hyperbole :> es) => Eff es Cookies
requestSessionCookies :: forall (es :: [Effect]). (Hyperbole :> es) => Eff es Cookies
requestSessionCookies = do
  (.cookies) (Request -> Cookies) -> Eff es Request -> Eff es Cookies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es Request
forall (es :: [Effect]). (Hyperbole :> es) => Eff es Request
request