module Simulation.Aivika.Trans.Resource
       (
        FCFSResource,
        LCFSResource,
        SIROResource,
        PriorityResource,
        Resource,
        
        newFCFSResource,
        newFCFSResourceWithMaxCount,
        newLCFSResource,
        newLCFSResourceWithMaxCount,
        newSIROResource,
        newSIROResourceWithMaxCount,
        newPriorityResource,
        newPriorityResourceWithMaxCount,
        newResource,
        newResourceWithMaxCount,
        
        resourceStrategy,
        resourceMaxCount,
        resourceCount,
        resourceCountStats,
        resourceUtilisationCount,
        resourceUtilisationCountStats,
        resourceQueueCount,
        resourceQueueCountStats,
        resourceTotalWaitTime,
        resourceWaitTime,
        
        requestResource,
        requestResourceWithPriority,
        tryRequestResourceWithinEvent,
        releaseResource,
        releaseResourceWithinEvent,
        usingResource,
        usingResourceWithPriority,
        
        incResourceCount,
        decResourceCount,
        
        resourceCountChanged,
        resourceCountChanged_,
        resourceUtilisationCountChanged,
        resourceUtilisationCountChanged_,
        resourceQueueCountChanged,
        resourceQueueCountChanged_,
        resourceWaitTimeChanged,
        resourceWaitTimeChanged_,
        resourceChanged_) where
import Data.Monoid
import Control.Monad
import Control.Monad.Trans
import Control.Exception
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Cont
import Simulation.Aivika.Trans.Internal.Process
import Simulation.Aivika.Trans.QueueStrategy
import Simulation.Aivika.Trans.Statistics
import Simulation.Aivika.Trans.Signal
type FCFSResource m = Resource m FCFS
type LCFSResource m = Resource m LCFS
type SIROResource m = Resource m SIRO
type PriorityResource m = Resource m StaticPriorities
data Resource m s = 
  Resource { resourceStrategy :: s,
             
             resourceMaxCount :: Maybe Int,
             
             
             resourceCountRef :: Ref m Int,
             resourceCountStatsRef :: Ref m (TimingStats Int),
             resourceCountSource :: SignalSource m Int,
             resourceUtilisationCountRef :: Ref m Int,
             resourceUtilisationCountStatsRef :: Ref m (TimingStats Int),
             resourceUtilisationCountSource :: SignalSource m Int,
             resourceQueueCountRef :: Ref m Int,
             resourceQueueCountStatsRef :: Ref m (TimingStats Int),
             resourceQueueCountSource :: SignalSource m Int,
             resourceTotalWaitTimeRef :: Ref m Double,
             resourceWaitTimeRef :: Ref m (SamplingStats Double),
             resourceWaitTimeSource :: SignalSource m (),
             resourceWaitList :: StrategyQueue m s (ResourceItem m) }
data ResourceItem m =
  ResourceItem { resourceItemTime :: Double,
                 resourceItemCont :: FrozenCont m () }
newFCFSResource :: MonadDES m
                   => Int
                   
                   -> Event m (FCFSResource m)
newFCFSResource = newResource FCFS
newFCFSResourceWithMaxCount :: MonadDES m
                               => Int
                               
                               -> Maybe Int
                               
                               -> Event m (FCFSResource m)
newFCFSResourceWithMaxCount = newResourceWithMaxCount FCFS
newLCFSResource :: MonadDES m
                   => Int
                   
                   -> Event m (LCFSResource m)
newLCFSResource = newResource LCFS
newLCFSResourceWithMaxCount :: MonadDES m
                               => Int
                               
                               -> Maybe Int
                               
                               -> Event m (LCFSResource m)
newLCFSResourceWithMaxCount = newResourceWithMaxCount LCFS
newSIROResource :: (MonadDES m, QueueStrategy m SIRO)
                   => Int
                   
                   -> Event m (SIROResource m)
newSIROResource = newResource SIRO
newSIROResourceWithMaxCount :: (MonadDES m, QueueStrategy m SIRO)
                               => Int
                               
                               -> Maybe Int
                               
                               -> Event m (SIROResource m)
newSIROResourceWithMaxCount = newResourceWithMaxCount SIRO
newPriorityResource :: (MonadDES m, QueueStrategy m StaticPriorities)
                       => Int
                       
                       -> Event m (PriorityResource m)
newPriorityResource = newResource StaticPriorities
newPriorityResourceWithMaxCount :: (MonadDES m, QueueStrategy m StaticPriorities)
                                   => Int
                                   
                                   -> Maybe Int
                                   
                                   -> Event m (PriorityResource m)
newPriorityResourceWithMaxCount = newResourceWithMaxCount StaticPriorities
newResource :: (MonadDES m, QueueStrategy m s)
               => s
               
               -> Int
               
               -> Event m (Resource m s)
newResource s count =
  newResourceWithMaxCount s count (Just count)
newResourceWithMaxCount :: (MonadDES m, QueueStrategy m s)
                           => s
                           
                           -> Int
                           
                           -> Maybe Int
                           
                           -> Event m (Resource m s)
newResourceWithMaxCount s count maxCount =
  Event $ \p ->
  do let r = pointRun p
         t = pointTime p
     when (count < 0) $
       throwComp $
       SimulationRetry $
       "The resource count cannot be negative: " ++
       "newResourceWithMaxCount."
     case maxCount of
       Just maxCount | count > maxCount ->
         throwComp $
         SimulationRetry $
         "The resource count cannot be greater than " ++
         "its maximum value: newResourceWithMaxCount."
       _ ->
         return ()
     countRef <- invokeSimulation r $ newRef count
     countStatsRef <- invokeSimulation r $ newRef $ returnTimingStats t count
     countSource <- invokeSimulation r newSignalSource
     utilCountRef <- invokeSimulation r $ newRef 0
     utilCountStatsRef <- invokeSimulation r $ newRef $ returnTimingStats t 0
     utilCountSource <- invokeSimulation r newSignalSource
     queueCountRef <- invokeSimulation r $ newRef 0
     queueCountStatsRef <- invokeSimulation r $ newRef $ returnTimingStats t 0
     queueCountSource <- invokeSimulation r newSignalSource
     totalWaitTimeRef <- invokeSimulation r $ newRef 0
     waitTimeRef <- invokeSimulation r $ newRef emptySamplingStats
     waitTimeSource <- invokeSimulation r newSignalSource
     waitList <- invokeSimulation r $ newStrategyQueue s
     return Resource { resourceStrategy = s,
                       resourceMaxCount = maxCount,
                       resourceCountRef = countRef,
                       resourceCountStatsRef = countStatsRef,
                       resourceCountSource = countSource,
                       resourceUtilisationCountRef = utilCountRef,
                       resourceUtilisationCountStatsRef = utilCountStatsRef,
                       resourceUtilisationCountSource = utilCountSource,
                       resourceQueueCountRef = queueCountRef,
                       resourceQueueCountStatsRef = queueCountStatsRef,
                       resourceQueueCountSource = queueCountSource,
                       resourceTotalWaitTimeRef = totalWaitTimeRef,
                       resourceWaitTimeRef = waitTimeRef,
                       resourceWaitTimeSource = waitTimeSource,
                       resourceWaitList = waitList }
resourceCount :: MonadDES m => Resource m s -> Event m Int
resourceCount r =
  Event $ \p -> invokeEvent p $ readRef (resourceCountRef r)
resourceCountStats :: MonadDES m => Resource m s -> Event m (TimingStats Int)
resourceCountStats r =
  Event $ \p -> invokeEvent p $ readRef (resourceCountStatsRef r)
resourceCountChanged :: MonadDES m => Resource m s -> Signal m Int
resourceCountChanged r =
  publishSignal $ resourceCountSource r
resourceCountChanged_ :: MonadDES m => Resource m s -> Signal m ()
resourceCountChanged_ r =
  mapSignal (const ()) $ resourceCountChanged r
resourceUtilisationCount :: MonadDES m => Resource m s -> Event m Int
resourceUtilisationCount r =
  Event $ \p -> invokeEvent p $ readRef (resourceUtilisationCountRef r)
resourceUtilisationCountStats :: MonadDES m => Resource m s -> Event m (TimingStats Int)
resourceUtilisationCountStats r =
  Event $ \p -> invokeEvent p $ readRef (resourceUtilisationCountStatsRef r)
resourceUtilisationCountChanged :: MonadDES m => Resource m s -> Signal m Int
resourceUtilisationCountChanged r =
  publishSignal $ resourceUtilisationCountSource r
resourceUtilisationCountChanged_ :: MonadDES m => Resource m s -> Signal m ()
resourceUtilisationCountChanged_ r =
  mapSignal (const ()) $ resourceUtilisationCountChanged r
resourceQueueCount :: MonadDES m => Resource m s -> Event m Int
resourceQueueCount r =
  Event $ \p -> invokeEvent p $ readRef (resourceQueueCountRef r)
resourceQueueCountStats :: MonadDES m => Resource m s -> Event m (TimingStats Int)
resourceQueueCountStats r =
  Event $ \p -> invokeEvent p $ readRef (resourceQueueCountStatsRef r)
resourceQueueCountChanged :: MonadDES m => Resource m s -> Signal m Int
resourceQueueCountChanged r =
  publishSignal $ resourceQueueCountSource r
resourceQueueCountChanged_ :: MonadDES m => Resource m s -> Signal m ()
resourceQueueCountChanged_ r =
  mapSignal (const ()) $ resourceQueueCountChanged r
resourceTotalWaitTime :: MonadDES m => Resource m s -> Event m Double
resourceTotalWaitTime r =
  Event $ \p -> invokeEvent p $ readRef (resourceTotalWaitTimeRef r)
resourceWaitTime :: MonadDES m => Resource m s -> Event m (SamplingStats Double)
resourceWaitTime r =
  Event $ \p -> invokeEvent p $ readRef (resourceWaitTimeRef r)
resourceWaitTimeChanged :: MonadDES m => Resource m s -> Signal m (SamplingStats Double)
resourceWaitTimeChanged r =
  mapSignalM (\() -> resourceWaitTime r) $ resourceWaitTimeChanged_ r
resourceWaitTimeChanged_ :: MonadDES m => Resource m s -> Signal m ()
resourceWaitTimeChanged_ r =
  publishSignal $ resourceWaitTimeSource r
requestResource :: (MonadDES m, EnqueueStrategy m s)
                   => Resource m s
                   
                   -> Process m ()
requestResource r =
  Process $ \pid ->
  Cont $ \c ->
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceCountRef r)
     if a == 0 
       then do c <- invokeEvent p $
                    freezeContReentering c () $
                    invokeCont c $
                    invokeProcess pid $
                    requestResource r
               invokeEvent p $
                 strategyEnqueue (resourceWaitList r) $
                 ResourceItem (pointTime p) c
               invokeEvent p $ updateResourceQueueCount r 1
       else do invokeEvent p $ updateResourceWaitTime r 0
               invokeEvent p $ updateResourceCount r (1)
               invokeEvent p $ updateResourceUtilisationCount r 1
               invokeEvent p $ resumeCont c ()
requestResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
                               => Resource m s
                               
                               -> p
                               
                               -> Process m ()
requestResourceWithPriority r priority =
  Process $ \pid ->
  Cont $ \c ->
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceCountRef r)
     if a == 0 
       then do c <- invokeEvent p $
                    freezeContReentering c () $
                    invokeCont c $
                    invokeProcess pid $
                    requestResourceWithPriority r priority
               invokeEvent p $
                 strategyEnqueueWithPriority (resourceWaitList r) priority $
                 ResourceItem (pointTime p) c
               invokeEvent p $ updateResourceQueueCount r 1
       else do invokeEvent p $ updateResourceWaitTime r 0
               invokeEvent p $ updateResourceCount r (1)
               invokeEvent p $ updateResourceUtilisationCount r 1
               invokeEvent p $ resumeCont c ()
releaseResource :: (MonadDES m, DequeueStrategy m s)
                   => Resource m s
                   
                   -> Process m ()
releaseResource r = 
  Process $ \_ ->
  Cont $ \c ->
  Event $ \p ->
  do invokeEvent p $ releaseResourceWithinEvent r
     invokeEvent p $ resumeCont c ()
releaseResourceWithinEvent :: (MonadDES m, DequeueStrategy m s)
                              => Resource m s
                              
                              -> Event m ()
releaseResourceWithinEvent r =
  Event $ \p ->
  do invokeEvent p $ updateResourceUtilisationCount r (1)
     invokeEvent p $ releaseResource' r
  
releaseResource' :: (MonadDES m, DequeueStrategy m s)
                    => Resource m s
                    
                    -> Event m ()
releaseResource' r =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceCountRef r)
     let a' = a + 1
     case resourceMaxCount r of
       Just maxCount | a' > maxCount ->
         throwComp $
         SimulationRetry $
         "The resource count cannot be greater than " ++
         "its maximum value: releaseResource'."
       _ ->
         return ()
     f <- invokeEvent p $
          strategyQueueNull (resourceWaitList r)
     if f 
       then invokeEvent p $ updateResourceCount r 1
       else do x <- invokeEvent p $
                    strategyDequeue (resourceWaitList r)
               invokeEvent p $ updateResourceQueueCount r (1)
               c <- invokeEvent p $ unfreezeCont (resourceItemCont x)
               case c of
                 Nothing ->
                   invokeEvent p $ releaseResource' r
                 Just c  ->
                   do invokeEvent p $ updateResourceWaitTime r (pointTime p  resourceItemTime x)
                      invokeEvent p $ updateResourceUtilisationCount r 1
                      invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c ()
tryRequestResourceWithinEvent :: MonadDES m
                                 => Resource m s
                                 
                                 -> Event m Bool
tryRequestResourceWithinEvent r =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceCountRef r)
     if a == 0 
       then return False
       else do invokeEvent p $ updateResourceWaitTime r 0
               invokeEvent p $ updateResourceCount r (1)
               invokeEvent p $ updateResourceUtilisationCount r 1
               return True
               
usingResource :: (MonadDES m, EnqueueStrategy m s)
                 => Resource m s
                 
                 -> Process m a
                 
                 -> Process m a
                 
usingResource r m =
  do requestResource r
     finallyProcess m $ releaseResource r
usingResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
                             => Resource m s
                             
                             
                             -> p
                             
                             -> Process m a
                             
                             -> Process m a
                             
usingResourceWithPriority r priority m =
  do requestResourceWithPriority r priority
     finallyProcess m $ releaseResource r
decResourceCount' :: (MonadDES m, EnqueueStrategy m s)
                     => Resource m s
                     
                     -> Process m ()
decResourceCount' r =
  do liftEvent $
       updateResourceUtilisationCount r (1)
     requestResource r
                   
incResourceCount :: (MonadDES m, DequeueStrategy m s)
                    => Resource m s
                    
                    -> Int
                    
                    -> Event m ()
incResourceCount r n
  | n < 0     = throwEvent $ SimulationRetry "The increment cannot be negative: incResourceCount"
  | n == 0    = return ()
  | otherwise =
    do releaseResource' r
       incResourceCount r (n  1)
decResourceCount :: (MonadDES m, EnqueueStrategy m s)
                    => Resource m s
                    
                    -> Int
                    
                    -> Process m ()
decResourceCount r n
  | n < 0     = throwProcess $ SimulationRetry "The decrement cannot be negative: decResourceCount"
  | n == 0    = return ()
  | otherwise =
    do decResourceCount' r
       decResourceCount r (n  1)
resourceChanged_ :: MonadDES m => Resource m s -> Signal m ()
resourceChanged_ r =
  resourceCountChanged_ r <>
  resourceUtilisationCountChanged_ r <>
  resourceQueueCountChanged_ r
updateResourceCount :: MonadDES m => Resource m s -> Int -> Event m ()
updateResourceCount r delta =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceCountRef r)
     let a' = a + delta
     a' `seq` invokeEvent p $ writeRef (resourceCountRef r) a'
     invokeEvent p $
       modifyRef (resourceCountStatsRef r) $
       addTimingStats (pointTime p) a'
     invokeEvent p $
       triggerSignal (resourceCountSource r) a'
updateResourceUtilisationCount :: MonadDES m => Resource m s -> Int -> Event m ()
updateResourceUtilisationCount r delta =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceUtilisationCountRef r)
     let a' = a + delta
     a' `seq` invokeEvent p $ writeRef (resourceUtilisationCountRef r) a'
     invokeEvent p $
       modifyRef (resourceUtilisationCountStatsRef r) $
       addTimingStats (pointTime p) a'
     invokeEvent p $
       triggerSignal (resourceUtilisationCountSource r) a'
updateResourceQueueCount :: MonadDES m => Resource m s -> Int -> Event m ()
updateResourceQueueCount r delta =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceQueueCountRef r)
     let a' = a + delta
     a' `seq` invokeEvent p $ writeRef (resourceQueueCountRef r) a'
     invokeEvent p $
       modifyRef (resourceQueueCountStatsRef r) $
       addTimingStats (pointTime p) a'
     invokeEvent p $
       triggerSignal (resourceQueueCountSource r) a'
updateResourceWaitTime :: MonadDES m => Resource m s -> Double -> Event m ()
updateResourceWaitTime r delta =
  Event $ \p ->
  do a <- invokeEvent p $ readRef (resourceTotalWaitTimeRef r)
     let a' = a + delta
     a' `seq` invokeEvent p $ writeRef (resourceTotalWaitTimeRef r) a'
     invokeEvent p $
       modifyRef (resourceWaitTimeRef r) $
       addSamplingStats delta
     invokeEvent p $
       triggerSignal (resourceWaitTimeSource r) ()