railroad 0.1.2.1 → 0.2.0.0
raw patch · 11 files changed
+365/−402 lines, 11 filesdep +QuickCheckPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck
API changes (from Hackage documentation)
- Railroad: (?>) :: forall (es :: [Effect]) e a. Error e :> es => Eff es a -> (a -> Bool) -> (a -> e) -> Eff es a
- Railroad: (??~) :: forall (es :: [Effect]) a. Bifurcate a => Eff es a -> (CErr a -> CRes a) -> Eff es (CRes a)
- Railroad: (?|) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b) => m a -> m b -> m (Either (CErr b) (CRes a))
- Railroad: (?|<>) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b, CErr a ~ CErr b, Semigroup (CErr a)) => m a -> m b -> m (Either (CErr a) (CRes a))
- Railroad: (?~) :: forall (es :: [Effect]) a. Bifurcate a => Eff es a -> CRes a -> Eff es (CRes a)
- Railroad: IsEmpty :: CardinalityError ta
- Railroad: TooMany :: ta -> CardinalityError ta
- Railroad: bifurcate :: Bifurcate f => f -> Either (CErr f) (CRes f)
- Railroad: cardinalityErr :: e -> (ta -> e) -> CardinalityError ta -> e
- Railroad: class Bifurcate f
- Railroad: data CardinalityError ta
- Railroad: infixl 0 ?@
- Railroad: instance (GHC.Internal.Data.Traversable.Traversable t, GHC.Internal.Base.Semigroup e, Railroad.CErr (t (Data.Validation.Validation e a)) GHC.Types.~ e, Railroad.CRes (t (Data.Validation.Validation e a)) GHC.Types.~ t a) => Railroad.Bifurcate (t (Data.Validation.Validation e a))
- Railroad: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.CErr (t (GHC.Internal.Data.Either.Either e a)) GHC.Types.~ e, Railroad.CRes (t (GHC.Internal.Data.Either.Either e a)) GHC.Types.~ t a) => Railroad.Bifurcate (t (GHC.Internal.Data.Either.Either e a))
- Railroad: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.CErr (t (GHC.Internal.Maybe.Maybe a)) GHC.Types.~ (), Railroad.CRes (t (GHC.Internal.Maybe.Maybe a)) GHC.Types.~ t a) => Railroad.Bifurcate (t (GHC.Internal.Maybe.Maybe a))
- Railroad: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.CErr (t GHC.Types.Bool) GHC.Types.~ (), Railroad.CRes (t GHC.Types.Bool) GHC.Types.~ t ()) => Railroad.Bifurcate (t GHC.Types.Bool)
- Railroad: instance Railroad.Bifurcate (Data.Validation.Validation e a)
- Railroad: instance Railroad.Bifurcate (GHC.Internal.Data.Either.Either e a)
- Railroad: instance Railroad.Bifurcate (GHC.Internal.Maybe.Maybe a)
- Railroad: instance Railroad.Bifurcate GHC.Types.Bool
- Railroad: type family CRes f
- Railroad.MonadError: (?>) :: forall m e a. MonadError e m => m a -> (a -> Bool) -> (a -> e) -> m a
- Railroad.MonadError: (??~) :: forall m a. (Bifurcate a, Monad m) => m a -> (CErr a -> CRes a) -> m (CRes a)
- Railroad.MonadError: (?|) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b) => m a -> m b -> m (Either (CErr b) (CRes a))
- Railroad.MonadError: (?|<>) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b, CErr a ~ CErr b, Semigroup (CErr a)) => m a -> m b -> m (Either (CErr a) (CRes a))
- Railroad.MonadError: (?~) :: forall m a. (Bifurcate a, Monad m) => m a -> CRes a -> m (CRes a)
- Railroad.MonadError: IsEmpty :: CardinalityError ta
- Railroad.MonadError: TooMany :: ta -> CardinalityError ta
- Railroad.MonadError: bifurcate :: Bifurcate f => f -> Either (CErr f) (CRes f)
- Railroad.MonadError: cardinalityErr :: e -> (ta -> e) -> CardinalityError ta -> e
- Railroad.MonadError: class Bifurcate f
- Railroad.MonadError: data CardinalityError ta
- Railroad.MonadError: infixl 0 ?@
- Railroad.MonadError: type family CRes f
+ Railroad.Bifurcate: (?>) :: Functor m => m a -> (a -> Bool) -> m (Either a a)
+ Railroad.Bifurcate: (??~) :: (Functor m, Bifurcate a) => m a -> (CErr a -> CRes a) -> m (CRes a)
+ Railroad.Bifurcate: (?|) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b) => m a -> m b -> m (Either (CErr b) (CRes a))
+ Railroad.Bifurcate: (?|<>) :: (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b, CErr a ~ CErr b, Semigroup (CErr a)) => m a -> m b -> m (Either (CErr a) (CRes a))
+ Railroad.Bifurcate: (?~) :: (Functor m, Bifurcate a) => m a -> CRes a -> m (CRes a)
+ Railroad.Bifurcate: bifurcate :: Bifurcate f => f -> Either (CErr f) (CRes f)
+ Railroad.Bifurcate: class Bifurcate f
+ Railroad.Bifurcate: infixl 1 ?|<>
+ Railroad.Bifurcate: instance (GHC.Internal.Data.Traversable.Traversable t, GHC.Internal.Base.Semigroup e, Railroad.Bifurcate.CErr (t (Data.Validation.Validation e a)) GHC.Types.~ e, Railroad.Bifurcate.CRes (t (Data.Validation.Validation e a)) GHC.Types.~ t a) => Railroad.Bifurcate.Bifurcate (t (Data.Validation.Validation e a))
+ Railroad.Bifurcate: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.Bifurcate.CErr (t (GHC.Internal.Data.Either.Either e a)) GHC.Types.~ e, Railroad.Bifurcate.CRes (t (GHC.Internal.Data.Either.Either e a)) GHC.Types.~ t a) => Railroad.Bifurcate.Bifurcate (t (GHC.Internal.Data.Either.Either e a))
+ Railroad.Bifurcate: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.Bifurcate.CErr (t (GHC.Internal.Maybe.Maybe a)) GHC.Types.~ (), Railroad.Bifurcate.CRes (t (GHC.Internal.Maybe.Maybe a)) GHC.Types.~ t a) => Railroad.Bifurcate.Bifurcate (t (GHC.Internal.Maybe.Maybe a))
+ Railroad.Bifurcate: instance (GHC.Internal.Data.Traversable.Traversable t, Railroad.Bifurcate.CErr (t GHC.Types.Bool) GHC.Types.~ (), Railroad.Bifurcate.CRes (t GHC.Types.Bool) GHC.Types.~ t ()) => Railroad.Bifurcate.Bifurcate (t GHC.Types.Bool)
+ Railroad.Bifurcate: instance Railroad.Bifurcate.Bifurcate (Data.Validation.Validation e a)
+ Railroad.Bifurcate: instance Railroad.Bifurcate.Bifurcate (GHC.Internal.Data.Either.Either e a)
+ Railroad.Bifurcate: instance Railroad.Bifurcate.Bifurcate (GHC.Internal.Maybe.Maybe a)
+ Railroad.Bifurcate: instance Railroad.Bifurcate.Bifurcate GHC.Types.Bool
+ Railroad.Bifurcate: type family CRes f
+ Railroad.Cardinality: IsEmpty :: CardinalityError ta
+ Railroad.Cardinality: TooMany :: ta -> CardinalityError ta
+ Railroad.Cardinality: cardinalityErr :: e -> (ta -> e) -> CardinalityError ta -> e
+ Railroad.Cardinality: data CardinalityError ta
- Railroad: infixl 1 ?>
+ Railroad: infixl 1 ?@
- Railroad.MonadError: infixl 1 ?>
+ Railroad.MonadError: infixl 1 ?@
Files
- CHANGELOG.md +16/−0
- railroad.cabal +7/−2
- readme.md +14/−2
- src/Railroad.hs +10/−114
- src/Railroad/Bifurcate.hs +104/−0
- src/Railroad/Cardinality.hs +17/−0
- src/Railroad/MonadError.hs +6/−23
- test/Model.hs +37/−0
- test/Railroad/BifurcateSpec.hs +78/−0
- test/Railroad/MonadErrorSpec.hs +43/−103
- test/RailroadSpec.hs +33/−158
CHANGELOG.md view
@@ -1,5 +1,21 @@ # Revision history for railroad +## 0.2.0.0 -- 2026-10-11+* Breaking: `(?>)` no longer throws. `m ?> p` tags the value (`Right a` if `p a`, else `Left a`,+ carrying the rejected value) and is finished with `?` or `??`: `(m ?> p) toErr` becomes+ `m ?> p ?? toErr`. It needs only `Functor`, so `Railroad.MonadError` re-exports the one definition.+* Breaking: all operators are now `infixl 1` (they were `infixl 0`, and `?>` was `infixl 1`), like+ `>>=`, `<&>` and `&`. `runQuery q ? err <&> f`, `f $ m ? e` and `m ? e ?> p` now parse as they read.+ Code that compiled before keeps its meaning, except where an operator was mixed with another of+ a different level.+* New modules `Railroad.Bifurcate` (the class, `CErr`, `CRes`, and the operators that never throw:+ `?>`, `??~`, `?~`, `?|`, `?|<>`) and `Railroad.Cardinality` (`CardinalityError`, `cardinalityErr`).+ `Railroad` and `Railroad.MonadError` re-export both, so imports keep working, and all three+ modules now have explicit export lists. `Railroad.MonadError` no longer imports `Railroad`.+* Breaking: `(??~)` and `(?~)` are defined once, in `Railroad.Bifurcate`, with the more general type+ `Functor m => m a -> ...` (they were `Eff es a` in `Railroad`).+* `(?|)` and `(?|<>)` simplified internally; their behaviour is unchanged.+ ## 0.1.2.1 -- 2026-10-11 * Fix overlapping instances: `Either e (Maybe a)`, `Maybe (Maybe a)`, `Either e Bool` and the like did not compile when used with `?`, so nested layers could not be peeled (the README's first
railroad.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: railroad-version: 0.1.2.1+version: 0.2.0.0 license: BSD-3-Clause license-file: LICENSE author: Frederik Kallstrup Mastratisi@@ -30,6 +30,8 @@ library import: stuff exposed-modules: Railroad+ Railroad.Bifurcate+ Railroad.Cardinality Railroad.MonadError hs-source-dirs: src default-language: GHC2021@@ -41,11 +43,14 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs- other-modules: RailroadSpec+ other-modules: Model+ RailroadSpec+ Railroad.BifurcateSpec Railroad.MonadErrorSpec build-tool-depends: hspec-discover:hspec-discover >= 2.11.14 && < 2.12 build-depends: base >=4.17 && < 4.23, hspec >= 2.11.14 && < 2.12,+ QuickCheck >= 2.14 && < 2.16, railroad
readme.md view
@@ -58,6 +58,14 @@ --- +## Modules++- `Railroad`: the operators for the `effectful` `Error` effect.+- `Railroad.MonadError`: the same operators for any `MonadError` (`mtl`, `ExceptT`, servant's `Handler`).+- `Railroad.Bifurcate`: the `Bifurcate` class and the operators that never throw+ (`?>`, `?~`, `??~`, `?|`, `?|<>`); `Railroad.Cardinality`: `CardinalityError`.+ Both of the above re-export these, so you rarely import them directly.+ ## Install ### Nix@@ -137,7 +145,7 @@ |----------|-----------------------------------------------|-------------------------------| | `??` | Derail on error with custom error mapping | `action ?? toMyError` | | `?` | Derail with constant error | `action ? MyError` |-| `?>` | Derail on predicate | `(action ?> isGood) toErr` |+| `?>` | Tag by predicate (`Left` carries the value) | `action ?> isGood ? NotGood` | | `??~` | Recover with a mapped default (error → value) | `action ??~ toDefaultVal` | | `?~` | Recover with a const default value | `action ?~ defaultVal` | | `?+` | Derail on empty collection | `items ?+ NoResults` |@@ -147,6 +155,10 @@ | `?\|<>` | Fall back, combining the errors with `<>` | `a ?\|<> b ?? toErr` | +All operators are `infixl 1`, like `>>=`, `<&>` and `&`, so they chain+left to right with them without parentheses:+`runQuery q ? err503 <&> toDTO`.+ For the semantics of the operators there are 3 relevant questions: What counts as an error? What happens in the error case? What happens in the success case?@@ -209,7 +221,7 @@ [validation](https://hackage.haskell.org/package/validation/docs/Data-Validation.html) package on Hackage. ### What happens in the success case?-In the success case the result is unwrapped or validated (`?>`, `?+`)+In the success case the result is unwrapped or validated (`?+`, `?!`) and the monad continues its execution. Result Info in the above tables shows the resulting type inside the monad.
src/Railroad.hs view
@@ -1,75 +1,24 @@+{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-} -- | -- Railway-oriented operators: turn a failure in a 'Bifurcate' structure (@Bool@, @Maybe@, -- @Either@, @Validation@, traversables of them) or a bad cardinality into a throw in the -- @Error@ effect, keeping the happy path clean. For @MonadError@ use "Railroad.MonadError".-module Railroad where+module Railroad+ ( module Railroad.Bifurcate+ , module Railroad.Cardinality+ , collapse+ , (??), (?), (?+), (?!), (?∅), (?@)+ ) where -import Data.Bool (bool) import Data.Foldable (toList)-import Data.Kind (Type)-import Data.Validation (Validation (..)) import Effectful (Eff, type (:>)) import Effectful.Error.Dynamic (Error, throwError_)+import Railroad.Bifurcate+import Railroad.Cardinality --- | What the failure case carries: @()@ for 'Bool' and 'Maybe', @e@ for 'Either' and--- 'Validation', that of the element for a traversable.-type family CErr f :: Type where- CErr Bool = ()- CErr (Maybe a) = ()- CErr (Either e a) = e- CErr (Validation e a) = e- CErr (t a) = CErr a--- | What the success case carries: @()@ for 'Bool', @a@ for 'Maybe', 'Either' and--- 'Validation', @t (CRes a)@ for a traversable @t a@.-type family CRes f :: Type where- CRes Bool = ()- CRes (Maybe a) = a- CRes (Either e a) = a- CRes (Validation e a) = a- CRes (t a) = t (CRes a)---- | A catamorphism to Either-class Bifurcate f where- bifurcate :: f -> Either (CErr f) (CRes f)-instance Bifurcate Bool where- bifurcate = bool (Left ()) (Right ())- -- bool :: b -> b -> Bool -> b-instance Bifurcate (Maybe a) where- bifurcate = maybe (Left ()) Right- -- maybe :: b -> (a -> b) -> Maybe a -> b-instance Bifurcate (Either e a) where- bifurcate = id- -- either :: (e -> b) -> (a -> b) -> Either e a -> b-instance Bifurcate (Validation e a) where- bifurcate = \case- Failure e -> Left e- Success a -> Right a- -- validation :: (e -> b) -> (a -> b) -> Validation e a -> b---- The traversable instances overlap the base ones for e.g. @Either e (Maybe a)@. They are--- INCOHERENT so the base instance wins and the outer layer is peeled first (@m ? e1 ? e2@).-instance {-# INCOHERENT #-} (Traversable t, CErr (t Bool) ~ (), CRes (t Bool) ~ t ())- => Bifurcate (t Bool) where- bifurcate = bifurcate . sequenceA . fmap bifurcate- -- Bool is not Applicative, so we need to map to Either first-instance {-# INCOHERENT #-} (Traversable t, CErr (t (Maybe a)) ~ (), CRes (t (Maybe a)) ~ t a)- => Bifurcate (t (Maybe a)) where- bifurcate = bifurcate . sequenceA-instance {-# INCOHERENT #-} (Traversable t, CErr (t (Either e a)) ~ e, CRes (t (Either e a)) ~ t a)- => Bifurcate (t (Either e a)) where- bifurcate = sequenceA- -- pedagogically: bifurcate = bifurcate . sequenceA-instance {-# INCOHERENT #-} (Traversable t, Semigroup e, CErr (t (Validation e a)) ~ e, CRes (t (Validation e a)) ~ t a)- => Bifurcate (t (Validation e a)) where- bifurcate = bifurcate . sequenceA- -- | Unwraps the success case, or throws the failure mapped by the function. collapse :: (Error e :> es, Bifurcate f) => (CErr f -> e) -> f -> Eff es (CRes f) collapse toErr = either (throwError_ . toErr) pure . bifurcate@@ -84,59 +33,7 @@ (?) :: forall es e a. (Error e :> es, Bifurcate a) => Eff es a -> e -> Eff es (CRes a) action ? err = action ?? const err --- | Passes the value on if it satisfies the predicate, else throws the error built from--- it: @(m ?> p) toErr@.-(?>) :: forall es e a. (Error e :> es) => Eff es a -> (a -> Bool) -> (a -> e) -> Eff es a-(?>) action predicate toErr = do- val <- action- if predicate val then pure val else throwError_ $ toErr val --- | Unwraps the success case, or recovers with a value computed from the error info.-(??~) :: forall es a. Bifurcate a => Eff es a -> (CErr a -> CRes a) -> Eff es (CRes a)-action ??~ defaultFunc = action >>= either (pure . defaultFunc) pure . bifurcate---- | Unwraps the success case, or recovers with a default value.-(?~) :: forall es a. Bifurcate a => Eff es a -> CRes a -> Eff es (CRes a)-action ?~ defaultVal = action ??~ (const defaultVal)----- | Fallback: runs the right action only if the left fails. The sides may be different--- structures with the same success type; the last error is kept. Finish with '?' or '??'.------ > cache k ?| db k ?| legacy k ? NotFound-(?|) :: forall m a b. (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b)- => m a -> m b -> m (Either (CErr b) (CRes a))-ma ?| mb = do- a <- ma- case bifurcate a of- Right x -> pure (Right x)- Left _ -> bifurcate <$> mb---- | Like '?|', but if every source fails their errors are combined with '<>', in order.--- The sides must also share the error type; map it to a common one first.-(?|<>) :: forall m a b. ( Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b- , CErr a ~ CErr b, Semigroup (CErr a) )- => m a -> m b -> m (Either (CErr a) (CRes a))-ma ?|<> mb = do- a <- ma- case bifurcate a of- Right x -> pure (Right x)- Left ea -> do- b <- mb- pure $ case bifurcate b of- Right y -> Right y- Left eb -> Left (ea <> eb)---- | Why a collection was not a single element: empty, or too many (carrying it).-data CardinalityError ta = IsEmpty | TooMany ta---- | Fold for 'CardinalityError': one result per case.-cardinalityErr :: e -> (ta -> e) -> CardinalityError ta -> e-cardinalityErr onEmpty onTooMany = \case- IsEmpty -> onEmpty- TooMany xs -> onTooMany xs-- -- | Succeeds if non-empty, returning the collection; else throws the constant error. (?+) :: forall es e t a. (Error e :> es, Foldable t) => Eff es (t a) -> e -> Eff es (t a)@@ -169,5 +66,4 @@ => Eff es (t a) -> ((t a) -> e) -> Eff es () (?@) = (?∅) -infixl 0 ??, ?, ??~, ?~, ?!, ?+, ?∅, ?@, ?|, ?|<>-infixl 1 ?>+infixl 1 ??, ?, ?!, ?+, ?∅, ?@
+ src/Railroad/Bifurcate.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- The 'Bifurcate' class, which splits a structure (@Bool@, @Maybe@, @Either@, @Validation@,+-- traversables of them) into a failure and a success case, and the operators that never+-- throw. The throwing operators are in "Railroad" and "Railroad.MonadError".+module Railroad.Bifurcate+ ( Bifurcate (..), CErr, CRes+ , (?>), (??~), (?~), (?|), (?|<>)+ ) where++import Data.Bifunctor (first)+import Data.Bool (bool)+import Data.Kind (Type)+import Data.Validation (Validation (..))+++-- | What the failure case carries: @()@ for 'Bool' and 'Maybe', @e@ for 'Either' and+-- 'Validation', that of the element for a traversable.+type family CErr f :: Type where+ CErr Bool = ()+ CErr (Maybe a) = ()+ CErr (Either e a) = e+ CErr (Validation e a) = e+ CErr (t a) = CErr a+-- | What the success case carries: @()@ for 'Bool', @a@ for 'Maybe', 'Either' and+-- 'Validation', @t (CRes a)@ for a traversable @t a@.+type family CRes f :: Type where+ CRes Bool = ()+ CRes (Maybe a) = a+ CRes (Either e a) = a+ CRes (Validation e a) = a+ CRes (t a) = t (CRes a)++-- | A catamorphism to Either+class Bifurcate f where+ bifurcate :: f -> Either (CErr f) (CRes f)+instance Bifurcate Bool where+ bifurcate = bool (Left ()) (Right ())+ -- bool :: b -> b -> Bool -> b+instance Bifurcate (Maybe a) where+ bifurcate = maybe (Left ()) Right+ -- maybe :: b -> (a -> b) -> Maybe a -> b+instance Bifurcate (Either e a) where+ bifurcate = id+ -- either :: (e -> b) -> (a -> b) -> Either e a -> b+instance Bifurcate (Validation e a) where+ bifurcate = \case+ Failure e -> Left e+ Success a -> Right a+ -- validation :: (e -> b) -> (a -> b) -> Validation e a -> b++-- The traversable instances overlap the base ones for e.g. @Either e (Maybe a)@. They are+-- INCOHERENT so the base instance wins and the outer layer is peeled first (@m ? e1 ? e2@).+instance {-# INCOHERENT #-} (Traversable t, CErr (t Bool) ~ (), CRes (t Bool) ~ t ())+ => Bifurcate (t Bool) where+ bifurcate = bifurcate . sequenceA . fmap bifurcate+ -- Bool is not Applicative, so we need to map to Either first+instance {-# INCOHERENT #-} (Traversable t, CErr (t (Maybe a)) ~ (), CRes (t (Maybe a)) ~ t a)+ => Bifurcate (t (Maybe a)) where+ bifurcate = bifurcate . sequenceA+instance {-# INCOHERENT #-} (Traversable t, CErr (t (Either e a)) ~ e, CRes (t (Either e a)) ~ t a)+ => Bifurcate (t (Either e a)) where+ bifurcate = sequenceA+ -- pedagogically: bifurcate = bifurcate . sequenceA+instance {-# INCOHERENT #-} (Traversable t, Semigroup e, CErr (t (Validation e a)) ~ e, CRes (t (Validation e a)) ~ t a)+ => Bifurcate (t (Validation e a)) where+ bifurcate = bifurcate . sequenceA+++-- | Tags the value: @Right@ if it satisfies the predicate, else @Left@ carrying it. Finish+-- with @?@ or @??@ (the mapper sees the rejected value): @m ?> p ? err@.+(?>) :: forall m a. Functor m => m a -> (a -> Bool) -> m (Either a a)+action ?> predicate = (\x -> if predicate x then Right x else Left x) <$> action++-- | Unwraps the success case, or recovers with a value computed from the error info.+(??~) :: forall m a. (Functor m, Bifurcate a) => m a -> (CErr a -> CRes a) -> m (CRes a)+action ??~ defaultFunc = either defaultFunc id . bifurcate <$> action++-- | Unwraps the success case, or recovers with a default value.+(?~) :: forall m a. (Functor m, Bifurcate a) => m a -> CRes a -> m (CRes a)+action ?~ defaultVal = action ??~ const defaultVal+++-- | Fallback: runs the right action only if the left fails. The sides may be different+-- structures with the same success type; the last error is kept. Finish with @?@ or @??@.+--+-- > cache k ?| db k ?| legacy k ? NotFound+(?|) :: forall m a b. (Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b)+ => m a -> m b -> m (Either (CErr b) (CRes a))+ma ?| mb = ma >>= either (const (bifurcate <$> mb)) (pure . Right) . bifurcate++-- | Like '?|', but if every source fails their errors are combined with '<>', in order.+-- The sides must also share the error type; map it to a common one first.+(?|<>) :: forall m a b. ( Monad m, Bifurcate a, Bifurcate b, CRes a ~ CRes b+ , CErr a ~ CErr b, Semigroup (CErr a) )+ => m a -> m b -> m (Either (CErr a) (CRes a))+ma ?|<> mb = ma >>= either (\ea -> first (ea <>) . bifurcate <$> mb) (pure . Right) . bifurcate++infixl 1 ??~, ?~, ?|, ?|<>, ?>
+ src/Railroad/Cardinality.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE LambdaCase #-}++-- |+-- The error info of the cardinality operators (@?!@ in "Railroad" and "Railroad.MonadError"):+-- why a collection was not a single element.+module Railroad.Cardinality+ ( CardinalityError (..), cardinalityErr+ ) where++-- | Why a collection was not a single element: empty, or too many (carrying it).+data CardinalityError ta = IsEmpty | TooMany ta++-- | Fold for 'CardinalityError': one result per case.+cardinalityErr :: e -> (ta -> e) -> CardinalityError ta -> e+cardinalityErr onEmpty onTooMany = \case+ IsEmpty -> onEmpty+ TooMany xs -> onTooMany xs
src/Railroad/MonadError.hs view
@@ -5,16 +5,16 @@ {-# LANGUAGE FlexibleContexts #-} module Railroad.MonadError- ( module Railroad -- re-exports CErr, CRes, Bifurcate, CardinalityError, etc.+ ( module Railroad.Bifurcate+ , module Railroad.Cardinality , collapse- , (??), (?), (?>), (??~), (?~), (?+), (?!), (?∅), (?@)+ , (??), (?), (?+), (?!), (?∅), (?@) ) where -import Railroad hiding (collapse, (?!), (?), (?+), (?>),- (??), (??~), (?@), (?~), (?∅))- import Control.Monad.Except (MonadError (..)) import Data.Foldable (toList)+import Railroad.Bifurcate+import Railroad.Cardinality -- | Unwraps the success case, or throws the failure mapped by the function. collapse :: (MonadError e m, Bifurcate f)@@ -32,22 +32,6 @@ => m a -> e -> m (CRes a) action ? err = action ?? const err --- | Passes the value on if it satisfies the predicate, else throws the error built from--- it: @(m ?> p) toErr@.-(?>) :: forall m e a. (MonadError e m)- => m a -> (a -> Bool) -> (a -> e) -> m a-(?>) action predicate toErr = do- val <- action- if predicate val then pure val else throwError $ toErr val---- | Unwraps the success case, or recovers with a value computed from the error info.-(??~) :: forall m a. (Bifurcate a, Monad m) => m a -> (CErr a -> CRes a) -> m (CRes a)-action ??~ defaultFunc = action >>= either (pure . defaultFunc) pure . bifurcate---- | Unwraps the success case, or recovers with a default value.-(?~) :: forall m a. (Bifurcate a, Monad m) => m a -> CRes a -> m (CRes a)-action ?~ defaultVal = action ??~ (const defaultVal)- -- | Succeeds if non-empty, returning the collection; else throws the constant error. (?+) :: forall m e t a. (MonadError e m, Foldable t) => m (t a) -> e -> m (t a)@@ -78,5 +62,4 @@ => m (t a) -> (t a -> e) -> m () (?@) = (?∅) -infixl 0 ??, ?, ??~, ?~, ?!, ?+, ?∅, ?@-infixl 1 ?>+infixl 1 ??, ?, ?!, ?+, ?∅, ?@
+ test/Model.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Shared by the specs: generators, the shapes the laws are run over, and helpers.+module Model+ ( Shape, forShapes+ ) where++import Data.Validation (Validation (..))+import Data.Proxy (Proxy (..))+import Railroad.Bifurcate+import Test.Hspec+import Test.QuickCheck hiding (Result (..))++instance (Arbitrary e, Arbitrary a) => Arbitrary (Validation e a) where+ arbitrary = oneof [Failure <$> arbitrary, Success <$> arbitrary]++-- | Everything a law needs to generate, compare and show a bifurcatable value.+type Shape a =+ ( Bifurcate a, Arbitrary a, Show a+ , Show (CErr a), Eq (CErr a), Function (CErr a), CoArbitrary (CErr a)+ , Show (CRes a), Eq (CRes a), Arbitrary (CRes a) )++-- | Run one property over the base structures, traversables of them, and layered shapes.+forShapes :: String -> (forall a. Shape a => Proxy a -> Property) -> Spec+forShapes name prop = describe name $ do+ it "Bool" $ prop (Proxy @Bool)+ it "Maybe" $ prop (Proxy @(Maybe Int))+ it "Either" $ prop (Proxy @(Either Int Int))+ it "Validation" $ prop (Proxy @(Validation [Int] Int))+ it "[Bool]" $ prop (Proxy @[Bool])+ it "[Maybe]" $ prop (Proxy @[Maybe Int])+ it "[Either]" $ prop (Proxy @[Either Int Int])+ it "[Validation]" $ prop (Proxy @[Validation [Int] Int])+ it "Either of Maybe" $ prop (Proxy @(Either Int (Maybe Int)))+ it "Maybe of Maybe" $ prop (Proxy @(Maybe (Maybe Int)))+ it "Either of Bool" $ prop (Proxy @(Either Int Bool))
+ test/Railroad/BifurcateSpec.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE TypeFamilies #-}++module Railroad.BifurcateSpec where++import Control.Monad.State (modify, runState)+import Data.Bifunctor (first)+import Data.Either (isLeft)+import Data.Functor.Identity+import Data.Maybe (listToMaybe)+import Data.Proxy (Proxy (..))+import Data.Validation (Validation (..))+import Model+import Railroad.Bifurcate+import Test.Hspec+import Test.QuickCheck hiding (Result (..))++spec :: Spec+spec = do+ describe "bifurcate" $ do+ it "Bool" $ property $ \b ->+ bifurcate b === (if b then Right () else Left ())+ it "Maybe" $ property $ \(m :: Maybe Int) ->+ bifurcate m === maybe (Left ()) Right m+ it "Either is the identity" $ property $ \(e :: Either Int Int) ->+ bifurcate e === e+ it "Validation" $ property $ \(v :: Validation Int Int) ->+ bifurcate v === (case v of Failure e -> Left e; Success a -> Right a)+ it "a traversable of Bool or Maybe succeeds only if every element does" $ property $+ \(bs :: [Bool]) (ms :: [Maybe Int]) ->+ (bifurcate bs === (if and bs then Right (map (const ()) bs) else Left ()))+ .&&. (bifurcate ms === maybe (Left ()) Right (sequence ms))+ it "a traversable of Either stops at the first error" $ property $ \(xs :: [Either Int Int]) ->+ bifurcate xs === maybe (Right [a | Right a <- xs]) Left (listToMaybe [e | Left e <- xs])+ it "a traversable of Validation accumulates every error" $ property $ \(xs :: [Validation [Int] Int]) ->+ bifurcate xs === (case [e | Failure e <- xs] of+ [] -> Right [a | Success a <- xs]+ es -> Left (concat es))+ it "peels only the outermost base layer" $ property $+ \(e :: Either Int (Maybe Int)) (m :: Maybe (Maybe Int)) (b :: Either Int Bool) ->+ (bifurcate e === e) .&&. (bifurcate m === maybe (Left ()) Right m) .&&. (bifurcate b === b)++ describe "?>" $ do+ it "tags by the predicate, keeping the value on both sides" $ property $ \(a :: Int) ->+ runIdentity (pure a ?> even) === (if even a then Right a else Left a)++ forShapes "?~ and ??~ recover from a failure" $ \(_ :: Proxy a) -> property $+ \(x :: a) (d :: CRes a) (Fn f :: Fun (CErr a) (CRes a)) ->+ (runIdentity (pure x ?~ d) === either (const d) id (bifurcate x))+ .&&. (runIdentity (pure x ??~ f) === either f id (bifurcate x))++ describe "?| (fallback, last error kept)" $ do+ let law :: forall a b. (Shape a, Shape b, CRes a ~ CRes b) => Proxy a -> Proxy b -> Property+ law _ _ = property $ \(x :: a) (y :: b) ->+ runIdentity (pure x ?| pure y) === either (const (bifurcate y)) Right (bifurcate x)+ shortCircuits :: forall a b. (Shape a, Shape b, CRes a ~ CRes b) => Proxy a -> Proxy b -> Property+ shortCircuits _ _ = property $ \(x :: a) (y :: b) ->+ snd (runState (pure x ?| (modify (+ (1 :: Int)) >> pure y)) 0)+ === (if isLeft (bifurcate x) then 1 else 0)+ it "Maybe, Either" $ law (Proxy @(Maybe Int)) (Proxy @(Either Int Int))+ it "Either, Maybe" $ law (Proxy @(Either Int Int)) (Proxy @(Maybe Int))+ it "Validation, Either" $ law (Proxy @(Validation Int Int)) (Proxy @(Either Int Int))+ it "[Maybe], [Either]" $ law (Proxy @[Maybe Int]) (Proxy @[Either Int Int])+ it "runs the right action only when the left fails" $ shortCircuits (Proxy @(Either Int Int)) (Proxy @(Maybe Int))+ it "is associative" $ property $ \(a :: Either Int Int) (b :: Either Int Int) (c :: Either Int Int) ->+ runIdentity ((pure a ?| pure b) ?| pure c) === runIdentity (pure a ?| (pure b ?| pure c))++ describe "?|<> (fallback, errors combined with <>)" $ do+ let law :: forall a b. (Shape a, Shape b, CRes a ~ CRes b, CErr a ~ CErr b, Semigroup (CErr a))+ => Proxy a -> Proxy b -> Property+ law _ _ = property $ \(x :: a) (y :: b) ->+ runIdentity (pure x ?|<> pure y)+ === either (\ex -> first (ex <>) (bifurcate y)) Right (bifurcate x)+ it "Either, Validation" $ law (Proxy @(Either [Int] Int)) (Proxy @(Validation [Int] Int))+ it "Validation, Either" $ law (Proxy @(Validation [Int] Int)) (Proxy @(Either [Int] Int))+ it "Maybe, Maybe" $ law (Proxy @(Maybe Int)) (Proxy @(Maybe Int))+ it "[Either], [Either]" $ law (Proxy @[Either [Int] Int]) (Proxy @[Either [Int] Int])+ it "is associative" $ property $ \(a :: Either [Int] Int) (b :: Either [Int] Int) (c :: Either [Int] Int) ->+ runIdentity ((pure a ?|<> pure b) ?|<> pure c) === runIdentity (pure a ?|<> (pure b ?|<> pure c))
test/Railroad/MonadErrorSpec.hs view
@@ -4,119 +4,59 @@ module Railroad.MonadErrorSpec where import Control.Monad.Except-import Control.Monad.State (State, modify, runState)-import Data.Validation (Validation (..))+import Data.Bifunctor (first)+import Data.Functor ((<&>)) import Data.Functor.Identity+import Data.Proxy (Proxy (..))+import Model import Railroad.MonadError import Test.Hspec+import Test.QuickCheck -- Helper to run MonadError computations in pure Either runMonadError :: ExceptT String Identity a -> Either String a runMonadError = runIdentity . runExceptT --- Like 'runMonadError', and counts how many 'tick's ran.-runCount :: ExceptT String (State Int) a -> (Either String a, Int)-runCount m = runState (runExceptT m) 0--tick :: ExceptT String (State Int) ()-tick = modify (+ 1)- spec :: Spec spec = do- describe "MonadError version of Operators" $ do- describe "Basic Operators (? and ??)" $ do- it "unwraps success values with (?)" $ do- runMonadError (pure (Just 10 :: Maybe Int) ? "missing") `shouldBe` Right 10- it "throws constant error on failure with (?)" $ do- runMonadError (pure (Nothing :: Maybe ()) ? "missing") `shouldBe` Left "missing"- it "maps internal errors with (??)" $ do- let action = pure (Left "original" :: Either String String)- runMonadError (action ?? reverse) `shouldBe` Left "lanigiro"-- describe "Predicate Operator (?>)" $ do- it "passes when predicate is met" $ do- runMonadError (pure (10 :: Int) ?> (> 5) $ const "too small") `shouldBe` Right 10- it "fails when predicate is not met" $ do- runMonadError (pure (4 :: Int) ?> (> 5) $ const "too small") `shouldBe` Left "too small"-- describe "Recovery Operators (?~ and ??~)" $ do- it "recovers to a constant value with (?~)" $ do- runMonadError (pure Nothing ?~ 0) `shouldBe` Right (0 :: Int)- it "recovers using a function with (??~)" $ do- runMonadError (pure (Left "err") ??~ length) `shouldBe` Right 3-- describe "Cardinality Operators" $ do- describe "(?+)" $ do- it "succeeds on non-empty list" $ do- runMonadError (pure [1, 2, 3 :: Int] ?+ "empty") `shouldBe` Right [1, 2, 3]- it "fails on empty list" $ do- runMonadError (pure ([] :: [Int]) ?+ "empty") `shouldBe` Left "empty"-- describe "(?!)" $ do- let toErr = cardinalityErr "none" (const "too many")- it "extracts the single element" $ do- runMonadError (pure [42 :: Int] ?! toErr) `shouldBe` Right 42- it "fails on empty" $ do- runMonadError (pure ([] :: [Int]) ?! toErr) `shouldBe` Left "none"- it "fails on multiple elements" $ do- runMonadError (pure [1, 2 :: Int] ?! toErr) `shouldBe` Left "too many"-- describe "(?∅)" $ do- it "succeeds on empty" $ do- runMonadError (pure [] ?∅ const "not empty") `shouldBe` Right ()- it "fails on non-empty" $ do- runMonadError (pure [1 :: Int] ?∅ const "not empty") `shouldBe` Left "not empty"+ forShapes "collapse, ?? and ? throw the mapped error info, else unwrap" $ \(_ :: Proxy a) ->+ property $ \(x :: a) ->+ (runMonadError (collapse show x) === first show (bifurcate x))+ .&&. (runMonadError (pure x ?? show) === first show (bifurcate x))+ .&&. (runMonadError (pure x ? "boom") === first (const "boom") (bifurcate x)) - describe "Fallback Operator (?|)" $ do- it "does not run the right action when the left succeeds" $ do- runCount (pure (Just 'a') ?| (tick >> pure (Nothing :: Maybe Char)) ? "none")- `shouldBe` (Right 'a', 0)- it "runs the right action when the left fails" $ do- runCount (pure (Nothing :: Maybe Int) ?| (tick >> pure (Just 7)) ? "none")- `shouldBe` (Right 7, 1)- it "keeps the last error when everything fails" $ do- runCount (pure (Left "first" :: Either String Int) ?| pure (Left "second") ?? id)- `shouldBe` (Left "second", 0)- runCount (pure (Nothing :: Maybe Int) ?| pure Nothing ? "none")- `shouldBe` (Left "none", 0)- it "chains mixed structures, stopping at the first success" $ do- let chain = pure (Nothing :: Maybe Int) ?| pure (Left "db" :: Either String Int)- ?| (tick >> pure (Just 3)) ?| (tick >> tick >> pure (Just 4)) ? "gone"- runCount chain `shouldBe` (Right 3, 1)+ describe "cardinality operators" $ do+ it "?+ succeeds on a non-empty collection" $ property $ \(xs :: [Int]) ->+ runMonadError (pure xs ?+ "empty") === (if null xs then Left "empty" else Right xs)+ it "?! succeeds on exactly one element" $ property $ \(xs :: [Int]) ->+ runMonadError (pure xs ?! cardinalityErr "none" (\ys -> "many " ++ show (length ys)))+ === (case xs of { [] -> Left "none"; [x] -> Right x; _ -> Left ("many " ++ show (length xs)) })+ it "?∅ and ?@ succeed on an empty collection" $ property $ \(xs :: [Int]) ->+ let model = if null xs then Right () else Left ("got " ++ show (length xs))+ in (runMonadError (pure xs ?∅ (\ys -> "got " ++ show (length ys))) === model)+ .&&. (runMonadError (pure xs ?@ (\ys -> "got " ++ show (length ys))) === model) - describe "Accumulating Fallback Operator (?|<>)" $ do- it "does not run the right action when the left succeeds" $ do- runCount (pure (Just 'a') ?|<> (tick >> pure (Nothing :: Maybe Char)) ? "none")- `shouldBe` (Right 'a', 0)- it "combines the errors in source order when everything fails" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Left "B") ?|<> pure (Left "C") ?? id)- `shouldBe` (Left "ABC", 0)- it "mixes structures with the same error and success types" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Failure "B" :: Validation String Int) ?? id)- `shouldBe` (Left "AB", 0)- runCount (pure (Left "A" :: Either String Int) ?|<> (tick >> pure (Success 5 :: Validation String Int)) ?? id)- `shouldBe` (Right 5, 1)- it "drops earlier errors once a later source succeeds" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Left "B") ?|<> pure (Right 3) ?? id)- `shouldBe` (Right 3, 0)- it "needs nothing special for Maybe sources" $ do- runCount (pure (Nothing :: Maybe Int) ?|<> pure Nothing ? "none")- `shouldBe` (Left "none", 0)+ describe "fixity (all operators are infixl 1, like >>=, <&> and &)" $ do+ it "composes with <&> without parentheses" $ do+ runMonadError (pure (Right 2 :: Either String Int) ? "e" <&> (+ 1)) `shouldBe` Right 3+ it "composes with $" $ do+ runMonadError (fmap negate $ pure (Just 2 :: Maybe Int) ? "e") `shouldBe` Right (-2)+ it "chains ? and ?> left to right" $ do+ runMonadError (pure (Just 7 :: Maybe Int) ? "none" ?> (> 5) ? "small") `shouldBe` Right 7+ runMonadError (pure (Just 3 :: Maybe Int) ? "none" ?> (> 5) ? "small") `shouldBe` Left "small"+ it "chains the fallback with ? and ?>" $ do+ runMonadError (pure (Nothing :: Maybe Int) ?| pure (Right 9 :: Either String Int) ? "none" ?> (> 5) ? "small")+ `shouldBe` Right 9+ it "gives the rejected value of ?> to the error mapper" $ do+ runMonadError (pure (4 :: Int) ?> (> 5) ?? \n -> "rejected " ++ show n) `shouldBe` Left "rejected 4" - describe "Layered structures (the outermost layer is peeled first)" $ do- it "peels Either of Maybe one layer at a time" $ do- runMonadError (pure (Right (Just 1) :: Either String (Maybe Int)) ? "outer" ? "inner") `shouldBe` Right 1- runMonadError (pure (Right Nothing :: Either String (Maybe Int)) ? "outer" ? "inner") `shouldBe` Left "inner"- runMonadError (pure (Left "x" :: Either String (Maybe Int)) ? "outer" ? "inner") `shouldBe` Left "outer"- it "peels Maybe of Maybe and Either of Bool" $ do- runMonadError (pure (Just Nothing :: Maybe (Maybe Int)) ? "o" ? "i") `shouldBe` Left "i"- runMonadError (pure (Right False :: Either String Bool) ? "db" ? "denied") `shouldBe` Left "denied"- it "runs the README example" $ do- let readmeExample :: Either String Int- readmeExample = runExcept $ do- x <- pure (Just 2) ? "Value missing"- y <- pure (Right $ Just 1) ? "Outer fail" ? "Inner fail"- z <- pure [Just 4] ? "List failed" ?! const "Not a single element"- q <- pure Nothing ?~ 1- pure (x + y + z + q)- readmeExample `shouldBe` Right 8+ describe "README" $ do+ it "runs the first example" $ do+ let readmeExample :: Either String Int+ readmeExample = runExcept $ do+ x <- pure (Just 2) ? "Value missing"+ y <- pure (Right $ Just 1) ? "Outer fail" ? "Inner fail"+ z <- pure [Just 4] ? "List failed" ?! const "Not a single element"+ q <- pure Nothing ?~ 1+ pure (x + y + z + q)+ readmeExample `shouldBe` Right 8
test/RailroadSpec.hs view
@@ -2,174 +2,49 @@ {-# LANGUAGE TypeApplications #-} module RailroadSpec where --import Data.Validation+import Data.Bifunctor (first)+import Data.Functor ((<&>))+import Data.Proxy (Proxy (..)) import Effectful import Effectful.Error.Dynamic-import Effectful.State.Static.Local+import Model import Railroad import Test.Hspec+import Test.QuickCheck -- Helper to run the Railroad effects in a pure context runRail :: Eff '[Error String] a -> Either String a runRail = runPureEff . runErrorNoCallStack --- Like 'runRail', and counts how many 'tick's ran.-runCount :: Eff '[Error String, State Int] a -> (Either String a, Int)-runCount = runPureEff . runState 0 . runErrorNoCallStack--tick :: State Int :> es => Eff es ()-tick = modify (+ (1 :: Int))- spec :: Spec spec = do- describe "Bifurcate Instances" $ do- it "bifurcates Bool" $ do- bifurcate True `shouldBe` (Right () :: Either () ())- bifurcate False `shouldBe` (Left () :: Either () ())-- it "bifurcates Maybe" $ do- bifurcate (Just 5) `shouldBe` (Right 5 :: Either () Int)- bifurcate (Nothing :: Maybe Int) `shouldBe` (Left () :: Either () Int)-- it "bifurcates Either" $ do- bifurcate (Right 5 :: Either String Int) `shouldBe` Right 5- bifurcate (Left "fire" :: Either String Int) `shouldBe` Left "fire"-- it "bifurcates Validation" $ do- bifurcate (Success 10 :: Validation String Int) `shouldBe` Right 10- bifurcate (Failure "ice" :: Validation String Int) `shouldBe` Left "ice"-- it "bifurcates List of Bool" $ do- bifurcate [True, True] `shouldBe` (Right [(), ()] :: Either () [()])- bifurcate [True, False, True] `shouldBe` (Left () :: Either () [()])-- it "bifurcates List of Maybe" $ do- bifurcate [Just 1, Just 2] `shouldBe` (Right [1, 2] :: Either () [Int])- bifurcate [Just 1, Nothing] `shouldBe` (Left () :: Either () [Int])-- it "bifurcates List of Either" $ do- let input0 = [Right 1, Right 2] :: [Either String Int]- bifurcate input0 `shouldBe` Right [1, 2]- let input1 = [Right 1, Left "first", Left "second"] :: [Either String Int]- bifurcate input1 `shouldBe` Left "first"-- it "List of Validation (Error Accumulation)" $ do- let allOk = [Success 1, Success 2] :: [Validation String Int]- bifurcate allOk `shouldBe` Right [1, 2]- -- Note: Validation accumulates because String is a Semigroup- let someBad = [Success 1, Failure "Fail A ", Failure "Fail B"] :: [Validation String Int]- bifurcate someBad `shouldBe` Left "Fail A Fail B"-- describe "Basic Operators (? and ??)" $ do- it "unwraps success values with (?)" $ do- runRail (pure (Just 10 :: Maybe Int) ? "missing") `shouldBe` Right 10-- it "throws constant error on failure with (?)" $ do- runRail (pure (Nothing :: Maybe ()) ? "missing") `shouldBe` Left "missing"-- it "maps internal errors with (??)" $ do- let action = pure (Left "original" :: Either String String)- runRail (action ?? reverse) `shouldBe` Left "lanigiro"-- describe "Predicate Operator (?>)" $ do- it "passes when predicate is met" $ do- runRail (pure (10 :: Int) ?> (> 5) $ const "too small") `shouldBe` Right 10-- it "fails when predicate is not met" $ do- runRail (pure (4 :: Int) ?> (> 5) $ const "too small") `shouldBe` Left "too small"-- describe "Recovery Operators (?~ and ??~)" $ do- it "recovers to a constant value with (?~)" $ do- runPureEff (pure Nothing ?~ 0) `shouldBe` (0 :: Int)-- it "recovers using a function with (??~)" $ do- runPureEff (pure (Left "err") ??~ length) `shouldBe` 3-- describe "Cardinality Operators" $ do- describe "(?+)" $ do- it "succeeds on non-empty list" $ do- runRail (pure [1, 2, 3 :: Int] ?+ "empty") `shouldBe` Right [1, 2, 3]- it "fails on empty list" $ do- runRail (pure ([] :: [Int]) ?+ "empty") `shouldBe` Left "empty"-- describe "(?!)" $ do- let toErr = cardinalityErr "none" (const "too many")- it "extracts the single element" $ do- runRail (pure [42 :: Int] ?! toErr) `shouldBe` Right 42- it "fails on empty" $ do- runRail (pure ([] :: [Int]) ?! toErr) `shouldBe` Left "none"- it "fails on multiple elements" $ do- runRail (pure [1, 2 :: Int] ?! toErr) `shouldBe` Left "too many"-- describe "(?∅)" $ do- it "succeeds on empty" $ do- runRail (pure [] ?∅ const "not empty") `shouldBe` Right ()- it "fails on non-empty" $ do- runRail (pure [1 :: Int] ?∅ const "not empty") `shouldBe` Left "not empty"-- describe "Fallback Operator (?|)" $ do- it "does not run the right action when the left succeeds" $ do- runCount (pure (Just 'a') ?| (tick >> pure (Nothing :: Maybe Char)) ? "none")- `shouldBe` (Right 'a', 0)-- it "runs the right action when the left fails" $ do- runCount (pure (Nothing :: Maybe Int) ?| (tick >> pure (Just 7)) ? "none")- `shouldBe` (Right 7, 1)-- it "keeps the last error when everything fails" $ do- runCount (pure (Left "first" :: Either String Int) ?| pure (Left "second") ?? id)- `shouldBe` (Left "second", 0)- runCount (pure (Nothing :: Maybe Int) ?| pure Nothing ? "none")- `shouldBe` (Left "none", 0)-- it "chains mixed structures, stopping at the first success" $ do- let chain = pure (Nothing :: Maybe Int) ?| pure (Left "db" :: Either String Int)- ?| (tick >> pure (Just 3)) ?| (tick >> tick >> pure (Just 4)) ? "gone"- runCount chain `shouldBe` (Right 3, 1)-- describe "Accumulating Fallback Operator (?|<>)" $ do- it "does not run the right action when the left succeeds" $ do- runCount (pure (Just 'a') ?|<> (tick >> pure (Nothing :: Maybe Char)) ? "none")- `shouldBe` (Right 'a', 0)-- it "combines the errors in source order when everything fails" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Left "B") ?|<> pure (Left "C") ?? id)- `shouldBe` (Left "ABC", 0)-- it "mixes structures with the same error and success types" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Failure "B" :: Validation String Int) ?? id)- `shouldBe` (Left "AB", 0)- runCount (pure (Left "A" :: Either String Int) ?|<> (tick >> pure (Success 5 :: Validation String Int)) ?? id)- `shouldBe` (Right 5, 1)-- it "drops earlier errors once a later source succeeds" $ do- runCount (pure (Left "A" :: Either String Int) ?|<> pure (Left "B") ?|<> pure (Right 3) ?? id)- `shouldBe` (Right 3, 0)-- it "needs nothing special for Maybe sources" $ do- runCount (pure (Nothing :: Maybe Int) ?|<> pure Nothing ? "none")- `shouldBe` (Left "none", 0)-- describe "Layered structures (the outermost layer is peeled first)" $ do- it "peels Either of Maybe one layer at a time" $ do- let ok = pure (Right (Just 1)) :: Eff '[Error String] (Either String (Maybe Int))- runRail (ok ? "outer" ? "inner") `shouldBe` Right 1- runRail (pure (Right Nothing :: Either String (Maybe Int)) ? "outer" ? "inner") `shouldBe` Left "inner"- runRail (pure (Left "x" :: Either String (Maybe Int)) ? "outer" ? "inner") `shouldBe` Left "outer"-- it "peels Maybe of Maybe" $ do- runRail (pure (Just (Just 1) :: Maybe (Maybe Int)) ? "o" ? "i") `shouldBe` Right 1- runRail (pure (Just Nothing :: Maybe (Maybe Int)) ? "o" ? "i") `shouldBe` Left "i"- runRail (pure (Nothing :: Maybe (Maybe Int)) ? "o" ? "i") `shouldBe` Left "o"-- it "peels Either of Bool" $ do- runRail (pure (Right True :: Either String Bool) ? "db" ? "denied") `shouldBe` Right ()- runRail (pure (Right False :: Either String Bool) ? "db" ? "denied") `shouldBe` Left "denied"- runRail (pure (Left "x" :: Either String Bool) ? "db" ? "denied") `shouldBe` Left "db"+ forShapes "collapse, ?? and ? throw the mapped error info, else unwrap" $ \(_ :: Proxy a) ->+ property $ \(x :: a) ->+ (runRail (collapse show x) === first show (bifurcate x))+ .&&. (runRail (pure x ?? show) === first show (bifurcate x))+ .&&. (runRail (pure x ? "boom") === first (const "boom") (bifurcate x)) - it "peels Either of Either" $ do- runRail (pure (Right (Left "in") :: Either String (Either String Int)) ? "out" ?? id) `shouldBe` Left "in"+ describe "cardinality operators" $ do+ it "?+ succeeds on a non-empty collection" $ property $ \(xs :: [Int]) ->+ runRail (pure xs ?+ "empty") === (if null xs then Left "empty" else Right xs)+ it "?! succeeds on exactly one element" $ property $ \(xs :: [Int]) ->+ runRail (pure xs ?! cardinalityErr "none" (\ys -> "many " ++ show (length ys)))+ === (case xs of { [] -> Left "none"; [x] -> Right x; _ -> Left ("many " ++ show (length xs)) })+ it "?∅ and ?@ succeed on an empty collection" $ property $ \(xs :: [Int]) ->+ let model = if null xs then Right () else Left ("got " ++ show (length xs))+ in (runRail (pure xs ?∅ (\ys -> "got " ++ show (length ys))) === model)+ .&&. (runRail (pure xs ?@ (\ys -> "got " ++ show (length ys))) === model) - it "still traverses a list inside a layer" $ do- runRail (pure (Just [Just 1, Just 2 :: Maybe Int]) ? "o" ? "i") `shouldBe` Right [1, 2]+ describe "fixity (all operators are infixl 1, like >>=, <&> and &)" $ do+ it "composes with <&> without parentheses" $ do+ runRail (pure (Right 2 :: Either String Int) ? "e" <&> (+ 1)) `shouldBe` Right 3+ it "composes with $" $ do+ runRail (fmap negate $ pure (Just 2 :: Maybe Int) ? "e") `shouldBe` Right (-2)+ it "chains ? and ?> left to right" $ do+ runRail (pure (Just 7 :: Maybe Int) ? "none" ?> (> 5) ? "small") `shouldBe` Right 7+ runRail (pure (Just 3 :: Maybe Int) ? "none" ?> (> 5) ? "small") `shouldBe` Left "small"+ it "chains the fallback with ? and ?>" $ do+ runRail (pure (Nothing :: Maybe Int) ?| pure (Right 9 :: Either String Int) ? "none" ?> (> 5) ? "small")+ `shouldBe` Right 9+ it "gives the rejected value of ?> to the error mapper" $ do+ runRail (pure (4 :: Int) ?> (> 5) ?? \n -> "rejected " ++ show n) `shouldBe` Left "rejected 4"