module System.Touched.OnlyOne where

import System.Touched.Procedure
import Data.Maybe (maybe)
import Data.Time.Clock (UTCTime, getCurrentTime)

-- | A wrapper over a process which allows only one instance of the process to
-- be active at any one time.
data OnlyOne a b = Inactive (Procedure a b)
                 | Active (Procedure a b) b UTCTime
                          

-- | Gets the time a process launched
otTime :: OnlyOne a b -> Maybe UTCTime
otTime (Active _ _ t0) = Just t0
otTime _ = Nothing
  
-- | Compare a process' launch time with a 'UTCTime', returning a Bool
-- specifying whether or not the process was launched prior to the time.
old :: OnlyOne a b -> UTCTime -> Bool
old ot utc = maybe True (<utc) $ otTime ot

-- | Forces any 'OnlyOne' process into 'Inactive' Mode.
otKill :: OnlyOne a b -> IO (OnlyOne a b)
otKill (Active p id _) = kill p id >>
                         return (Inactive p)
otKill ot = return ot

-- | Starts a process if it has not been started, restarts a process that has
-- been started
otStart :: OnlyOne a b -> IO (OnlyOne a b)
otStart (Inactive p) = do
  id <- fork p $ exec p
  t <- getCurrentTime
  return (Active p id t)
otStart active@(Active p _ _) = otKill active >>= otStart

-- | Takes an 'OnlyOne' lifted process and a UTCTime. If the process was
-- launched prior to the UTCTime, the process is (re)started. Otherwise, it's
-- just returned.
restartOld :: OnlyOne a b -> UTCTime -> IO (OnlyOne a b)
restartOld ot t = if old ot t
                  then otStart ot
                  else return ot