module Glue.Types(
BasicService
, MultiGetService
, MultiGetRequest
, MultiGetResponse
, ResultVar
, MToIO
, FailOrSuccess
, multiGetToBasic
, basicToMultiGet
, getResult
, makeCall
) where
import Control.Applicative
import Data.Hashable
import Control.Concurrent
import qualified Control.Concurrent.MVar.Lifted as MV
import Control.Exception.Base hiding(throw, throwIO, catch)
import Control.Exception.Lifted hiding(throw)
import Control.Monad.Trans.Control
import qualified Data.HashSet as S
import qualified Data.HashMap.Strict as M
type BasicService m a b = a -> m b
type MultiGetRequest a = S.HashSet a
type MultiGetResponse a b = M.HashMap a b
type MultiGetService m a b = BasicService m (MultiGetRequest a) (MultiGetResponse a b)
type ResultVar a = MVar (Either SomeException a)
type MToIO m = forall a. m a -> IO a
type FailOrSuccess a b = Either SomeException (MultiGetResponse a b)
multiGetToBasic :: (Hashable a, Eq a, Monad m) => MultiGetService m a b -> BasicService m a (Maybe b)
multiGetToBasic service = (\r -> do
mapResult <- service (S.singleton r)
return $ M.lookup r mapResult)
basicToMultiGet :: (Hashable a, Eq a, Applicative m) => BasicService m a b -> MultiGetService m a b
basicToMultiGet service =
let callService resultMap request = liftA2 (flip $ M.insert request) resultMap (service request)
in S.foldl' callService (pure M.empty)
getResult :: (MonadBaseControl IO m) => ResultVar a -> m a
getResult var = do
result <- MV.readMVar var
either throwIO return result
makeCall :: (Eq a, Hashable a, MonadBaseControl IO m) => MultiGetService m a b -> S.HashSet a -> m (FailOrSuccess a b)
makeCall service requests = catch (fmap Right $ service requests) (\(e :: SomeException) -> return $ Left e)