packages feed

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 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"