-- | Functions for receive timeouts and delayed messages sending.
--
-- Based on the 'delay' function.
--
-- @since 0.12.0
module Control.Eff.Concurrent.Process.Timer
  ( TimerReference()
  , TimerElapsed(fromTimerElapsed)
  , sendAfter
  , startTimer
  , sendAfterWithTitle
  , startTimerWithTitle
  , cancelTimer
  , selectTimerElapsed
  , receiveAfter
  , receiveSelectedAfter
  , receiveSelectedWithMonitorAfter
  , receiveAfterWithTitle
  , receiveSelectedAfterWithTitle
  , receiveSelectedWithMonitorAfterWithTitle
  )

where

import           Control.Eff.Concurrent.Process
import           Control.Eff.Concurrent.Misc
import           Control.Eff
import           Control.DeepSeq
import           Data.Typeable
import           Data.Text as T
import           Control.Applicative
import           GHC.Stack

-- | Wait for a message of the given type for the given time. When no message
-- arrives in time, return 'Nothing'. This is based on
-- 'receiveSelectedAfter'.
--
-- @since 0.12.0
receiveAfter
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Typeable a
     , NFData a
     , Show a
     )
  => Timeout
  -> Eff r (Maybe a)
receiveAfter t =
  either (const Nothing) Just <$> receiveSelectedAfter (selectMessage @a) t

-- | Wait for a message of the given type for the given time. When no message
-- arrives in time, return 'Left' 'TimerElapsed'. This is based on
-- 'selectTimerElapsed' and 'startTimer'.
--
-- @since 0.12.0
receiveSelectedAfter
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Show a
     , Typeable a
     )
  => MessageSelector a
  -> Timeout
  -> Eff r (Either TimerElapsed a)
receiveSelectedAfter sel t = do
  let timerTitle =
        MkProcessTitle
          ("receive-timer-"
          <> pack (showSTypeable @a "")
          <> "-"
          <> pack (show t)
          )
  timerRef <- startTimerWithTitle timerTitle t
  res      <- receiveSelectedMessage
    (Left <$> selectTimerElapsed timerRef <|> Right <$> sel)
  cancelTimer timerRef
  return res

-- | Like 'receiveWithMonitor' combined with 'receiveSelectedAfter'.
--
-- @since 0.22.0
receiveSelectedWithMonitorAfter
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Show a
     , Typeable a
     )
  => ProcessId
  -> MessageSelector a
  -> Timeout
  -> Eff r (Either (Either ProcessDown TimerElapsed) a)
receiveSelectedWithMonitorAfter pid sel t =
  let timerTitle =
        MkProcessTitle
          ("receive-timer-"
          <> pack (showSTypeable @a "")
          <> "-monitoring-"
          <> pack (show pid)
          <> "-"
          <> pack (show t)
          )
  in receiveSelectedWithMonitorAfterWithTitle pid sel t timerTitle


-- | Wait for a message of the given type for the given time. When no message
-- arrives in time, return 'Nothing'. This is based on
-- 'receiveSelectedAfterWithTitle'.
--
-- @since 0.12.0
receiveAfterWithTitle
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Typeable a
     , NFData a
     , Show a
     )
  => Timeout
  -> ProcessTitle
  -> Eff r (Maybe a)
receiveAfterWithTitle t timerTitle =
  either (const Nothing) Just <$> receiveSelectedAfterWithTitle (selectMessage @a) t timerTitle

-- | Wait for a message of the given type for the given time. When no message
-- arrives in time, return 'Left' 'TimerElapsed'. This is based on
-- 'selectTimerElapsed' and 'startTimerWithTitle'.
--
-- @since 0.12.0
receiveSelectedAfterWithTitle
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Show a
     , Typeable a
     )
  => MessageSelector a
  -> Timeout
  -> ProcessTitle
  -> Eff r (Either TimerElapsed a)
receiveSelectedAfterWithTitle sel t timerTitle = do
  timerRef <- startTimerWithTitle timerTitle t
  res      <- receiveSelectedMessage
    (Left <$> selectTimerElapsed timerRef <|> Right <$> sel)
  cancelTimer timerRef
  return res

-- | Like 'receiveWithMonitorWithTitle' combined with 'receiveSelectedAfterWithTitle'.
--
-- @since 0.30.0
receiveSelectedWithMonitorAfterWithTitle
  :: forall a r q
   . ( HasCallStack
     , HasProcesses r q
     , Show a
     , Typeable a
     )
  => ProcessId
  -> MessageSelector a
  -> Timeout
  -> ProcessTitle
  -> Eff r (Either (Either ProcessDown TimerElapsed) a)
receiveSelectedWithMonitorAfterWithTitle pid sel t timerTitle = do
  timerRef <- startTimerWithTitle timerTitle t
  res      <- withMonitor pid $ \pidMon -> do
                receiveSelectedMessage
                  (   Left . Left  <$> selectProcessDown pidMon
                  <|> Left . Right <$> selectTimerElapsed timerRef
                  <|> Right        <$> sel
                  )
  cancelTimer timerRef
  return res

-- | A 'MessageSelector' matching 'TimerElapsed' messages created by
-- 'startTimer'.
--
-- @since 0.12.0
selectTimerElapsed :: TimerReference -> MessageSelector TimerElapsed
selectTimerElapsed timerRef =
  filterMessage (\(TimerElapsed timerRefIn) -> timerRef == timerRefIn)

-- | The reference to a timer started by 'startTimer', required to stop
-- a timer via 'cancelTimer'.
--
-- @since 0.12.0
newtype TimerReference = TimerReference ProcessId
  deriving (NFData, Ord,Eq, Num, Integral, Real, Enum, Typeable)

instance Show TimerReference where
  showsPrec d (TimerReference t) =
    showParen (d >= 10) (showString "timer: " . shows t)

-- | A value to be sent when timer started with 'startTimer' has elapsed.
--
-- @since 0.12.0
newtype TimerElapsed = TimerElapsed {fromTimerElapsed :: TimerReference}
  deriving (NFData, Ord,Eq, Typeable)

instance Show TimerElapsed where
  showsPrec d (TimerElapsed t) =
    showParen (d >= 10) (shows t . showString " elapsed")--

-- | Send a message to a given process after waiting. The message is created by
-- applying the function parameter to the 'TimerReference', such that the
-- message can directly refer to the timer.
--
-- @since 0.12.0
sendAfter
  :: forall r q message
   . ( HasCallStack
     , HasProcesses r q
     , Typeable message
     , NFData message
     )
  => ProcessId
  -> Timeout
  -> (TimerReference -> message)
  -> Eff r TimerReference
sendAfter pid t mkMsg =
  sendAfterWithTitle
    (MkProcessTitle ("send-after-timer-" <> T.pack (show t) <> "-" <> T.pack (showSTypeable @message "") <> "-" <> T.pack (show pid)))
    pid
    t
    mkMsg

-- | Like 'sendAfter' but with a user provided name for the timer process.
--
-- @since 0.30.0
sendAfterWithTitle
  :: forall r q message
   . ( HasCallStack
     , HasProcesses r q
     , Typeable message
     , NFData message
     )
  => ProcessTitle
  -> ProcessId
  -> Timeout
  -> (TimerReference -> message)
  -> Eff r TimerReference
sendAfterWithTitle title pid t mkMsg =
  TimerReference <$>
  (spawn
    title
    (delay t
    >>  self
    >>= (sendMessage pid . force . mkMsg . TimerReference)))

-- | Start a new timer, after the time has elapsed, 'TimerElapsed' is sent to
-- calling process. The message also contains the 'TimerReference' returned by
-- this function. Use 'cancelTimer' to cancel the timer. Use
-- 'selectTimerElapsed' to receive the message using 'receiveSelectedMessage'.
-- To receive messages with guarded with a timeout see 'receiveAfter'.
--
-- This calls 'sendAfterWithTitle' under the hood with 'TimerElapsed' as
-- message.
--
-- @since 0.30.0
startTimerWithTitle
  :: forall r q
   . ( HasCallStack
     , HasProcesses r q
     )
  => ProcessTitle
  -> Timeout
  -> Eff r TimerReference -- TODO add a parameter to the TimerReference
startTimerWithTitle title t = do
  p <- self
  sendAfterWithTitle title p t TimerElapsed

-- | Start a new timer, after the time has elapsed, 'TimerElapsed' is sent to
-- calling process. The message also contains the 'TimerReference' returned by
-- this function. Use 'cancelTimer' to cancel the timer. Use
-- 'selectTimerElapsed' to receive the message using 'receiveSelectedMessage'.
-- To receive messages with guarded with a timeout see 'receiveAfter'.
--
-- Calls 'sendAfter' under the hood.
--
-- @since 0.12.0
startTimer
  :: forall r q
   . ( HasCallStack
     , HasProcesses r q
     )
  => Timeout
  -> Eff r TimerReference -- TODO add a parameter to the TimerReference
startTimer t = do
  p <- self
  sendAfter p t TimerElapsed

-- | Cancel a timer started with 'startTimer'.
--
-- @since 0.12.0
cancelTimer
  :: forall r q
   . ( HasCallStack
     , HasProcesses r q
     )
  => TimerReference
  -> Eff r ()
cancelTimer (TimerReference tr) = sendShutdown tr ExitNormally