generic-case 0.1.0.0 → 0.1.1.0

raw patch · 8 files changed

+539/−53 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• generic-case.cabal +2/−1
• src/Generics/Case.hs +194/−2
• src/Generics/Chain.hs +95/−6
• test/Generics/Case/BoolSpec.hs +33/−8
• test/Generics/Case/Custom/NoParamTypeSpec.hs +52/−8
• test/Generics/Case/Custom/OneParamTypeSpec.hs +57/−8
• test/Generics/Case/EitherSpec.hs +55/−10
• test/Generics/Case/MaybeSpec.hs +51/−10

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               generic-case-version:            0.1.0.0+version:            0.1.1.0 synopsis:           Generic case analysis description:   Generic case analysis in the vein of 'maybe', 'either' and 'bool',@@ -18,6 +18,7 @@ build-type:         Simple extra-doc-files:    CHANGELOG.md tested-with:+  GHC == 9.12.2   GHC == 9.10.1   GHC == 9.8.2   GHC == 9.6.5

@@ -79,32 +79,68 @@   Analysis (These a b) c these = gcase @++== Flipping the argument order++'maybe', 'either' and 'Data.Bool.bool' have a slightly different shape to @these@: they take the datatype+(@Maybe a@, @Either a b@ or @Bool@) after the case functions, whereas @these@ (and generally any+analysis function implemented using 'gcase') takes the datatype as its first argument, followed by+the case functions. This is due to the implementation, and is the recommended usage due to performance.+However, you may want your function to follow the same pattern as 'maybe', since this is more ergonomic.+In this case you can use 'AnalysisR' and 'gcaseR':++@+theseR ::+  forall a b c.+  (a -> c) ->+  (b -> c) ->+  (a -> b -> c) ->+  These a b ->+  c+-- alternate signature: theseR :: forall a b c. AnalysisR (These a b) c+theseR = gcaseR @(These a b)+@++Note that we need the @TypeApplications@ extension here. If you're really against this extension,+see 'gcaseR_'. -} module Generics.Case   ( -- * Generic case analysis     Analysis   , gcase +    -- ** Flipped argument order+  , AnalysisR+  , gcaseR+  , gcaseR_+     -- * Examples      -- ** Maybe   , maybeL+  , maybeR      -- ** Either   , eitherL+  , eitherR      -- ** Bool   , boolL+  , boolR      -- ** Tuples   , tupleL+  , tupleR   , tuple3L+  , tuple3R      -- ** Lists   , listL+  , listR      -- ** Non-empty lists   , nonEmptyL+  , nonEmptyR   ) where @@ -137,6 +173,63 @@   Analysis a r gcase = applyChains @(Code a) @r . unSOP . from +{- | Same as 'Analysis', except that the type comes after the functions.++You shouldn't ever need to create a function of this type; use 'gcaseR' or 'gcaseR_'.++You can exapand the type in a repl:++@+ghci> :k! AnalysisR (Maybe a) r+AnalysisR (Maybe a) r :: *+= r -> (a -> r) -> Maybe a -> r+@+-}+type AnalysisR a r = ChainsR (Code a) a r++{- | Generic case analysis, with the same shape as 'maybe' or 'either'. In other words this is the same+as 'gcase', except the datatype comes after the analysis functions.++== Note++This is undoubtedly more ergonomic, since it allows us to use partial application nicely:++@+let maybeToEither err = 'maybeR' (Left err) Right+in  ...+@++However, this carries a slight performance impact. It will __always__ be faster to use 'gcase', so if+performance is critical in your use-case, use that. Then again, if performance is __really__ critical,+you'll always be better off writing your analysis function manually; or just pattern-matching directly.+-}+gcaseR ::+  forall a r.+  (Generic a) =>+  AnalysisR a r+gcaseR = toChainsR @(Code a) @a @r $ gcase @a @r++{- | Morally the same as 'gcaseR', but takes a 'Proxy' to avoid @TypeApplications@.++Following our @These@ example:++@+these_ ::+  forall a b c.+  (a -> c) ->+  (b -> c) ->+  (a -> b -> c) ->+  These a b -> c+these_ = gcaseR_ (Proxy :: Proxy (These a b))+@+-}+gcaseR_ ::+  forall a r.+  (Generic a) =>+  Proxy a ->+  AnalysisR a r+gcaseR_ _ = gcaseR @a @r+ ------------------------------------------------------------ -- Examples @@ -157,6 +250,23 @@ maybeL :: forall a r. Maybe a -> r -> (a -> r) -> r maybeL = gcase +{- | 'maybe', implemented using 'gcaseR'.++Equivalent type signature:++@+maybeR :: forall a r. 'AnalysisR' (Maybe a) r+@++The implementation is just:++@+maybeR = gcaseR @(Maybe a)+@+-}+maybeR :: forall a r. r -> (a -> r) -> Maybe a -> r+maybeR = gcaseR @(Maybe a)+ {- | Same as 'either', except the 'Either' comes before the case functions.  Equivalent type signature:@@ -174,6 +284,23 @@ eitherL :: forall a b r. Either a b -> (a -> r) -> (b -> r) -> r eitherL = gcase +{- | 'either', implemented using 'gcaseR_'.++Equivalent type signature:++@+eitherR :: forall a b r. 'AnalysisR' (Either a b) r+@++The implementation is just:++@+eitherR = gcaseR_ (Proxy :: Proxy (Either a b))+@+-}+eitherR :: forall a b r. (a -> r) -> (b -> r) -> Either a b -> r+eitherR = gcaseR_ (Proxy :: Proxy (Either a b))+ {- | Same as 'Data.Bool.bool', except the 'Bool' comes before the case functions.  Equivalent type signature:@@ -191,6 +318,23 @@ boolL :: forall r. Bool -> r -> r -> r boolL = gcase +{- | 'Data.Bool.bool', implemented using 'gcaseR'.++Equivalent type signature:++@+boolR :: forall r. 'AnalysisR' Bool r+@++The implementation is just:++@+boolR = gcaseR @Bool+@+-}+boolR :: forall r. r -> r -> Bool -> r+boolR = gcaseR @Bool+ {- | Case analysis on a list. Same as [list](https://hackage.haskell.org/package/extra/docs/Data-List-Extra.html#v:list) from @extra@, except the list comes before the case functions.@@ -204,6 +348,19 @@ listL :: forall a r. [a] -> r -> (a -> [a] -> r) -> r listL = gcase +{- | Case analysis on a list. Same as+[list](https://hackage.haskell.org/package/extra/docs/Data-List-Extra.html#v:list)+from @extra@.++Equivalent type signature:++@+listR :: forall a r. 'AnalysisR' [a] r+@+-}+listR :: forall a r. r -> (a -> [a] -> r) -> [a] -> r+listR = gcaseR @[a]+ {- | Case analysis on a tuple. Same as 'uncurry', except the tuple comes before the case function.  Equivalent type signature:@@ -215,6 +372,17 @@ tupleL :: forall a b r. (a, b) -> (a -> b -> r) -> r tupleL = gcase +{- | Case analysis on a tuple. Interestingly, this is the same as 'uncurry'.++Equivalent type signature:++@+tupleR :: forall a b r. 'AnalysisR' (a, b) r+@+-}+tupleR :: forall a b r. (a -> b -> r) -> (a, b) -> r+tupleR = gcaseR @(a, b)+ {- | Case analysis on a 3-tuple. Same as [uncurry3](https://hackage.haskell.org/package/extra/docs/Data-Tuple-Extra.html#v:uncurry3) from @extra@, except the tuple comes before the case function.@@ -222,19 +390,43 @@ Equivalent type signature:  @-tupleL :: forall a b c r. 'Analysis' (a, b, c) r+tuple3L :: forall a b c r. 'Analysis' (a, b, c) r @ -} tuple3L :: forall a b c r. (a, b, c) -> (a -> b -> c -> r) -> r tuple3L = gcase -{- | Case analysis on a non-empty list.+{- | Case analysis on a 3-tuple. Same as+[uncurry3](https://hackage.haskell.org/package/extra/docs/Data-Tuple-Extra.html#v:uncurry3)+from @extra@.  Equivalent type signature:  @+tuple3R :: forall a b c r. 'AnalysisR' (a, b, c) r+@+-}+tuple3R :: forall a b c r. (a -> b -> c -> r) -> (a, b, c) -> r+tuple3R = gcaseR @(a, b, c)++{- | Case analysis on a non-empty list, where the list comes before the case function.++Equivalent type signature:++@ nonEmptyL :: forall a r. 'Analysis' (NonEmpty a) r @ -} nonEmptyL :: forall a r. NonEmpty a -> (a -> [a] -> r) -> r nonEmptyL = gcase++{- | Case analysis on a non-empty list.++Equivalent type signature:++@+nonEmptyR :: forall a r. 'AnalysisR' (NonEmpty a) r+@+-}+nonEmptyR :: forall a r. (a -> [a] -> r) -> NonEmpty a -> r+nonEmptyR = gcaseR @(NonEmpty a)

@@ -54,7 +54,7 @@ f3__ = f3_ @ -'Chains' iterates on this concepts: it is a type-level family representing+'Chains' iterates on this concept: it is a type-level family representing a function of functions. This lets us represent "case analysis" functions like 'maybe' and 'either' nicely (see "Generics.Case"): @@ -68,6 +68,23 @@ bool' :: forall r. Bool -> 'Chains' '[ '[], '[]] r bool' b f t = 'Data.Bool.bool' f t b @++'ChainsR' does the same thing, but let us pass the datatype __after__ the functions,+exactly matching the shape of 'maybe' and 'either':++@+maybe'' :: forall a r. 'ChainsR' '[ '[], '[a]] (Maybe a) r+maybe'' = 'maybe'++either'' :: forall a b r. 'ChainsR' '[ '[a], '[b]] (Either a b) r+either'' = 'either'++bool'' :: forall r. 'ChainsR' '[ '[], '[]] Bool r+bool'' = 'Data.Bool.bool'+@++Both 'Chains' and 'ChainsR' are implemented using 'Chains'', and we can convert between them using+'toChainsR' and 'fromChainsR'. -} module Generics.Chain   ( -- * Representation of n-ary functions@@ -79,6 +96,12 @@   , Chains   , applyChains   , constChain++    -- * Flipped argument order+  , ChainsR+  , toChainsR+  , fromChainsR+  , Chains'   ) where @@ -125,6 +148,21 @@   SNil -> f Nil   SCons -> \x -> toChain $ \xs -> f (I x :* xs) +{- | This type family generalises 'Chains' when we want the inner 'Chain's to have a different+return type to the overall function.++@+Chains' '[ '[x,y], '[z], '[]] ret final+  ~ Chain '[x,y] final -> Chain '[z] final -> Chain '[] final -> ret+  ~ (x -> y -> final)  -> (z -> final)     -> final           -> ret+@++It's used to implement both 'Chains' and 'ChainsR'.+-}+type family Chains' xss ret final where+  Chains' '[] ret final = ret+  Chains' (xs ': xss) ret final = Chain xs final -> Chains' xss ret final+ {- | The next level up from 'Chain': now we represent a function of functions.  @@@ -139,9 +177,7 @@ type Chains xss r = Chain (Map (\xs -> Chain xs r) xss) r @ -}-type family Chains xss r where-  Chains '[] r = r-  Chains (xs ': xss) r = Chain xs r -> Chains xss r+type Chains xss r = Chains' xss r r  {- | Apply a series of chains. Used to implement 'Generics.Case.gcase'. @@ -178,17 +214,70 @@ which just helps GHC understand the recursion) as being:  @-applyChains ::+constChain ::   r ->   Chains xs1 r ->   Chains xs2 r ->   ... ->   Chains xsn r ->   r-applyChains r _ _ ... _ = r+constChain r _ _ ... _ = r @ -} constChain :: forall xss r. r -> Shape xss -> Chains xss r constChain r = \case   ShapeNil -> r   ShapeCons s -> \_ -> constChain @_ @r r s++{- | Isomorphic to @a -> Chains xss r@, as witnessed by 'toChainsR' and 'fromChainsR'.++@+ChainsR '[ '[x,y], '[z], '[]] a r+  ~ Chain '[x,y] r -> Chain '[z] r -> Chain '[] r -> a -> r+  ~ (x -> y -> r)  -> (z -> r)     -> r           -> a -> r+@+-}+type ChainsR xss a r = Chains' xss (a -> r) r++{- | Convert between different representations of second-order n-ary functions. Should be inverse to 'fromChainsR'.++This will be used to convert from 'Generics.Case.Analysis' to 'Generics.Case.AnalysisR' in the implementation of+'Generics.Case.gcaseR'.++Morally we can think of this as:++@+toChainsR ::+  ( a -> Chains xs1 r -> ... -> Chains xsn r -> r) ->+  ( Chains xs1 r -> ... -> Chains xsn r -> a -> r)+toChainsR f c1 c2 ... cn a = f a c1 c2 ... cn+@++Effectively, it's an n-ary generalisation of 'flip'.+-}+toChainsR :: forall xss a r. (SListI xss) => (a -> Chains xss r) -> ChainsR xss a r+toChainsR = go $ shape @_ @xss+  where+    go :: forall yss. Shape yss -> (a -> Chains yss r) -> ChainsR yss a r+    go = \case+      ShapeNil -> id+      ShapeCons sc -> \f c -> go sc (`f` c)++{- | Convert between different representations of second-order n-ary functions. Should be inverse to 'toChainsR'.++Again, we can think of this as an n-ary generalisation of 'flip', in the other direction:++@+fromChainsR ::+  ( Chains xs1 r -> ... -> Chains xsn r -> a -> r) ->+  ( a -> Chains xs1 r -> ... -> Chains xsn r -> r)+fromChainsR f a c1 c2 ... cn = f c1 c2 ... cn a+@+-}+fromChainsR :: forall xss a r. (SListI xss) => ChainsR xss a r -> (a -> Chains xss r)+fromChainsR = go $ shape @_ @xss+  where+    go :: forall yss. Shape yss -> ChainsR yss a r -> (a -> Chains yss r)+    go = \case+      ShapeNil -> id+      ShapeCons (sc :: Shape xs) -> \f a c -> go sc (f c) a

@@ -8,11 +8,18 @@  type BoolFn r = Bool -> r -> r -> r +type BoolFnR r = r -> r -> Bool -> r+ type FunArgs r = '[Bool, r, r] +type FunArgsR r = '[r, r, Bool]+ manual :: BoolFn r manual b f t = bool f t b +manualR :: BoolFnR r+manualR = bool+ specBool ::   forall r.   (Show r, Eq r, Q.Arbitrary r) =>@@ -21,13 +28,31 @@   H.Spec specBool name f = specG @(FunArgs r) ("bool", manual) (name, f) +specBoolR ::+  forall r.+  (Show r, Eq r, Q.Arbitrary r) =>+  String ->+  BoolFnR r ->+  H.Spec+specBoolR name f = specG @(FunArgsR r) ("bool", manualR) (name, f)+ spec :: H.Spec spec = do-  H.describe "()" $ do-    specBool @() "boolL" boolL-  H.describe "Char" $ do-    specBool @Char "boolL" boolL-  H.describe "String" $ do-    specBool @String "boolL" boolL-  H.describe "[Maybe (Int, String)]" $ do-    specBool @[Maybe (Int, String)] "boolL" boolL+  H.describe "Left" $ do+    H.describe "()" $ do+      specBool @() "boolL" boolL+    H.describe "Char" $ do+      specBool @Char "boolL" boolL+    H.describe "String" $ do+      specBool @String "boolL" boolL+    H.describe "[Maybe (Int, String)]" $ do+      specBool @[Maybe (Int, String)] "boolL" boolL+  H.describe "Right" $ do+    H.describe "()" $ do+      specBoolR @() "boolR" boolR+    H.describe "Char" $ do+      specBoolR @Char "boolR" boolR+    H.describe "String" $ do+      specBoolR @String "boolR" boolR+    H.describe "[Maybe (Int, String)]" $ do+      specBoolR @[Maybe (Int, String)] "boolR" boolR

@@ -30,19 +30,34 @@  type NPTFn r = NoParamType -> r -> (Int -> r) -> (String -> Char -> r) -> r +type NPTFnR r = r -> (Int -> r) -> (String -> Char -> r) -> NoParamType -> r+ type FunArgs r = '[NoParamType, r, Fun Int r, Fun String (Fun Char r)] +type FunArgsR r = '[r, Fun Int r, Fun String (Fun Char r), NoParamType]+ type NPTFun r = Chain (FunArgs r) r +type NPTFunR r = Chain (FunArgsR r) r+ manual :: NPTFn r manual npt r fromInt fromStringChar = case npt of   NPT1 -> r   NPT2 int -> fromInt int   NPT3 string char -> fromStringChar string char +manualR :: NPTFnR r+manualR r fromInt fromStringChar npt = case npt of+  NPT1 -> r+  NPT2 int -> fromInt int+  NPT3 string char -> fromStringChar string char+ nptL :: NPTFn r nptL = gcase @NoParamType +nptR :: NPTFnR r+nptR = gcaseR @NoParamType+ specNPT ::   forall r.   ( Q.Arbitrary r@@ -57,18 +72,47 @@     ("manual", mkFn manual)     (name, mkFn f) +specNPTR ::+  forall r.+  ( Q.Arbitrary r+  , Show r+  , Eq r+  ) =>+  String ->+  NPTFnR r ->+  H.Spec+specNPTR name f =+  specG @(FunArgsR r)+    ("manual", mkFnR manualR)+    (name, mkFnR f)+ mkFn ::   NPTFn r ->   NPTFun r mkFn f npt' r f1 f2 = f npt' r (applyFun f1) (applyFun <$> applyFun f2) +mkFnR ::+  NPTFnR r ->+  NPTFunR r+mkFnR f r f1 f2 = f r (applyFun f1) (applyFun <$> applyFun f2)+ spec :: H.Spec spec = do-  H.describe "()" $ do-    specNPT @() "nptL" nptL-  H.describe "Char" $ do-    specNPT @Char "nptL" nptL-  H.describe "String" $ do-    specNPT @String "nptL" nptL-  H.describe "[Maybe (Int, String)]" $ do-    specNPT @[Maybe (Int, String)] "nptL" nptL+  H.describe "left" $ do+    H.describe "()" $ do+      specNPT @() "nptL" nptL+    H.describe "Char" $ do+      specNPT @Char "nptL" nptL+    H.describe "String" $ do+      specNPT @String "nptL" nptL+    H.describe "[Maybe (Int, String)]" $ do+      specNPT @[Maybe (Int, String)] "nptL" nptL+  H.describe "right" $ do+    H.describe "()" $ do+      specNPTR @() "nptR" nptR+    H.describe "Char" $ do+      specNPTR @Char "nptR" nptR+    H.describe "String" $ do+      specNPTR @String "nptR" nptR+    H.describe "[Maybe (Int, String)]" $ do+      specNPTR @[Maybe (Int, String)] "nptR" nptR

@@ -30,19 +30,34 @@  type OPTFn a r = OneParamType a -> (a -> r) -> (Maybe a -> r) -> (a -> a -> r) -> r +type OPTFnR a r = (a -> r) -> (Maybe a -> r) -> (a -> a -> r) -> OneParamType a -> r+ type FunArgs a r = '[OneParamType a, Fun a r, Fun (Maybe a) r, Fun a (Fun a r)] +type FunArgsR a r = '[Fun a r, Fun (Maybe a) r, Fun a (Fun a r), OneParamType a]+ type OPTFun a r = Chain (FunArgs a r) r +type OPTFunR a r = Chain (FunArgsR a r) r+ manual :: OPTFn a r manual opt fromA fromM fromAs = case opt of   OPT1 a -> fromA a   OPT2 m -> fromM m   OPT3 a1 a2 -> fromAs a1 a2 +manualR :: OPTFnR a r+manualR fromA fromM fromAs opt = case opt of+  OPT1 a -> fromA a+  OPT2 m -> fromM m+  OPT3 a1 a2 -> fromAs a1 a2+ gopt :: forall a r. OPTFn a r gopt = gcase @(OneParamType a) +goptR :: forall a r. OPTFnR a r+goptR = gcaseR @(OneParamType a)+ specOPT ::   forall a r.   ( Show a@@ -61,19 +76,53 @@     ("manual", mkFn manual)     (name, mkFn f) +specOPTR ::+  forall a r.+  ( Show a+  , Function a+  , Q.CoArbitrary a+  , Q.Arbitrary a+  , Q.Arbitrary r+  , Show r+  , Eq r+  ) =>+  String ->+  OPTFnR a r ->+  H.Spec+specOPTR name f =+  specG @(FunArgsR a r)+    ("manual", mkFnR manualR)+    (name, mkFnR f)+ mkFn ::   forall a r.   OPTFn a r ->   OPTFun a r mkFn f m f1 f2 f3 = f m (applyFun f1) (applyFun f2) (applyFun <$> applyFun f3) +mkFnR ::+  forall a r.+  OPTFnR a r ->+  OPTFunR a r+mkFnR f f1 f2 f3 = f (applyFun f1) (applyFun f2) (applyFun <$> applyFun f3)+ spec :: H.Spec spec = do-  H.describe "OneParamType () -> Char" $ do-    specOPT @() @Char "gopt" gopt-  H.describe "OneParamType Char -> Either String ()" $ do-    specOPT @Char @(Either String ()) "gopt" gopt-  H.describe "OneParamType String -> (Int, Either Integer Int)" $ do-    specOPT @String @(Int, Either Integer Int) "gopt" gopt-  H.describe "OneParamType [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do-    specOPT @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "gopt" gopt+  H.describe "left" $ do+    H.describe "OneParamType () -> Char" $ do+      specOPT @() @Char "gopt" gopt+    H.describe "OneParamType Char -> Either String ()" $ do+      specOPT @Char @(Either String ()) "gopt" gopt+    H.describe "OneParamType String -> (Int, Either Integer Int)" $ do+      specOPT @String @(Int, Either Integer Int) "gopt" gopt+    H.describe "OneParamType [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do+      specOPT @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "gopt" gopt+  H.describe "right" $ do+    H.describe "OneParamType () -> Char" $ do+      specOPTR @() @Char "goptR" goptR+    H.describe "OneParamType Char -> Either String ()" $ do+      specOPTR @Char @(Either String ()) "goptR" goptR+    H.describe "OneParamType String -> (Int, Either Integer Int)" $ do+      specOPTR @String @(Int, Either Integer Int) "goptR" goptR+    H.describe "OneParamType [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do+      specOPTR @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "goptR" goptR

@@ -9,14 +9,22 @@  type EitherFn a b r = Either a b -> (a -> r) -> (b -> r) -> r +type EitherFnR a b r = (a -> r) -> (b -> r) -> Either a b -> r+ type FunArgs a b r = '[Either a b, Fun a r, Fun b r] +type FunArgsR a b r = '[Fun a r, Fun b r, Either a b]+ type EitherFun a b r = Chain (FunArgs a b r) r +type EitherFunR a b r = Chain (FunArgsR a b r) r+ manual :: EitherFn a b r-manual (Left a) f _ = f a-manual (Right b) _ g = g b+manual e l r = either l r e +manualR :: EitherFnR a b r+manualR = either+ specEither ::   forall a b r.   ( Show a@@ -39,18 +47,55 @@     ("either", mkFn manual)     (name, mkFn f) +specEitherR ::+  forall a b r.+  ( Show a+  , Function a+  , Q.CoArbitrary a+  , Q.Arbitrary a+  , Show b+  , Function b+  , Q.CoArbitrary b+  , Q.Arbitrary b+  , Q.Arbitrary r+  , Show r+  , Eq r+  ) =>+  String ->+  EitherFnR a b r ->+  H.Spec+specEitherR name f =+  specG @(FunArgsR a b r)+    ("either", mkFnR manualR)+    (name, mkFnR f)+ mkFn ::   EitherFn a b r ->   EitherFun a b r mkFn e x f g = e x (applyFun f) (applyFun g) +mkFnR ::+  EitherFnR a b r ->+  EitherFunR a b r+mkFnR e f g = e (applyFun f) (applyFun g)+ spec :: H.Spec spec = do-  H.describe "Either () Char -> Char" $ do-    specEither @() @Char @Char "eitherL" eitherL-  H.describe "Either Char String -> Either String ()" $ do-    specEither @Char @String @(Either String ()) "eitherL" eitherL-  H.describe "Either String (Maybe Integer) -> (Int, Either Integer Int)" $ do-    specEither @String @(Maybe Integer) @(Int, Either Integer Int) "eitherL" eitherL-  H.describe "Either [Maybe (Int, String)] Int -> (Int, [Either (Maybe ()) String])" $ do-    specEither @(Maybe (Int, String)) @Int @(Int, [Either (Maybe ()) String]) "eitherL" eitherL+  H.describe "left" $ do+    H.describe "Either () Char -> Char" $ do+      specEither @() @Char @Char "eitherL" eitherL+    H.describe "Either Char String -> Either String ()" $ do+      specEither @Char @String @(Either String ()) "eitherL" eitherL+    H.describe "Either String (Maybe Integer) -> (Int, Either Integer Int)" $ do+      specEither @String @(Maybe Integer) @(Int, Either Integer Int) "eitherL" eitherL+    H.describe "Either [Maybe (Int, String)] Int -> (Int, [Either (Maybe ()) String])" $ do+      specEither @(Maybe (Int, String)) @Int @(Int, [Either (Maybe ()) String]) "eitherL" eitherL+  H.describe "right" $ do+    H.describe "Either () Char -> Char" $ do+      specEitherR @() @Char @Char "eitherR" eitherR+    H.describe "Either Char String -> Either String ()" $ do+      specEitherR @Char @String @(Either String ()) "eitherR" eitherR+    H.describe "Either String (Maybe Integer) -> (Int, Either Integer Int)" $ do+      specEitherR @String @(Maybe Integer) @(Int, Either Integer Int) "eitherR" eitherR+    H.describe "Either [Maybe (Int, String)] Int -> (Int, [Either (Maybe ()) String])" $ do+      specEitherR @(Maybe (Int, String)) @Int @(Int, [Either (Maybe ()) String]) "eitherR" eitherR

@@ -9,14 +9,22 @@  type MaybeFn a r = Maybe a -> r -> (a -> r) -> r +type MaybeFnR a r = r -> (a -> r) -> Maybe a -> r+ type FunArgs a r = '[Maybe a, r, Fun a r] +type FunArgsR a r = '[r, Fun a r, Maybe a]+ type MaybeFun a r = Chain (FunArgs a r) r +type MaybeFunR a r = Chain (FunArgsR a r) r+ manual :: MaybeFn a r-manual Nothing r _ = r-manual (Just a) _ f = f a+manual m r f = maybe r f m +manualR :: MaybeFnR a r+manualR = maybe+ specMaybe ::   forall a r.   ( Show a@@ -35,18 +43,51 @@     ("maybe", mkFn manual)     (name, mkFn f) +specMaybeR ::+  forall a r.+  ( Show a+  , Function a+  , Q.Arbitrary r+  , Q.CoArbitrary a+  , Q.Arbitrary a+  , Show r+  , Eq r+  ) =>+  String ->+  MaybeFnR a r ->+  H.Spec+specMaybeR name f =+  specG @(FunArgsR a r)+    ("maybe", mkFnR manualR)+    (name, mkFnR f)+ mkFn ::   MaybeFn a r ->   MaybeFun a r mkFn f m r fn = f m r (applyFun fn) +mkFnR ::+  MaybeFnR a r ->+  MaybeFunR a r+mkFnR f r fn = f r (applyFun fn)+ spec :: H.Spec spec = do-  H.describe "Maybe () -> Char" $ do-    specMaybe @() @Char "maybeL" maybeL-  H.describe "Maybe Char -> Either String ()" $ do-    specMaybe @Char @(Either String ()) "maybeL" maybeL-  H.describe "Maybe String -> (Int, Either Integer Int)" $ do-    specMaybe @String @(Int, Either Integer Int) "maybeL" maybeL-  H.describe "Maybe [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do-    specMaybe @(Maybe (Int, String)) @(Int, [Either (Maybe ()) String]) "maybeL" maybeL+  H.describe "left" $ do+    H.describe "Maybe () -> Char" $ do+      specMaybe @() @Char "maybeL" maybeL+    H.describe "Maybe Char -> Either String ()" $ do+      specMaybe @Char @(Either String ()) "maybeL" maybeL+    H.describe "Maybe String -> (Int, Either Integer Int)" $ do+      specMaybe @String @(Int, Either Integer Int) "maybeL" maybeL+    H.describe "Maybe [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do+      specMaybe @(Maybe (Int, String)) @(Int, [Either (Maybe ()) String]) "maybeL" maybeL+  H.describe "right" $ do+    H.describe "Maybe () -> Char" $ do+      specMaybeR @() @Char "maybeR" maybeR+    H.describe "Maybe Char -> Either String ()" $ do+      specMaybeR @Char @(Either String ()) "maybeR" maybeR+    H.describe "Maybe String -> (Int, Either Integer Int)" $ do+      specMaybeR @String @(Int, Either Integer Int) "maybeR" maybeR+    H.describe "Maybe [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do+      specMaybeR @(Maybe (Int, String)) @(Int, [Either (Maybe ()) String]) "maybeR" maybeR