{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.Data.Session where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.String.Conversions (cs)
import Data.Text (Text)
import GHC.Generics
import Web.Hyperbole.Data.QueryData (Param (..), ParamValue (..), ToParam (..))
import Web.View.Types.Url (Segment)


data Cookie = Cookie
  { Cookie -> Param
key :: Param
  , Cookie -> Maybe ParamValue
value :: Maybe ParamValue
  , Cookie -> Maybe [Segment]
path :: Maybe [Segment]
  }
  deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)
newtype Cookies = Cookies (Map Param Cookie)
  deriving newtype (Semigroup Cookies
Cookies
Semigroup Cookies =>
Cookies
-> (Cookies -> Cookies -> Cookies)
-> ([Cookies] -> Cookies)
-> Monoid Cookies
[Cookies] -> Cookies
Cookies -> Cookies -> Cookies
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Cookies
mempty :: Cookies
$cmappend :: Cookies -> Cookies -> Cookies
mappend :: Cookies -> Cookies -> Cookies
$cmconcat :: [Cookies] -> Cookies
mconcat :: [Cookies] -> Cookies
Monoid, NonEmpty Cookies -> Cookies
Cookies -> Cookies -> Cookies
(Cookies -> Cookies -> Cookies)
-> (NonEmpty Cookies -> Cookies)
-> (forall b. Integral b => b -> Cookies -> Cookies)
-> Semigroup Cookies
forall b. Integral b => b -> Cookies -> Cookies
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Cookies -> Cookies -> Cookies
<> :: Cookies -> Cookies -> Cookies
$csconcat :: NonEmpty Cookies -> Cookies
sconcat :: NonEmpty Cookies -> Cookies
$cstimes :: forall b. Integral b => b -> Cookies -> Cookies
stimes :: forall b. Integral b => b -> Cookies -> Cookies
Semigroup, Int -> Cookies -> ShowS
[Cookies] -> ShowS
Cookies -> String
(Int -> Cookies -> ShowS)
-> (Cookies -> String) -> ([Cookies] -> ShowS) -> Show Cookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookies -> ShowS
showsPrec :: Int -> Cookies -> ShowS
$cshow :: Cookies -> String
show :: Cookies -> String
$cshowList :: [Cookies] -> ShowS
showList :: [Cookies] -> ShowS
Show, Cookies -> Cookies -> Bool
(Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool) -> Eq Cookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookies -> Cookies -> Bool
== :: Cookies -> Cookies -> Bool
$c/= :: Cookies -> Cookies -> Bool
/= :: Cookies -> Cookies -> Bool
Eq)


insert :: Cookie -> Cookies -> Cookies
insert :: Cookie -> Cookies -> Cookies
insert Cookie
cookie (Cookies Map Param Cookie
m) =
  Map Param Cookie -> Cookies
Cookies (Map Param Cookie -> Cookies) -> Map Param Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ Param -> Cookie -> Map Param Cookie -> Map Param Cookie
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Cookie
cookie.key Cookie
cookie Map Param Cookie
m


delete :: Param -> Cookies -> Cookies
delete :: Param -> Cookies -> Cookies
delete Param
key (Cookies Map Param Cookie
m) =
  Map Param Cookie -> Cookies
Cookies (Map Param Cookie -> Cookies) -> Map Param Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ Param -> Map Param Cookie -> Map Param Cookie
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Param
key Map Param Cookie
m



lookup :: Param -> Cookies -> Maybe ParamValue
lookup :: Param -> Cookies -> Maybe ParamValue
lookup Param
key (Cookies Map Param Cookie
m) = do
  Cookie
cook <- Param -> Map Param Cookie -> Maybe Cookie
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Param
key Map Param Cookie
m
  Cookie
cook.value


deletedCookie :: forall a. (Session a) => Cookie
deletedCookie :: forall a. Session a => Cookie
deletedCookie =
  Param -> Maybe ParamValue -> Maybe [Segment] -> Cookie
Cookie (forall a. Session a => Param
sessionKey @a) Maybe ParamValue
forall a. Maybe a
Nothing (forall a. Session a => Maybe [Segment]
cookiePath @a)


sessionCookie :: forall a. (Session a, ToParam a) => a -> Cookie
sessionCookie :: forall a. (Session a, ToParam a) => a -> Cookie
sessionCookie a
a = Param -> Maybe ParamValue -> Maybe [Segment] -> Cookie
Cookie (forall a. Session a => Param
sessionKey @a) (ParamValue -> Maybe ParamValue
forall a. a -> Maybe a
Just (ParamValue -> Maybe ParamValue) -> ParamValue -> Maybe ParamValue
forall a b. (a -> b) -> a -> b
$ a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a) (forall a. Session a => Maybe [Segment]
cookiePath @a)


fromList :: [Cookie] -> Cookies
fromList :: [Cookie] -> Cookies
fromList [Cookie]
cks = Map Param Cookie -> Cookies
Cookies (Map Param Cookie -> Cookies) -> Map Param Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ [(Param, Cookie)] -> Map Param Cookie
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Cookie -> (Param, Cookie)) -> [Cookie] -> [(Param, Cookie)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> (Param, Cookie)
forall {b} {a}. HasField "key" b a => b -> (a, b)
keyValue [Cookie]
cks)
 where
  keyValue :: b -> (a, b)
keyValue b
c = (b
c.key, b
c)


toList :: Cookies -> [Cookie]
toList :: Cookies -> [Cookie]
toList (Cookies Map Param Cookie
m) = Map Param Cookie -> [Cookie]
forall k a. Map k a -> [a]
M.elems Map Param Cookie
m


{- | Configure a data type to persist in the 'session'

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

instance 'DefaultParam' Preferences where
  defaultParam = Preferences White
@
-}
class Session a where
  -- | Unique key for the Session. Defaults to the datatypeName
  sessionKey :: Param
  default sessionKey :: (Generic a, GDatatypeName (Rep a)) => Param
  sessionKey = Segment -> Param
Param (Segment -> Param) -> Segment -> Param
forall a b. (a -> b) -> a -> b
$ Rep a Any -> Segment
forall p. Rep a p -> Segment
forall {k} (f :: k -> *) (p :: k).
GDatatypeName f =>
f p -> Segment
gDatatypeName (Rep a Any -> Segment) -> Rep a Any -> Segment
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a
forall a. HasCallStack => a
undefined :: a)


  -- | By default Sessions are persisted only to the current page. Set this to `Just []` to make an application-wide Session
  cookiePath :: Maybe [Segment]
  default cookiePath :: Maybe [Segment]
  cookiePath = Maybe [Segment]
forall a. Maybe a
Nothing


-- | generic datatype name
class GDatatypeName f where
  gDatatypeName :: f p -> Text


instance (Datatype d) => GDatatypeName (M1 D d f) where
  gDatatypeName :: forall (p :: k). M1 D d f p -> Segment
gDatatypeName M1 D d f p
_ =
    String -> Segment
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Segment) -> String -> Segment
forall a b. (a -> b) -> a -> b
$ M1 D d f Any -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> String
datatypeName (M1 D d f p
forall {p :: k}. M1 D d f p
forall a. HasCallStack => a
undefined :: M1 D d f p)