registry 0.1.2.0 → 0.1.2.2

raw patch · 4 files changed

+102/−50 lines, 4 filesdep ~tastyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: tasty

API changes (from Hackage documentation)

Files

• registry.cabal +5/−4
• src/Data/Registry/Make.hs +1/−1
• src/Data/Registry/RIO.hs +57/−45
• test/Test/Data/Registry/RIOSpec.hs +39/−0

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: ed72935dd76dfeedd16a88cf5a89166e40c882c6bbd693cb2a05f9d2c898c1df+-- hash: 7566c8a11593eb9d930102b802543fdd53f6664c7b6d041c3fe6d67c48386775  name:           registry-version:        0.1.2.0+version:        0.1.2.2 synopsis:       data structure for assembling components description:    This library provides a "Registry" which is a data structure containing a list of functions and values representing dependencies in a directed acyclic graph. A `make` function can then be used to create a value of a specific type out of the registry.                 You can start with the [README](https://github.com/etorreborre/registry/blob/master/README.md) for a full description of the library.@@ -70,6 +70,7 @@       Test.Data.Registry.Make       Test.Data.Registry.MonadRandomSpec       Test.Data.Registry.RegistrySpec+      Test.Data.Registry.RIOSpec       Test.Data.Registry.SmallExample       Test.Data.Registry.WarmupSpec       Test.Tasty.Extensions@@ -91,7 +92,7 @@     , random <2.0     , registry     , resourcet <1.3-    , tasty <1.2+    , tasty <1.3     , tasty-discover <4.3     , tasty-hedgehog <0.3     , tasty-th <0.2

@@ -69,7 +69,7 @@       --  use the makeUntyped function to create an element of the target type from a list of values and functions       --  the list of values is kept as some State so that newly created values can be added to the current state       case-        flip runStack values $+        flip runStack values           (makeUntyped targetType (Context [targetType]) functions specializations modifiers)        of

@@ -35,63 +35,59 @@ --   component creation actions, cumulating start/stop tasks --   found along the way -newtype RioT m a =-  RioT-  { runRioT :: Stop -> m (a, Warmup) }-  deriving (Functor)---- | Specialization of RioT to IO-type RIO = RioT IO--runRIO :: RIO a -> Stop -> IO (a, Warmup)-runRIO = runRioT+newtype RIO a = RIO { runRIO :: Stop -> IO (a, Warmup) } deriving (Functor) -instance (Monad m) => Applicative (RioT m) where+instance Applicative RIO where   pure a =-    RioT (const (pure (a, mempty)))+    RIO(const (pure (a, mempty))) -  RioT fab <*> RioT fa =-    RioT $ \s ->+  RIO fab <*> RIO fa =+    RIO $ \s ->       do (f, sf) <- fab s          (a, sa) <- fa s          pure (f a, sf `mappend` sa) -instance (Monad m) => Monad (RioT m) where+instance Monad RIO where   return = pure -  RioT ma >>= f =-    RioT $ \s ->+  RIO ma >>= f =+    RIO $ \s ->       do (a, sa) <- ma s-         (b, sb) <- runRioT  (f a) s+         (b, sb) <- runRIO  (f a) s          pure (b, sa `mappend` sb) -instance (MonadIO m) => MonadIO (RioT m) where-  liftIO io = RioT (const $ (, mempty) <$> liftIO io)+instance MonadIO RIO where+  liftIO io = RIO (const $ (, mempty) <$> liftIO io) -instance (MonadThrow m) => MonadThrow (RioT m) where-  throwM e = RioT (const $ throwM e)+instance MonadThrow RIO where+  throwM e = RIO (const $ throwM e) -instance (MonadBase IO m, MonadIO m) => MonadBase IO (RioT m) where+instance MonadBase IO RIO where   liftBase = liftIO -instance MonadResource m => MonadResource (RioT m) where-  liftResourceT action = RioT $ \(Stop s) -> liftIO ((, mempty) <$> runInternalState action s)--instance MonadTrans RioT where-  lift :: Monad m => m a -> RioT m a-  lift ma = RioT (const $ (, mempty) <$> ma)+instance MonadResource RIO where+  liftResourceT action = RIO $ \(Stop s) -> liftIO ((, mempty) <$> runInternalState action s)  -- * For production +-- | Use a RIO value and make sure that resources are closed+--   Only run the action if the warmup is successful+withRIO :: RIO a -> (a -> IO ()) -> IO Result+withRIO rio f = runResourceT $ withInternalState $ \is ->+  do  (a, warmup) <- runRIO rio (Stop is)+      result      <- liftIO $ runWarmup warmup+      if isSuccess result then f a else pure ()+      pure result+ -- | This function must be used to run services involving a top component --   It creates the top component and invokes all warmup functions -- --   The passed function 'f' is used to decide whether to continue or --   not depending on the Result-withRegistry :: forall a b ins out m . (Typeable a, Typeable m, MonadIO m, MonadUnliftIO m, Contains (RioT m a) out, Solvable ins out) =>+withRegistry :: forall a b ins out . (Typeable a, Contains (RIO a) out, Solvable ins out) =>      Registry ins out-  -> (Result -> a -> m b)-  -> m b+  -> (Result -> a -> IO b)+  -> IO b withRegistry registry f = runResourceT $ do   (a, warmup) <- runRegistryT @a registry   result      <- lift . liftIO $ runWarmup warmup@@ -99,37 +95,53 @@  -- | This can be used if you want to insert the component creation inside --   another action managed with 'ResourceT'. Or if you want to call 'runResourceT' yourself later-runRegistryT :: forall a ins out m . (Typeable a, Typeable m, MonadIO m, Contains (RioT m a) out, Solvable ins out) => Registry ins out -> ResourceT m (a, Warmup)-runRegistryT registry = withInternalState $ \is -> runRioT (make @(RioT m a) registry) (Stop is)+runRegistryT :: forall a ins out . (Typeable a, Contains (RIO a) out, Solvable ins out) => Registry ins out -> ResourceT IO (a, Warmup)+runRegistryT registry = withInternalState $ \is ->+  runRIO (make @(RIO a) registry) (Stop is)  -- * For testing +-- | Use a RIO value and make sure that resources are closed+--   Don't run the warmup+withNoWarmupRIO :: RIO a -> (a -> IO b) -> IO b+withNoWarmupRIO rio f =+  runResourceT $ withInternalState $ \is ->+  f . fst =<< runRIO rio (Stop is)+ -- | Instantiate the component but don't execute the warmup (it may take time) --   and keep the Stop value to clean resources later --   This function statically checks that the component can be instantiated-executeRegistry :: forall a ins out m . (Typeable a, Typeable m, MonadIO m, Contains (RioT m a) out, Solvable ins out) => Registry ins out -> m (a, Warmup, Stop)+executeRegistry :: forall a ins out . (Typeable a, Contains (RIO a) out, Solvable ins out) => Registry ins out -> IO (a, Warmup, Stop) executeRegistry registry = do   is <- liftIO createInternalState-  (a, w) <- runRioT (make @(RioT m a) registry) (Stop is)+  (a, w) <- runRIO (make @(RIO a) registry) (Stop is)   pure (a, w, Stop is)  -- | Instantiate the component but don't execute the warmup (it may take time) and lose a way to cleanu up resources -- | Almost no compilation time is spent on checking that component resolution is possible-unsafeRun :: forall a ins out m . (Typeable a, Typeable m, MonadIO m, Contains (RioT m a) out) => Registry ins out -> m a-unsafeRun registry = fst <$> unsafeRunWithStop registry+unsafeRun :: forall a ins out . (Typeable a, Contains (RIO a) out) => Registry ins out -> IO a+unsafeRun = unsafeRunDynamic +-- | Instantiate the component but don't execute the warmup (it may take time) and lose a way to cleanu up resources+--   Don't even check that a component can be built out of the registry+unsafeRunDynamic :: forall a ins out . (Typeable a) => Registry ins out -> IO a+unsafeRunDynamic registry = fst <$> unsafeRunDynamicWithStop registry+ -- | Same as 'unsafeRun' but keep the 'Stop' value to be able to clean resources later-unsafeRunWithStop :: forall a ins out m . (Typeable a, Typeable m, MonadIO m, Contains (RioT m a) out) => Registry ins out -> m (a, Stop)-unsafeRunWithStop registry = do+unsafeRunWithStop :: forall a ins out . (Typeable a, Contains (RIO a) out) => Registry ins out -> IO (a, Stop)+unsafeRunWithStop = unsafeRunDynamicWithStop++unsafeRunDynamicWithStop :: forall a ins out . (Typeable a) => Registry ins out -> IO (a, Stop)+unsafeRunDynamicWithStop registry = do   is <- createInternalState-  (a, _) <- runRioT (makeUnsafe @(RioT m a) registry) (Stop is)+  (a, _) <- runRIO (makeUnsafe @(RIO a) registry) (Stop is)   pure (a, Stop is) --- | Lift a 'Warmup' action into the 'RioT m' monad-warmupWith :: (Applicative m) => Warmup -> RioT m ()-warmupWith w = RioT (const $ pure ((), w))+-- | Lift a 'Warmup' action into the 'RIO` monad+warmupWith :: Warmup -> RIO ()+warmupWith w = RIO (const $ pure ((), w))  -- | Allocate some resource-allocate :: (MonadResource m) => IO a -> (a -> IO ()) -> RioT m a+allocate :: IO a -> (a -> IO ()) -> RIO a allocate resource cleanup =   snd <$> Resource.allocate resource cleanup

@@ -0,0 +1,39 @@+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE TypeApplications    #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}++module Test.Data.Registry.RIOSpec where++import           Data.IORef+import           Data.Registry+import           Protolude             as P+import           Test.Tasty.Extensions++test_close_resource = prop "RIO resources must be closed, with warmup" $ do+  ref <- liftIO $ newIORef []+  let rio = do+        ref' <- allocate (pure ref) (\ref' -> modifyIORef ref' (<>["close"]))+        warmupWith (warmupOf ("test"::Text) $ modifyIORef ref (<>["start"]))+        pure ref'++  res <- liftIO $ withRIO rio $ \ref' -> modifyIORef ref' (<>["use"])+  content <- liftIO $ readIORef ref++  isSuccess res === True+  content === ["start", "use", "close" :: Text]++test_close_resource_no_warmup = prop "RIO resources must be closed" $ do++  let rio = do+        ref <- allocate (newIORef []) (\ref -> modifyIORef ref (<>["close"]))+        liftIO $ modifyIORef ref (<>["start"])+        pure ref++  ref <- liftIO $ withNoWarmupRIO rio $ \ref -> modifyIORef ref (<>["use"]) $> ref+  content <- liftIO $ readIORef ref+  content === ["start", "use", "close" :: Text]++tests = $(testGroupGenerator)