{-
 - Copyright (c) 2008,  Jochem Berndsen
 - All rights reserved.
 - 
 - Redistribution and use in source and binary forms, with or without
 - modification, are permitted provided that the following conditions
 - are met:
 - 
 -   1. Redistributions of source code must retain the above copyright
 -      notice, this list of conditions and the following disclaimer.
 -   2. Redistributions in binary form must reproduce the above copyright
 -      notice, this list of conditions and the following disclaimer in the
 -      documentation and/or other materials provided with the distribution.
 -   3. Neither the name of the author nor the names of its contributors
 -      may be used to endorse or promote products derived from this software
 -      without specific prior written permission.
 - 
 - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS
 - ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 - TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 - PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
 - BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 - CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 - SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 - INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 - CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 - ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 - POSSIBILITY OF SUCH DAMAGE.
 -}


-- |
-- Module      : Control.Hasim.DES
-- Copyright   : (c) Jochem Berndsen 2008
-- License     : BSD3
--
-- Maintainer  : jochem@functor.nl
-- Stability   : experimental
-- Portability : unportable
--
-- This module defines a /DES/, which stands for /Discrete Event Set/.
-- There are functions for creating and inserting events.
--
-- For each process, an 'Event' may be scheduled. This event consists of
-- a 'Time' and a 'Runnable'. There can be at most one 'Event' scheduled
-- for each 'Process'.

module Control.Hasim.DES (
    -- * Events
    -- ** Abstract data type
    Event,
    -- ** Querying events
    eTime,
    eRunnable,
    eProcess,
    -- * Discrete Event Set
    -- ** ADT for Discrete Event Set
    DES,
    -- ** Creating Discrete Event Set
    initDES,
    emptyDES,
    -- ** Querying Discrete Event Set
    isEmpty,
    -- * Updating Discrete Event Set
    removeNext,
    update
) where

-- Internal imports
import Control.Hasim.Process
import Control.Hasim.Types

-- External imports
import Control.Monad
import Data.IORef
import Data.Maybe

-- | Event. An event consists of a 'Time' and a 'Runnable'
data Event = Event { eTime :: Time -- ^ The 'Time' at which the event takes place.
                   , eRunnable :: Runnable -- ^ The 'Runnable' that should be run at this time
                   }

-- | The process of an 'Event'
eProcess :: Event 
         -> Process
eProcess = runnable2process . eRunnable

instance Show Event where
    show e = "Event { t = " ++ t ++ ", proc = " ++ p ++ " }" where
        t = show (eTime e)
        p = show (eProcess e)

-- | Discrete Event Set. A discrete event set is a data structure
-- that supports the operations 'update' and 'removeNext'.
newtype DES = DES { unDES :: [Event] }

instance Show DES where
    show = show . unDES

-- | Is the Discrete Event Set empty?
isEmpty :: DES 
        -> Bool
isEmpty = null . unDES

-- | Get an event with lowest time that will take place next.
-- Returns a tuple @(evt, des)@ where @evt@ is the next 'Event'
-- and @des@ is the new 'DES' where this event is removed.
--
-- Calls 'error' if the 'DES' is empty.
removeNext :: DES 
           -> (Event, DES)
removeNext (DES (e:es)) = (e, DES es)
removeNext (DES []) = error "Control.Hasim.DES.removeNext : empty discrete event set"

insert :: Event 
       -> DES
       -> DES
insert e' = DES . go . unDES where
    go es = left ++ [e'] ++ right where
        (left, right) = span (\e -> eTime e' >= eTime e) es

-- | Schedule an event in a discrete event set. Note that an old
-- event of the same process is removed from the discrete event set.
update :: Time -- ^ The time at which the event takes place
       -> Runnable -- ^ The 'Runnable' that should be run at that time
       -> DES -- ^ The old discrete event set
       -> DES -- ^ The discrete event set with the event added
update newtime runnable = insert evt . DES . rmv . unDES where
    proc = runnable2process runnable
    rmv = filter ((/= proc) . eProcess)
    evt = Event { eTime = newtime, eRunnable = runnable } 

-- | Create a new 'DES'. For each 'Process', an 'Event' is scheduled
-- at time 0 and with 'Runnable' the associated 'Runnable' of the 'Process'.
initDES :: [Process] -- ^ The list of processes
        -> IO DES -- ^ IO, with result the created DES
initDES ps = DES `liftM` mapM (\(Process p) -> do
    mRunnable <- readIORef (action p)
    when (isNothing mRunnable) 
        (fail "Control.Hasim.DES.initDES: Process without action")
    return $! Event { eTime = 0
                    , eRunnable = fromJust mRunnable 
                    }
    ) ps

-- | An empty discrete event set.
emptyDES :: DES
emptyDES = DES []