{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

module Managed.Agent
  ( fromList
  , toList
  , (!)
  , (!?)
  , invoke
  , ids
  , invokeUnsafe
  , describe
  , describeEither
  , describeHuman
  ) where

import qualified Data.Map as M

import Data.Managed

import Control.DeepSeq (NFData, force)
import Control.Exception (catch, evaluate, toException)
import Control.Monad.Catch (try)
import Managed.Exception
import Managed.ProbeDescription
import System.IO.Error (catchIOError)

-- | 'Data.Map.fromList' specialized to 'Agent'
fromList :: [(ProbeID, Probe e)] -> Agent e
fromList :: [(ProbeID, Probe e)] -> Agent e
fromList = [(ProbeID, Probe e)] -> Agent e
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

-- | 'Data.Map.toList' specialized to 'Agent'
toList :: Agent e -> [(ProbeID, Probe e)]
toList :: Agent e -> [(ProbeID, Probe e)]
toList = Agent e -> [(ProbeID, Probe e)]
forall k a. Map k a -> [(k, a)]
M.toList

infixl 9 !, !?

-- | 'Data.Map.!' specialized to 'Agent'
(!) :: Agent e -> ProbeID -> Probe e
(!) = Agent e -> ProbeID -> Probe e
forall k a. Ord k => Map k a -> k -> a
(M.!)

-- | 'Data.Map.!?' specialized to 'Agent'
(!?) :: Agent e -> ProbeID -> Maybe (Probe e)
!? :: Agent e -> ProbeID -> Maybe (Probe e)
(!?) = Agent e -> ProbeID -> Maybe (Probe e)
forall k a. Ord k => Map k a -> k -> Maybe a
(M.!?)

-- | Invokes (calls) a 'Probe'.
--
-- This function never throws an exception,
-- instead, an 'Either' is used.
-- Any errors and exceptions caused by incorrect 'ProbeID',
-- incorrect input parameters, or by the probe call itself
-- are caught and passed as an 'AgentException'.
--
-- The result is fully evaluated using 'force'
-- before it's returned
-- (to keep all exceptions inside the 'Either').
invoke ::
     (NFData (Out e))
  => ProbeID -- ^ ID of the probe to be called
  -> [In e] -- ^ Input parameters
  -> Agent e -- ^ Agent that contains the probe to be called
  -> IO (Either AgentException (Out e))
invoke :: ProbeID -> [In e] -> Agent e -> IO (Either AgentException (Out e))
invoke ProbeID
p [In e]
i Agent e
a = IO (Out e) -> IO (Either AgentException (Out e))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (Out e) -> IO (Either AgentException (Out e)))
-> IO (Out e) -> IO (Either AgentException (Out e))
forall a b. (a -> b) -> a -> b
$ ProbeID -> [In e] -> Agent e -> IO (Out e)
forall e.
NFData (Out e) =>
ProbeID -> [In e] -> Agent e -> IO (Out e)
invokeUnsafe ProbeID
p [In e]
i Agent e
a

-- | An unsafe variant of 'invoke'.
--
-- This function rethrows all exceptions and errors
-- caused by probe lookup or input parameters.
-- Exceptions caused by probe invocation
-- are rethrown as 'ProbeRuntimeException'.
invokeUnsafe ::
     (NFData (Out e))
  => ProbeID
  -> [In e]
  -> Agent e
  -> IO (Out e)
invokeUnsafe :: ProbeID -> [In e] -> Agent e -> IO (Out e)
invokeUnsafe ProbeID
pid [In e]
input Agent e
agent =
  ProbeID -> Agent e -> IO (Probe e)
forall e. ProbeID -> Agent e -> IO (Probe e)
findOrThrow ProbeID
pid Agent e
agent IO (Probe e) -> (Probe e -> IO (Out e)) -> IO (Out e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [In e] -> Probe e -> IO (Out e)
forall e. NFData (Out e) => [In e] -> Probe e -> IO (Out e)
callStrict [In e]
input

-- | List all Probe IDs
ids :: Agent e -> [ProbeID]
ids :: Agent e -> [ProbeID]
ids = ((ProbeID, Probe e) -> ProbeID)
-> [(ProbeID, Probe e)] -> [ProbeID]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (ProbeID, Probe e) -> ProbeID
forall a b. (a, b) -> a
fst ([(ProbeID, Probe e)] -> [ProbeID])
-> (Agent e -> [(ProbeID, Probe e)]) -> Agent e -> [ProbeID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Agent e -> [(ProbeID, Probe e)]
forall e. Agent e -> [(ProbeID, Probe e)]
toList

-- | Create a full description of a 'Probe'
describe :: Agent e -> ProbeID -> Maybe ProbeDescription
describe :: Agent e -> ProbeID -> Maybe ProbeDescription
describe Agent e
agent ProbeID
pid = ProbeID -> Probe e -> ProbeDescription
forall e. ProbeID -> Probe e -> ProbeDescription
mkDescription ProbeID
pid (Probe e -> ProbeDescription)
-> Maybe (Probe e) -> Maybe ProbeDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Agent e
agent Agent e -> ProbeID -> Maybe (Probe e)
forall e. Agent e -> ProbeID -> Maybe (Probe e)
!? ProbeID
pid

-- | A variant of 'describe' that returns 'Either' instead of 'Maybe'
describeEither ::
     Agent e
  -> ProbeID
  -> Either AgentException ProbeDescription
describeEither :: Agent e -> ProbeID -> Either AgentException ProbeDescription
describeEither Agent e
agent ProbeID
pid =
  case Agent e -> ProbeID -> Maybe ProbeDescription
forall e. Agent e -> ProbeID -> Maybe ProbeDescription
describe Agent e
agent ProbeID
pid of
    Maybe ProbeDescription
Nothing -> AgentException -> Either AgentException ProbeDescription
forall a b. a -> Either a b
Left (AgentException -> Either AgentException ProbeDescription)
-> AgentException -> Either AgentException ProbeDescription
forall a b. (a -> b) -> a -> b
$ ProbeID -> AgentException
badProbeID ProbeID
pid
    Just ProbeDescription
res -> ProbeDescription -> Either AgentException ProbeDescription
forall a b. b -> Either a b
Right ProbeDescription
res

-- | Create a human-readable description of a probe
describeHuman :: Agent e -> ProbeID -> Maybe String
describeHuman :: Agent e -> ProbeID -> Maybe ProbeID
describeHuman Agent e
agent ProbeID
pid = ProbeDescription -> ProbeID
human (ProbeDescription -> ProbeID)
-> Maybe ProbeDescription -> Maybe ProbeID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Agent e -> ProbeID -> Maybe ProbeDescription
forall e. Agent e -> ProbeID -> Maybe ProbeDescription
describe Agent e
agent ProbeID
pid

-- Utility functions
findOrThrow :: ProbeID -> Agent e -> IO (Probe e)
findOrThrow :: ProbeID -> Agent e -> IO (Probe e)
findOrThrow ProbeID
pid Agent e
agent =
  case Agent e
agent Agent e -> ProbeID -> Maybe (Probe e)
forall e. Agent e -> ProbeID -> Maybe (Probe e)
!? ProbeID
pid of
    Maybe (Probe e)
Nothing -> AgentException -> IO (Probe e)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (AgentException -> IO (Probe e)) -> AgentException -> IO (Probe e)
forall a b. (a -> b) -> a -> b
$ ProbeID -> AgentException
badProbeID ProbeID
pid
    Just Probe e
probe -> Probe e -> IO (Probe e)
forall (m :: * -> *) a. Monad m => a -> m a
return Probe e
probe

callStrict ::
     (NFData (Out e)) => [In e] -> Probe e -> IO (Out e)
callStrict :: [In e] -> Probe e -> IO (Out e)
callStrict [In e]
input Probe e
p = [In e] -> Probe e -> IO (Out e)
forall e. [In e] -> Probe e -> IO (Out e)
callOrThrow [In e]
input Probe e
p IO (Out e) -> (Out e -> IO (Out e)) -> IO (Out e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Out e -> IO (Out e)
forall a. NFData a => a -> IO a
evalOrThrow

callOrThrow :: [In e] -> Probe e -> IO (Out e)
callOrThrow :: [In e] -> Probe e -> IO (Out e)
callOrThrow [In e]
input Probe e
p =
  Probe e -> [In e] -> IO (Out e)
forall e. Probe e -> [In e] -> IO (Out e)
call Probe e
p [In e]
input IO (Out e) -> (IOError -> IO (Out e)) -> IO (Out e)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
  (AgentException -> IO (Out e)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (AgentException -> IO (Out e))
-> (IOError -> AgentException) -> IOError -> IO (Out e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> AgentException
probeRuntimeException (SomeException -> AgentException)
-> (IOError -> SomeException) -> IOError -> AgentException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> SomeException
forall e. Exception e => e -> SomeException
toException)

evalOrThrow :: (NFData a) => a -> IO a
evalOrThrow :: a -> IO a
evalOrThrow a
x =
  (a -> IO a
forall a. a -> IO a
evaluate (a -> IO a) -> (a -> a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. NFData a => a -> a
force) a
x IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
  (AgentException -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (AgentException -> IO a)
-> (SomeException -> AgentException) -> SomeException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> AgentException
probeRuntimeException)