{-# LANGUAGE BangPatterns #-} {-# LANGUAGE NoImplicitPrelude #-} module Control.Monad.Component.Internal.Core where import Protolude import Control.Monad.Component.Internal.Types import Control.Teardown (Teardown, newTeardown, teardown) -------------------------------------------------------------------------------- -- | Given the name and a `ComponentM` sub-routine, this function builds an `IO` -- sub-routine that returns a `Component` record. -- -- The name argument is used for trace-ability purposes when executing the -- `teardown` of a resulting `Component`. -- -- * A note on error scenarios: -- -- Sometimes the given `ComponentM` sub-routine may fail on execution, in such -- cases, this function will teardown all component resources allocated so far -- and throw a `ComponentStartupFailure` exception. -- runComponentM :: Text -> ComponentM a -> IO (Component a) runComponentM !appName (ComponentM ma) = do eResult <- ma case eResult of Left (errList, cleanupActions) -> do appTeardown <- newTeardown appName cleanupActions -- Cleanup resources allocated so far and throw error -- list void $ teardown appTeardown throwIO (ComponentStartupFailure errList) Right (a, cleanupActions) -> do appTeardown <- newTeardown appName cleanupActions return $! Component a appTeardown -- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given -- `IO` sub-routine must return a tuple where: -- -- * First position represents the resource being returned from -- the component -- -- * Second position represents a named cleanup action that tears down -- allocated resources to create the first element of the tuple -- buildComponentWithCleanup :: IO (a, (Text, IO ())) -> ComponentM a buildComponentWithCleanup !ma = ComponentM $ do (a, (desc, cleanupAction)) <- ma teardownAction <- newTeardown desc cleanupAction return $ Right (a, [teardownAction]) -- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given -- `IO` sub-routine must return a tuple where: -- -- * First position represents the resource being returned from -- the component -- -- * Second position represents a `Teardown` record that cleans up allocated -- resources to create the first element of the tuple -- buildComponentWithTeardown :: IO (a, Teardown) -> ComponentM a buildComponentWithTeardown !ma = ComponentM $ (\(a, resourceTeardown) -> Right (a, [resourceTeardown])) <$> ma -- | Transforms an `IO` sub-routine into a `ComponentM` sub-routine; the given -- `IO` sub-routine returns a resource that does not allocate any other -- resources that would need to be cleaned up on a system shutdown. -- buildComponent :: IO a -> ComponentM a buildComponent !ma = ComponentM $ (\a -> Right (a, [])) <$> ma