tower-hs 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+110/−1 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• src/Tower/Service.hs +32/−0
• test/Tower/ServiceSpec.hs +71/−0
• tower-hs.cabal +1/−1

@@ -1,5 +1,11 @@ # Changelog +## 0.3.0.0 — 2026-04-07++- Add `Category` instance for `Service` — compose services sequentially with `>>>`, errors short-circuit automatically+- Add `Arrow` instance for `Service` — lift pure functions with `arr`, thread data with `first`/`second`+- Add `ArrowChoice` instance for `Service` — route with `|||` and `left`/`right`+ ## 0.2.0.0 — 2026-04-07  - Add `Functor` instance for `Service req` — use `fmap` to transform successful responses

@@ -6,6 +6,10 @@ -- The fundamental building blocks for composable middleware stacks. -- A 'Service' is a function from request to @IO (Either ServiceError response)@, -- and 'Middleware' wraps a service to add behavior.+--+-- 'Service' forms a 'Category' (sequential composition via '>>>') and an+-- 'Arrow', so you can use arrow combinators and proc-notation to wire+-- services together. module Tower.Service   ( Service(..)   , Middleware@@ -15,7 +19,10 @@   , composeMiddleware   ) where +import Control.Arrow (Arrow(..), ArrowChoice(..))+import Control.Category (Category(..)) import Data.Profunctor (Profunctor(..))+import Prelude hiding (id, (.)) import Tower.Error (ServiceError)  -- | A service transforms a request into an effectful response.@@ -44,6 +51,31 @@   dimap f g (Service run) = Service $ \req -> fmap (fmap g) (run (f req))   lmap f (Service run) = Service (run . f)   rmap = fmap++instance Category Service where+  id = Service (pure . Right)+  (Service g) . (Service f) = Service $ \req -> do+    result <- f req+    case result of+      Left err -> pure (Left err)+      Right mid -> g mid++instance Arrow Service where+  arr f = Service (pure . Right . f)+  first (Service f) = Service $ \(a, c) -> do+    result <- f a+    case result of+      Left err -> pure (Left err)+      Right b -> pure (Right (b, c))++instance ArrowChoice Service where+  left (Service f) = Service $ \eac -> case eac of+    Left a -> do+      result <- f a+      case result of+        Left err -> pure (Left err)+        Right b -> pure (Right (Left b))+    Right c -> pure (Right (Right c))  -- | Middleware wraps a service to add behavior (retry, timeout, logging, etc.) --

@@ -4,6 +4,9 @@  import Test.Hspec +import Control.Arrow (Arrow(..), ArrowChoice(..))+import qualified Control.Category+import Control.Category ((>>>)) import Tower.Service import Tower.Error import Data.Function ((&))@@ -37,6 +40,74 @@           mapped = svc & mapService (* 3)       result <- runService mapped ()       result `shouldBe` Left TimeoutError++  describe "Category" $ do+    it "id passes through unchanged" $ do+      let svc = Control.Category.id :: Service Int Int+      result <- runService svc 42+      result `shouldBe` Right 42++    it "composes services with >>>" $ do+      let double = Service $ \n -> pure (Right (n * 2 :: Int))+          addOne = Service $ \n -> pure (Right (n + 1 :: Int))+          composed = double >>> addOne+      result <- runService composed 10+      result `shouldBe` Right 21++    it "short-circuits on error in first service" $ do+      let failing :: Service Int Int+          failing = Service $ \_ -> pure (Left (CustomError "fail"))+          addOne = Service $ \n -> pure (Right (n + 1 :: Int))+          composed = failing >>> addOne+      result <- runService composed 10+      result `shouldBe` Left (CustomError "fail")++    it "short-circuits on error in second service" $ do+      let double = Service $ \n -> pure (Right (n * 2 :: Int))+          failing :: Service Int Int+          failing = Service $ \_ -> pure (Left (CustomError "fail"))+          composed = double >>> failing+      result <- runService composed 10+      result `shouldBe` Left (CustomError "fail")++  describe "Arrow" $ do+    it "arr lifts a pure function" $ do+      let svc = arr (* 3) :: Service Int Int+      result <- runService svc 7+      result `shouldBe` Right 21++    it "first applies to the first element of a pair" $ do+      let double = Service $ \n -> pure (Right (n * 2 :: Int))+          paired = first double+      result <- runService paired (10, "hello")+      result `shouldBe` Right (20, "hello")++    it "first propagates errors" $ do+      let failing :: Service Int Int+          failing = Service $ \_ -> pure (Left TimeoutError)+          paired = first failing+      result <- runService paired (10, "hello")+      result `shouldBe` Left TimeoutError++  describe "ArrowChoice" $ do+    it "left applies to Left values" $ do+      let double = Service $ \n -> pure (Right (n * 2 :: Int))+          choice = left double :: Service (Either Int String) (Either Int String)+      result <- runService choice (Left 5)+      result `shouldBe` Right (Left 10)++    it "left passes through Right values" $ do+      let double = Service $ \n -> pure (Right (n * 2 :: Int))+          choice = left double :: Service (Either Int String) (Either Int String)+      result <- runService choice (Right "hello")+      result `shouldBe` Right (Right "hello")++    it "left propagates errors" $ do+      let failing :: Service Int Int+          failing = Service $ \_ -> pure (Left (CustomError "boom"))+          choice = left failing :: Service (Either Int String) (Either Int String)+      result <- runService choice (Left 5)+      result `shouldBe` Left (CustomError "boom")    describe "composeMiddleware" $ do     it "applies outer then inner" $ do

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           tower-hs-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Composable service middleware for Haskell, inspired by Rust's Tower description:    tower-hs provides a composable middleware abstraction for any service type.                 Build middleware stacks with retry, timeout, circuit breaker, and more — all with