Internal.hs

{-# LANGUAGE FlexibleContexts, Rank2Types, TemplateHaskell, OverloadedStrings #-}
module SecondTransfer.Sessions.Internal where

import SecondTransfer.Sessions.Config


import           Control.Concurrent.MVar (MVar, newMVar,modifyMVar)
-- import           Control.Exception       (SomeException)
import qualified Control.Exception       as E
import           Control.Lens            ((^.), makeLenses, Lens' )


--import           System.Log.Logger



-- | Contains information that applies to all sessions created in the program.
--  Use the lenses interface to access members of this struct.
--
-- TODO: members of this record should be renamed to the "suffix" convention.
data SessionsContext = SessionsContext {
    -- | Read-only configuration information passed-in at construction time
     _sessionsConfig  :: SessionsConfig
    -- | MVar with enumerator for sessions
    ,_nextSessionId   :: MVar Int
    }


makeLenses ''SessionsContext


sessionsConfig_Sctx :: Lens' SessionsContext SessionsConfig
sessionsConfig_Sctx = sessionsConfig


nextSessionId_Sctx ::  Lens' SessionsContext (MVar Int)
nextSessionId_Sctx = nextSessionId


-- Session tags are simple session identifiers
acquireNewSessionTag :: SessionsContext -> IO Int
acquireNewSessionTag sessions_context =
    modifyMVar
        (sessions_context ^. nextSessionId )
        (\ next_id -> return (next_id+1, next_id))


-- Adds runtime data to a context, and let it work....
makeSessionsContext :: SessionsConfig -> IO SessionsContext
makeSessionsContext sessions_config = do
    next_session_id_mvar <- newMVar 1
    return  SessionsContext {
        _sessionsConfig = sessions_config,
        _nextSessionId = next_session_id_mvar
        }


makeDefaultSessionsContext :: IO SessionsContext
makeDefaultSessionsContext = makeSessionsContext defaultSessionsConfig

sessionExceptionHandler ::
    E.Exception e => SessionComponent -> Int -> SessionsContext -> e -> IO ()
sessionExceptionHandler session_component session_id sessions_context e =
    let

        getit = ( sessionsConfig . sessionsCallbacks . reportErrorCallback_SC )
        maybe_error_callback = sessions_context ^. getit
        --component_tag = "Session." ++ show session_component
        error_tuple = (
            session_component,
            SessionCoordinates session_id,
            E.toException e
            )
    in case maybe_error_callback of
        Nothing ->
            -- errorM component_tag (show e)
            -- When no callback, ignore the exception
            return ()

        Just callback ->
            callback error_tuple