{-# LANGUAGE FlexibleContexts #-}

module IAFinance.Environment.Context(
    Has(..),
    EnvContext,
    Context,
    insert,
    select,
    remove
) where

-----------------------------------------------------------------------------
-- import

import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Control.Monad.Reader (MonadReader, MonadIO, ask, liftIO)
import Control.Concurrent.Async.Lifted.Safe ()
import Control.Concurrent (MVar, newMVar)
import Control.Concurrent.STM (atomically, modifyTVar', readTVarIO)

import qualified IAFinance.Environment.Config as Cfg
import IAFinance.Server.Data.State (State(..))
import IAFinance.Environment.Config (ServerConfig(..), SessionConfig(..))
import IAFinance.Environment.Internal (
    Has(..),
    EnvContext,
    Context,
    EnvConfig,
    Config(..))

-----------------------------------------------------------------------------
-- Context

insert :: (MonadReader a m, Has EnvConfig a, Has EnvContext a, MonadIO m)
       => Text -> m (Maybe (MVar State))
insert k = release >>= \ok ->
    if ok then do
        s <- io $ newMVar Idle
        t <- io $ timestamp
        modify $ Map.insert k (t, s)
        pure $ Just s
    else
        pure Nothing

select :: (MonadReader env m, Has EnvContext env, MonadIO m)
       => Text -> m (Maybe (MVar State))
select k = do
    t <- io $ timestamp
    modify $ Map.adjust (\p -> (t, snd p)) k
    get >>= pure . maybe Nothing (Just . snd) . Map.lookup k

remove :: (MonadReader env m, Has EnvContext env, MonadIO m)
       => Text -> m ()
remove k = modify $ Map.update (const Nothing) k

-----------------------------------------------------------------------------
-- helper

release :: (MonadReader a m, Has EnvConfig a, Has EnvContext a, MonadIO m)
         => m Bool
release = do
    c <- session <$> base <$> Cfg.get
    t <- (+) (toInteger $ timeout c) <$> (io timestamp)
    modify . Map.filter $ (< t) . fst
    let s = capacity c
    (< s) <$> Map.size <$> get

modify :: (MonadReader env m, Has EnvContext env, MonadIO m)
       => (Context -> Context) -> m ()
modify f = ask >>= \env -> io . atomically . flip modifyTVar' f . member $env

get :: (MonadReader env m, Has EnvContext env, MonadIO m)
    => m Context
get = ask >>= \env -> io . readTVarIO . member $ env

io :: (MonadIO m) => IO a -> m a
io = liftIO

timestamp :: IO Integer
timestamp = (round . (* 1000)) <$> getPOSIXTime

{-

[Is the whole Map copied when a new binding is inserted?]
(https://stackoverflow.com/a/10003037)

-}
