Commit fdacfc1d authored by Michael Hanus's avatar Michael Hanus
Browse files

Type `SessionStore` renamed `SessionData` and `GlobalSessionStore` to `SessionStore`

parent 8b6eec46
...@@ -9,9 +9,8 @@ import HTML.Base ...@@ -9,9 +9,8 @@ import HTML.Base
import HTML.Session import HTML.Session
--- The data stored in the session is the number of guesses. --- The data stored in the session is the number of guesses.
--trials :: GlobalP (SessionStore Int) trials :: SessionStore Int
trials :: GlobalSessionStore Int trials = sessionStore "trials"
trials = globalSessionData "trials"
guessForm :: HtmlFormDef Int guessForm :: HtmlFormDef Int
guessForm = formDef (getSessionData trials 1) guessFormHtml guessForm = formDef (getSessionData trials 1) guessFormHtml
......
...@@ -10,8 +10,8 @@ import HTML.Base ...@@ -10,8 +10,8 @@ import HTML.Base
import HTML.Session import HTML.Session
--- The data stored in a session is the string typed into the input field. --- The data stored in a session is the string typed into the input field.
rdInput :: GlobalSessionStore String rdInput :: SessionStore String
rdInput = globalSessionData "rdInput" rdInput = sessionStore "rdInput"
-- Example: a form with a text input field and two submit buttons. -- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String revDupForm :: HtmlFormDef String
......
...@@ -7,13 +7,13 @@ ...@@ -7,13 +7,13 @@
--- to hold some session-specific data. --- to hold some session-specific data.
--- ---
--- @author Michael Hanus --- @author Michael Hanus
--- @version April 2021 --- @version May 2021
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
module HTML.Session module HTML.Session
( sessionDataDir, inSessionDataDir ( sessionDataDir, inSessionDataDir
, sessionCookie, doesSessionExist, withSessionCookie, withSessionCookieInfo , sessionCookie, doesSessionExist, withSessionCookie, withSessionCookieInfo
, SessionStore, emptySessionStore, GlobalSessionStore, globalSessionData , SessionData, emptySessionData, SessionStore, sessionStore
, getSessionMaybeData, getSessionData , getSessionMaybeData, getSessionData
, putSessionData, removeSessionData, modifySessionData , putSessionData, removeSessionData, modifySessionData
) where ) where
...@@ -155,35 +155,37 @@ cookieInfoPage = do ...@@ -155,35 +155,37 @@ cookieInfoPage = do
, bold [href ('?' : urlparam) [htxt "please click here."]]]] , bold [href ('?' : urlparam) [htxt "please click here."]]]]
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Implementation of session stores. -- Implementation of session data and stores.
--- The type of a session store that holds particular data used in a session. --- The type of session data which represents the data used in a session.
--- A session store consists of a list of data items for each session in the --- The session data consists of a list of data items for each session in the
--- system together with the clock time of the last access. --- system together with the clock time of the last access.
--- The clock time is used to remove old data in the store. --- The clock time is used to remove old data in the store.
data SessionStore a = SessionStore [(SessionId, Int, a)] data SessionData a = SessionData [(SessionId, Int, a)]
deriving (Read,Show) deriving (Read,Show)
--- An initial value for the empty session store. --- An initial value for the empty session data.
emptySessionStore :: SessionStore _ emptySessionData :: SessionData _
emptySessionStore = SessionStore [] emptySessionData = SessionData []
--- A global session store is a persistent global entity containing --- The type of a session store is a persistent global entity containing
--- a session store with some data. --- a session store with some data.
type GlobalSessionStore a = GlobalP (SessionStore a) type SessionStore a = GlobalP (SessionData a)
globalSessionData :: (Read a, Show a) => String -> GlobalSessionStore a --- A session store contains readable and showable data kept in
globalSessionData name = --- a store with a given name. The name is used as a file name
globalPersistent (inSessionDataDir name) emptySessionStore --- in the directory containing all session data.
sessionStore :: (Read a, Show a) => String -> SessionStore a
sessionStore name = globalPersistent (inSessionDataDir name) emptySessionData
--- Retrieves data for the current user session stored in a session store. --- Retrieves data for the current user session stored in a session store.
--- Returns `Nothing` if there is no data for the current session. --- Returns `Nothing` if there is no data for the current session.
getSessionMaybeData :: (Read a, Show a) => getSessionMaybeData :: (Read a, Show a) =>
GlobalSessionStore a -> FormReader (Maybe a) SessionStore a -> FormReader (Maybe a)
getSessionMaybeData sessionData = toFormReader $ do getSessionMaybeData sessionData = toFormReader $ do
ensureSessionDataDir ensureSessionDataDir
sid <- getSessionId sid <- getSessionId
SessionStore sdata <- safeReadGlobalP sessionData emptySessionStore SessionData sdata <- safeReadGlobalP sessionData emptySessionData
return (findInSession sid sdata) return (findInSession sid sdata)
where where
findInSession si ((id, _, storedData):rest) = findInSession si ((id, _, storedData):rest) =
...@@ -196,44 +198,44 @@ getSessionMaybeData sessionData = toFormReader $ do ...@@ -196,44 +198,44 @@ getSessionMaybeData sessionData = toFormReader $ do
--- where the second argument is returned if there is no data --- where the second argument is returned if there is no data
--- for the current session. --- for the current session.
getSessionData :: (Read a, Show a) => getSessionData :: (Read a, Show a) =>
GlobalSessionStore a -> a -> FormReader a SessionStore a -> a -> FormReader a
getSessionData sessiondata defaultdata = getSessionData sessiondata defaultdata =
fmap (fromMaybe defaultdata) (getSessionMaybeData sessiondata) fmap (fromMaybe defaultdata) (getSessionMaybeData sessiondata)
--- Stores data related to the current user session in a session store. --- Stores data related to the current user session in a session store.
putSessionData :: (Read a, Show a) => GlobalSessionStore a -> a -> IO () putSessionData :: (Read a, Show a) => SessionStore a -> a -> IO ()
putSessionData sessionData newData = do putSessionData sessionData newData = do
ensureSessionDataDir ensureSessionDataDir
sid <- getSessionId sid <- getSessionId
SessionStore sdata <- safeReadGlobalP sessionData emptySessionStore SessionData sdata <- safeReadGlobalP sessionData emptySessionData
currentTime <- getClockTime currentTime <- getClockTime
case findIndex (\ (id, _, _) -> id == sid) sdata of case findIndex (\ (id, _, _) -> id == sid) sdata of
Just i -> Just i ->
writeGlobalP sessionData writeGlobalP sessionData
(SessionStore (replace (sid, clockTimeToInt currentTime, newData) i (SessionData (replace (sid, clockTimeToInt currentTime, newData) i
(cleanup currentTime sdata))) (cleanup currentTime sdata)))
Nothing -> Nothing ->
writeGlobalP sessionData writeGlobalP sessionData
(SessionStore ((sid, clockTimeToInt currentTime, newData) (SessionData ((sid, clockTimeToInt currentTime, newData)
: cleanup currentTime sdata)) : cleanup currentTime sdata))
--- Modifies the data of the current user session. --- Modifies the data of the current user session.
modifySessionData :: (Read a, Show a) => modifySessionData :: (Read a, Show a) =>
GlobalSessionStore a -> a -> (a -> a) -> IO () SessionStore a -> a -> (a -> a) -> IO ()
modifySessionData sessiondata defaultdata upd = do modifySessionData sessiondata defaultdata upd = do
sd <- fromFormReader $ getSessionData sessiondata defaultdata sd <- fromFormReader $ getSessionData sessiondata defaultdata
putSessionData sessiondata (upd sd) putSessionData sessiondata (upd sd)
--- Removes data related to the current user session from a session store. --- Removes data related to the current user session from a session store.
removeSessionData :: (Read a, Show a) => GlobalSessionStore a -> IO () removeSessionData :: (Read a, Show a) => SessionStore a -> IO ()
removeSessionData sessionData = do removeSessionData sessionData = do
ensureSessionDataDir ensureSessionDataDir
sid <- getSessionId sid <- getSessionId
SessionStore sdata <- safeReadGlobalP sessionData emptySessionStore SessionData sdata <- safeReadGlobalP sessionData emptySessionData
currentTime <- getClockTime currentTime <- getClockTime
writeGlobalP sessionData writeGlobalP sessionData
(SessionStore (filter (\ (id, _, _) -> id /= sid) (SessionData (filter (\ (id, _, _) -> id /= sid)
(cleanup currentTime sdata))) (cleanup currentTime sdata)))
-- expects that clockTimeToInt converts time into ascending integers! -- expects that clockTimeToInt converts time into ascending integers!
-- we should write our own conversion-function -- we should write our own conversion-function
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment