content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE DefaultSignatures #-}
  
  module Web.Hyperbole.Effect.Session where
  
  import Data.Default (Default (..))
  import Data.Maybe (fromMaybe)
  import Data.String.Conversions (cs)
  import Data.Text (Text)
  import Effectful
  import Effectful.Dispatch.Dynamic
  import GHC.Generics
  import Web.Hyperbole.Data.Cookie as Cookie
  import Web.Hyperbole.Data.Encoded as Encoded
  import Web.Hyperbole.Data.Param
  import Web.Hyperbole.Data.URI (Path)
  import Web.Hyperbole.Effect.Hyperbole (Hyperbole (..))
  import Web.Hyperbole.Effect.Request (request)
  import Web.Hyperbole.Types.Client (Client (..), clientModCookies)
  import Web.Hyperbole.Types.Request
  import Web.Hyperbole.Types.Response
  
  
  {- | Configure a data type to persist in the 'session' as a cookie. These are type-indexed, so only one of each can exist in the session
  
  @
  #EMBED Example/Docs/Sessions.hs data Preferences
  
  #EMBED Example/Docs/Sessions.hs instance Default Preferences
  @
  -}
  class Session a where
    -- | Unique key for this Session Type. Defaults to the datatypeName
    sessionKey :: Key
    default sessionKey :: (Generic a, GDatatypeName (Rep a)) => Key
    sessionKey = gDatatypeName $ from (undefined :: a)
  
  
    -- | By default Sessions are persisted only to the current page. Set to `Just "/"` to make an instance available application-wide
    cookiePath :: Maybe Path
    default cookiePath :: Maybe Path
    cookiePath = Nothing
  
  
    -- | Encode type to a a cookie value
    toCookie :: a -> CookieValue
    default toCookie :: (ToEncoded a) => a -> CookieValue
    toCookie = CookieValue . cs . Encoded.encode
  
  
    -- | Decode from a cookie value. Defaults to FromJSON
    parseCookie :: CookieValue -> Either String a
    default parseCookie :: (FromEncoded a) => CookieValue -> Either String a
    parseCookie (CookieValue bs) = do
      Encoded.decodeEither (cs bs)
  
  
  {- | Load data from a browser cookie. If it doesn't exist, the 'Default' instance is used
  
  @
  #EMBED Example/Docs/Sessions.hs data Preferences
  
  #EMBED Example/Docs/Sessions.hs instance Default Preferences
  
  #EMBED Example/Docs/Sessions.hs page
  @
  -}
  session :: (Session a, Default a, Hyperbole :> es) => Eff es a
  session = do
    ms <- lookupSession
    pure $ fromMaybe def ms
  
  
  -- | Return a session if it exists
  lookupSession :: forall a es. (Session a, Hyperbole :> es) => Eff es (Maybe a)
  lookupSession = do
    let key = sessionKey @a
    mck <- Cookie.lookup key <$> sessionCookies
    case mck of
      Nothing -> pure Nothing
      Just val -> Just <$> parseSession key val
  
  
  {- | Persist datatypes in browser cookies
  
  @
  #EMBED Example/Docs/Sessions.hs data Preferences
  
  #EMBED Example/Docs/Sessions.hs instance Default Preferences
  
  #EMBED Example/Docs/Sessions.hs instance HyperView Content
  @
  -}
  saveSession :: forall a es. (Session a, Hyperbole :> es) => a -> Eff es ()
  saveSession a = do
    modifyCookies $ Cookie.insert $ sessionCookie a
  
  
  modifySession :: (Session a, Default a, Hyperbole :> es) => (a -> a) -> Eff es a
  modifySession f = do
    s <- session
    let updated = f s
    saveSession updated
    pure updated
  
  
  modifySession_ :: (Session a, Default a, Hyperbole :> es) => (a -> a) -> Eff es ()
  modifySession_ f = do
    _ <- modifySession f
    pure ()
  
  
  -- | Remove a single 'Session' from the browser cookies
  deleteSession :: forall a es. (Session a, Hyperbole :> es) => Eff es ()
  deleteSession = do
    let cookie = Cookie (sessionKey @a) (cookiePath @a) Nothing
    modifyCookies $ Cookie.insert cookie
  
  
  parseSession :: (Session a, Hyperbole :> es) => Key -> CookieValue -> Eff es a
  parseSession prm cook = do
    case parseCookie cook of
      Left e -> send $ RespondNow $ Err $ ErrSession prm e
      Right a -> pure a
  
  
  -- | save a single datatype to a specific key in the session
  setCookie :: (ToParam a, Hyperbole :> es) => Cookie -> Eff es ()
  setCookie ck = do
    modifyCookies (Cookie.insert ck)
  
  
  -- | Modify the client cookies
  modifyCookies :: (Hyperbole :> es) => (Cookies -> Cookies) -> Eff es ()
  modifyCookies f =
    send $ ModClient $ clientModCookies f
  
  
  -- | Return all the cookies, both those sent in the request and others added by the page
  sessionCookies :: (Hyperbole :> es) => Eff es Cookies
  sessionCookies = do
    clt <- clientSessionCookies
    req <- requestSessionCookies
    pure $ clt <> req
  
  
  -- | Return the session from the Client cookies
  clientSessionCookies :: (Hyperbole :> es) => Eff es Cookies
  clientSessionCookies = do
    (.session) <$> send GetClient
  
  
  -- | Return the session from the 'Request' cookies
  requestSessionCookies :: (Hyperbole :> es) => Eff es Cookies
  requestSessionCookies = do
    (.cookies) <$> request
  
  
  sessionCookie :: forall a. (Session a) => a -> Cookie
  sessionCookie a =
    Cookie (sessionKey @a) (cookiePath @a) (Just $ toCookie a)
  
  
  -- | generic datatype name
  genericTypeName :: forall a. (Generic a, GDatatypeName (Rep a)) => Text
  genericTypeName =
    gDatatypeName $ from (undefined :: a)
  
  
  class GDatatypeName f where
    gDatatypeName :: f p -> Text
  
  
  instance (Datatype d) => GDatatypeName (M1 D d f) where
    gDatatypeName _ =
      cs $ datatypeName (undefined :: M1 D d f p)
  