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 ( 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