From dfc90e8e12297e1de63a04fd91012eec8dd3eae7 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Fri, 24 Apr 2026 14:33:43 -0400 Subject: [PATCH 1/2] ema: Add hspec test suite with Ema.DynamicSpec Closes #178. Adds the `test` test-suite stanza so future feature PRs can land unit tests alongside code. Seeds it with specs for `Ema.Dynamic.currentValue` (#177) covering the initial value and the wrapped updater. --- ema/ema.cabal | 22 ++++++++++++++++++++++ ema/test/Ema/DynamicSpec.hs | 15 +++++++++++++++ ema/test/Spec.hs | 8 ++++++++ 3 files changed, 45 insertions(+) create mode 100644 ema/test/Ema/DynamicSpec.hs create mode 100644 ema/test/Spec.hs diff --git a/ema/ema.cabal b/ema/ema.cabal index 1ce0258a..a2aad4e8 100644 --- a/ema/ema.cabal +++ b/ema/ema.cabal @@ -141,3 +141,25 @@ library if impl(ghc >=8.10) ghc-options: -Wunused-packages + +test-suite test + import: extensions + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: Ema.DynamicSpec + build-depends: + , base + , ema + , hspec + , relude >=1.0 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude, Relude.Container.One), + relude + + default-language: Haskell2010 + + if impl(ghc >=8.10) + ghc-options: -Wunused-packages diff --git a/ema/test/Ema/DynamicSpec.hs b/ema/test/Ema/DynamicSpec.hs new file mode 100644 index 00000000..e32a5048 --- /dev/null +++ b/ema/test/Ema/DynamicSpec.hs @@ -0,0 +1,15 @@ +module Ema.DynamicSpec where + +import Ema.Dynamic (Dynamic (Dynamic), currentValue) +import Test.Hspec (Spec, describe, it, shouldReturn) + +spec :: Spec +spec = describe "currentValue" $ do + it "returns initial value before any update" $ do + (readNow, _) <- currentValue (Dynamic (42 :: Int, \_ -> pass)) + readNow `shouldReturn` 42 + it "tracks the latest value pushed through the wrapped Dynamic" $ do + (readNow, Dynamic (_, xf)) <- + currentValue (Dynamic (0 :: Int, \send -> mapM_ send [1, 2, 3])) + xf $ \_ -> pass + readNow `shouldReturn` 3 diff --git a/ema/test/Spec.hs b/ema/test/Spec.hs new file mode 100644 index 00000000..b175d39e --- /dev/null +++ b/ema/test/Spec.hs @@ -0,0 +1,8 @@ +module Main where + +import Ema.DynamicSpec qualified +import Test.Hspec (hspec) + +main :: IO () +main = hspec $ do + Ema.DynamicSpec.spec From e75ccb71e29818f021692fd209348bc3fd7e04cb Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Fri, 24 Apr 2026 14:52:10 -0400 Subject: [PATCH 2/2] test(Dynamic): Cover Functor and Applicative instances Extends DynamicSpec to exercise fmap (initial value + updater), pure (no-op updater), and liftA2 (combined initial value + updates from both sides, serialized by the internal sendLock). liftA2 is driven through currentValue and gated with MVars so the assertions don't rely on timing. --- ema/ema.cabal | 4 +- ema/test/Ema/DynamicSpec.hs | 81 ++++++++++++++++++++++++++++++++----- 2 files changed, 74 insertions(+), 11 deletions(-) diff --git a/ema/ema.cabal b/ema/ema.cabal index a2aad4e8..0a2e18d0 100644 --- a/ema/ema.cabal +++ b/ema/ema.cabal @@ -152,7 +152,9 @@ test-suite test , base , ema , hspec - , relude >=1.0 + , monad-logger + , relude >=1.0 + , unliftio mixins: base hiding (Prelude), diff --git a/ema/test/Ema/DynamicSpec.hs b/ema/test/Ema/DynamicSpec.hs index e32a5048..ab90fb4b 100644 --- a/ema/test/Ema/DynamicSpec.hs +++ b/ema/test/Ema/DynamicSpec.hs @@ -1,15 +1,76 @@ module Ema.DynamicSpec where +import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Ema.Dynamic (Dynamic (Dynamic), currentValue) -import Test.Hspec (Spec, describe, it, shouldReturn) +import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn) +import UnliftIO.Async (withAsync) spec :: Spec -spec = describe "currentValue" $ do - it "returns initial value before any update" $ do - (readNow, _) <- currentValue (Dynamic (42 :: Int, \_ -> pass)) - readNow `shouldReturn` 42 - it "tracks the latest value pushed through the wrapped Dynamic" $ do - (readNow, Dynamic (_, xf)) <- - currentValue (Dynamic (0 :: Int, \send -> mapM_ send [1, 2, 3])) - xf $ \_ -> pass - readNow `shouldReturn` 3 +spec = do + describe "currentValue" $ do + it "returns initial value before any update" $ do + (readNow, _) <- currentValue (Dynamic (42 :: Int, \_ -> pass)) + readNow `shouldReturn` 42 + it "tracks the latest value pushed through the wrapped Dynamic" $ do + (readNow, Dynamic (_, xf)) <- + currentValue (Dynamic (0 :: Int, \send -> mapM_ send [1, 2, 3])) + xf $ \_ -> pass + readNow `shouldReturn` 3 + + describe "Functor" $ do + it "fmap transforms the initial value" $ do + let Dynamic (x0, _) = + fmap (+ 1) (Dynamic (5 :: Int, \_ -> pass) :: Dynamic IO Int) + x0 `shouldBe` 6 + it "fmap transforms each value pushed through the updater" $ do + sent <- newIORef ([] :: [Int]) + let Dynamic (_, xf) = + fmap + (* 10) + (Dynamic (0 :: Int, \send -> mapM_ send [1, 2, 3]) :: Dynamic IO Int) + xf $ \x -> modifyIORef' sent (x :) + reverse <$> readIORef sent `shouldReturn` [10, 20, 30] + + describe "Applicative" $ do + it "pure has a no-op updater" $ runNoLoggingT $ do + let Dynamic (x0, xf) = pure (7 :: Int) :: Dynamic (NoLoggingT IO) Int + sent <- liftIO $ newIORef ([] :: [Int]) + xf $ \x -> liftIO $ modifyIORef' sent (x :) + liftIO $ do + x0 `shouldBe` 7 + readIORef sent `shouldReturn` [] + + it "liftA2 combines initial values and tracks updates from both sides" $ + runNoLoggingT $ do + gateA <- newEmptyMVar + gateB <- newEmptyMVar + doneA <- newEmptyMVar + doneB <- newEmptyMVar + let dA, dB :: Dynamic (NoLoggingT IO) Int + dA = + Dynamic + ( 1 + , \send -> do + takeMVar gateA + send 10 + putMVar doneA () + ) + dB = + Dynamic + ( 2 + , \send -> do + takeMVar gateB + send 20 + putMVar doneB () + ) + (readNow, Dynamic (init0, xf)) <- currentValue ((,) <$> dA <*> dB) + liftIO $ do + init0 `shouldBe` (1, 2) + readNow `shouldReturn` (1, 2) + withAsync (xf $ \_ -> pass) $ \_ -> do + putMVar gateA () + takeMVar doneA + liftIO $ readNow `shouldReturn` (10, 2) + putMVar gateB () + takeMVar doneB + liftIO $ readNow `shouldReturn` (10, 20)