functor-combinators 0.3.5.1 → 0.3.6.0

raw patch · 14 files changed

+677/−19 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• functor-combinators.cabal +4/−3
• src/Control/Monad/Freer/Church.hs +17/−0
• src/Data/Functor/Apply/Free.hs +21/−0
• src/Data/Functor/Combinator.hs +4/−0
• src/Data/Functor/Contravariant/Divisible/Free.hs +41/−0
• src/Data/HBifunctor.hs +10/−5
• src/Data/HFunctor/Chain.hs +2/−2
• src/Data/HFunctor/Chain/Internal.hs +87/−0
• src/Data/HFunctor/HTraversable.hs +419/−0
• src/Data/HFunctor/Internal.hs +15/−3
• src/Data/HFunctor/Interpret.hs +26/−0
• src/Data/HFunctor/Route.hs +13/−0
• test/Tests/Util.hs +0/−6

@@ -1,6 +1,24 @@ Changelog ========= +Version 0.3.6.0+---------------++*August 27, 2020*++<https://github.com/mstksg/functor-combinators/releases/tag/v0.3.6.0>++*   *Data.HFunctor.HTraversable* added, providing `HTraversable` and+    `HTraversable1`.+*   *Control.Monad.Freer.Church*: Missing `Apply`, `Alt`, and `Plus` instances+    added for `Comp`.+*   *Data.HBifunctor*: `HFunctor` instances for `LeftF`, `RightF`, `Joker`,+    `Void3`, and `Comp` made more kind-polymorphic+*   *Data.HFunctor.Interpret*: `itraverse` added, mimicking `htraverse` for+    proper `Interpret` instances.+*   *Data.HFunctor.Chain*: `foldChainA` and `foldChain1A` added, for effectful+    folding of chains.+ Version 0.3.5.0 --------------- 

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 5ffab6787a63b6742f7dc3dc9eb04a4f68a6ae789f96828dbc2a2f1919fe3855+-- hash: 9070db16766f843e9ffef9a8370e247bb1136ef2d5903a49c7411b5cb1227af7  name:           functor-combinators-version:        0.3.5.1+version:        0.3.6.0 synopsis:       Tools for functor combinator-based program design description:    Tools for working with /functor combinators/: types that take functors (or                 other indexed types) and returns a new functor that "enhances" or "mixes"@@ -68,6 +68,7 @@       Data.HFunctor       Data.HFunctor.Chain       Data.HFunctor.Final+      Data.HFunctor.HTraversable       Data.HFunctor.Interpret       Data.HFunctor.Route   other-modules:

@@ -36,6 +36,7 @@   ) where  import           Control.Applicative+import           Data.Functor.Plus import           Control.Monad import           Control.Natural import           Data.Foldable@@ -429,6 +430,14 @@ instance Functor g => Functor (Comp f g) where     fmap f (x :>>= h) = x :>>= (fmap f . h) +-- | @since 0.3.6.0+instance (Apply f, Apply g) => Apply (Comp f g) where+    (x :>>= f) <.> (y :>>= g) = ((,) <$> x <.> y)+                           :>>= (\(x', y') -> f x' <.> g y')+    liftF2 h (x :>>= f) (y :>>= g)+            = ((,) <$> x <.> y)+         :>>= (\(x', y') -> liftF2 h (f x') (g y'))+ instance (Applicative f, Applicative g) => Applicative (Comp f g) where     pure x = pure () :>>= (pure . const x)     (x :>>= f) <*> (y :>>= g) = ((,) <$> x <*> y)@@ -447,6 +456,14 @@ instance (Alternative f, Alternative g) => Alternative (Comp f g) where     empty = empty :>>= id     (x :>>= f) <|> (y :>>= g) = ((f <$> x) <|> (g <$> y)) :>>= id++-- | @since 0.3.6.0+instance (Alt f, Alt g) => Alt (Comp f g) where+    (x :>>= f) <!> (y :>>= g) = ((f <$> x) <!> (g <$> y)) :>>= id++-- | @since 0.3.6.0+instance (Plus f, Plus g) => Plus (Comp f g) where+    zero = zero :>>= id  instance (Functor f, Show1 f, Show1 g) => Show1 (Comp f g) where     liftShowsPrec sp sl d (Comp x) =

@@ -28,6 +28,7 @@ import           Data.Functor.Identity import           Data.Functor.Invariant import           Data.HFunctor+import           Data.HFunctor.HTraversable import           Data.HFunctor.Interpret import           Data.Kind import           GHC.Generics@@ -114,6 +115,26 @@  instance HBind Ap1 where     hbind = runAp1++instance HTraversable Ap1 where+    htraverse f (Ap1 x xs) = Ap1 <$> f x <*> htraverse f xs++instance HTraversable1 Ap1 where+    htraverse1 f (Ap1 x xs) = traverseAp1_ f x xs++traverseAp1_+    :: forall f g h a b. Apply h+    => (forall x. f x -> h (g x))+    -> f a+    -> Ap f (a -> b)+    -> h (Ap1 g b)+traverseAp1_ f = go+  where+    go :: f x -> Ap f (x -> y) -> h (Ap1 g y)+    go x = \case+      Pure y  -> (`Ap1` Pure y) <$> f x+      Ap y ys -> Ap1 <$> f x <.> (toAp <$> go y ys)+  instance Apply f => Interpret Ap1 f where     retract = retractAp1

@@ -48,6 +48,9 @@   , getI, collectI   , injectMap, injectContramap   , AltConst(..)+  -- ** 'HTraversable'+  , HTraversable(..), hsequence, hfoldMap, htoList+  , HTraversable1(..), hsequence1, hfoldMap1, htoNonEmpty   -- ** Multi-Functors   -- | Classes that deal with two-functor combinators, that "mix" two   -- functors together in some way.@@ -143,6 +146,7 @@ import           Data.HBifunctor.Tensor import           Data.HFunctor import           Data.HFunctor.Final+import           Data.HFunctor.HTraversable import           Data.HFunctor.Internal import           Data.HFunctor.Interpret import           GHC.Generics

@@ -36,12 +36,15 @@ import           Data.Functor.Contravariant.Coyoneda import           Data.Functor.Contravariant.Decide import           Data.Functor.Contravariant.Divise+import           Data.Functor.Apply import           Data.Functor.Contravariant.Divisible import           Data.Functor.Invariant import           Data.HFunctor+import           Data.HFunctor.HTraversable import           Data.HFunctor.Interpret import           Data.Kind import           Data.List.NonEmpty                   (NonEmpty(..))+import           Data.Semigroup.Traversable import           Data.Void import qualified Control.Monad.Trans.Compose          as CT import qualified Data.Functor.Contravariant.Day       as CD@@ -62,6 +65,9 @@   deriving (Contravariant, Divise, Divisible) via (ListF (Coyoneda f))   deriving (HFunctor, Inject) via (CT.ComposeT ListF Coyoneda) +instance HTraversable Div where+    htraverse f (Div xs) = Div <$> traverse (htraverse f) xs+ instance Invariant (Div f) where     invmap _ = contramap @@ -131,6 +137,12 @@   deriving (Contravariant, Divise) via (NonEmptyF (Coyoneda f))   deriving (HFunctor, Inject) via (CT.ComposeT NonEmptyF Coyoneda) +instance HTraversable Div1 where+    htraverse f (Div1 xs) = Div1 <$> traverse (htraverse f) xs++instance HTraversable1 Div1 where+    htraverse1 f (Div1 xs) = Div1 <$> traverse1 (htraverse1 f) xs+ instance Invariant (Div1 f) where     invmap _ = contramap @@ -210,6 +222,15 @@ instance Conclude f => Interpret Dec f where     interpret = runDec +instance HTraversable Dec where+    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> Dec f a -> h (Dec g a)+    htraverse f = go+      where+        go :: Dec f b -> h (Dec g b)+        go = \case+          Lose   v      -> pure (Lose v)+          Choose g x xs -> Choose g <$> f x <*> go xs+ -- | Map over the underlying context in a 'Dec'. hoistDec :: forall f g. (f ~> g) -> Dec f ~> Dec g hoistDec f = go@@ -257,6 +278,12 @@ instance Decide f => Interpret Dec1 f where     interpret = runDec1 +instance HTraversable Dec1 where+    htraverse f (Dec1 g x xs) = Dec1 g <$> f x <*> htraverse f xs++instance HTraversable1 Dec1 where+    htraverse1 f (Dec1 g x xs) = traverseDec1_ f g x xs+ -- | Map over the undering context in a 'Dec1'. hoistDec1 :: forall f g. (f ~> g) -> Dec1 f ~> Dec1 g hoistDec1 f (Dec1 g x xs) = Dec1 g (f x) (hoistDec f xs)@@ -282,3 +309,17 @@     go g x = \case       Lose h        -> contramap (either id (absurd . h) . g) (f x)       Choose h y ys -> decide g (f x) (go h y ys)++traverseDec1_+    :: forall f g h a b c. Apply h+    => (forall x. f x -> h (g x))+    -> (a -> Either b c)+    -> f b+    -> Dec f c+    -> h (Dec1 g a)+traverseDec1_ f = go+  where+    go :: (x -> Either y z) -> f y -> Dec f z -> h (Dec1 g x)+    go g x = \case+      Lose h        -> (\x' -> Dec1 g x' (Lose h)) <$> f x+      Choose h y ys -> Dec1 g <$> f x <.> (toDec <$> go h y ys)

@@ -23,9 +23,11 @@ import           Control.Natural.IsoF import           Data.Biapplicative import           Data.Bifunctor.TH+import           Data.Coerce import           Data.Data import           Data.Deriving import           Data.HFunctor+import           Data.HFunctor.HTraversable import           Data.HFunctor.Internal import           Data.HFunctor.Interpret import           GHC.Generics@@ -67,9 +69,12 @@ instance HBifunctor LeftF where     hbimap f _ (LeftF x) = LeftF (f x) -deriving via (WrappedHBifunctor LeftF f)-    instance HFunctor (LeftF f)+instance HFunctor (LeftF f) where+    hmap _ = coerce +instance HTraversable (LeftF f) where+    htraverse _ = pure . coerce+ -- | An 'HBifunctor' that ignores its first input.  Like -- a 'GHC.Generics.:+:' with no 'GHC.Generics.L1'/left branch. --@@ -86,14 +91,14 @@ instance HBifunctor RightF where     hbimap _ g (RightF x) = RightF (g x) -deriving via (WrappedHBifunctor RightF g)-    instance HFunctor (RightF g)- instance HFunctor (RightF g) where     hmap f (RightF x) = RightF (f x)  instance Inject (RightF g) where     inject = RightF++instance HTraversable (RightF g) where+    htraverse f (RightF x) = RightF <$> f x  instance HBind (RightF g) where     hbind f (RightF x) = f x

@@ -27,7 +27,7 @@ module Data.HFunctor.Chain (   -- * 'Chain'     Chain(..)-  , foldChain+  , foldChain, foldChainA   , unfoldChain   , unroll   , reroll@@ -39,7 +39,7 @@   , unconsChain   -- * 'Chain1'   , Chain1(..)-  , foldChain1+  , foldChain1, foldChain1A   , unfoldChain1   , unrollingNE   , unrollNE

@@ -2,10 +2,12 @@ module Data.HFunctor.Chain.Internal (     Chain1(..)   , foldChain1, unfoldChain1+  , foldChain1A   , toChain1, injectChain1   , matchChain1   , Chain(..)   , foldChain, unfoldChain+  , foldChainA   , splittingChain, unconsChain   , DivAp1(..)   , DivAp(..)@@ -13,14 +15,17 @@   , DecAlt1(..)   ) where +import           Control.Monad.Freer.Church import           Control.Natural import           Control.Natural.IsoF+import           Data.Functor.Apply import           Data.Functor.Classes import           Data.Functor.Contravariant import           Data.Functor.Identity import           Data.Functor.Invariant import           Data.HBifunctor import           Data.HFunctor+import           Data.HFunctor.HTraversable import           Data.Kind import           Data.Typeable import           Data.Void@@ -160,6 +165,17 @@       Done1 x  -> f x       More1 xs -> g (hright go xs) +-- | An "effectful" version of 'foldChain1', weaving Applicative effects.+--+-- @since 0.3.6.0+foldChain1A+    :: (HBifunctor t, Functor h)+    => (forall x. f x -> h (g x))                -- ^ handle 'Done1'+    -> (forall x. t f (Comp h g) x -> h (g x))   -- ^ handle 'More1'+    -> Chain1 t f a+    -> h (g a)+foldChain1A f g = unComp . foldChain1 (Comp . f) (Comp . g)+ -- | Recursively build up a 'Chain1'.  Provide a function that takes some -- starting seed @g@ and returns either "done" (@f@) or "continue further" -- (@t f g@), and it will create a @'Chain1' t f@ from a @g@.@@ -310,6 +326,17 @@       Done x  -> f x       More xs -> g (hright go xs) +-- | An "effectful" version of 'foldChain', weaving Applicative effects.+--+-- @since 0.3.6.0+foldChainA+    :: (HBifunctor t, Functor h)+    => (forall x. i x -> h (g x))         -- ^ Handle 'Done'+    -> (forall x. t f (Comp h g) x -> h (g x))     -- ^ Handle 'More'+    -> Chain t i f a+    -> h (g a)+foldChainA f g = unComp . foldChain (Comp . f) (Comp . g)+ -- | Recursively build up a 'Chain'.  Provide a function that takes some -- starting seed @g@ and returns either "done" (@i@) or "continue further" -- (@t f g@), and it will create a @'Chain' t i f@ from a @g@.@@ -380,6 +407,26 @@ newtype DivAp1 f a = DivAp1_ { unDivAp1 :: Chain1 ID.Day f a }   deriving (Invariant, HFunctor, Inject) +instance HTraversable DivAp1 where+    htraverse f =+        foldChain1A+          (fmap (DivAp1_ . Done1) . f)+          (\case ID.Day x (Comp y) g h ->+                     (\x' y' -> DivAp1_ (More1 (ID.Day x' y' g h)))+                   <$> f x <*> (unDivAp1 <$> y)+          )+      . unDivAp1++instance HTraversable1 DivAp1 where+    htraverse1 f =+        foldChain1A+          (fmap (DivAp1_ . Done1) . f)+          (\case ID.Day x (Comp y) g h ->+                     (\x' y' -> DivAp1_ (More1 (ID.Day x' y' g h)))+                   <$> f x <.> (unDivAp1 <$> y)+          )+      . unDivAp1+ -- | The invariant version of 'Ap' and 'Div': combines the capabilities of -- both 'Ap' and 'Div' together. --@@ -422,6 +469,17 @@ instance Inject DivAp where     inject x = DivAp $ More (ID.Day x (Done (Identity ())) const (,())) +instance HTraversable DivAp where+    htraverse f =+        foldChainA+          (pure . DivAp . Done)+          (\case ID.Day x (Comp y) g h ->+                      (\x' y' -> DivAp (More (ID.Day x'  y' g h)))+                  <$> f x <*> (unDivAp <$> y)+          )+      . unDivAp++ -- | The invariant version of 'NonEmptyF' and 'Dec1': combines the -- capabilities of both 'NonEmptyF' and 'Dec1' together. --@@ -460,6 +518,26 @@ newtype DecAlt1 f a = DecAlt1_ { unDecAlt1 :: Chain1 IN.Night f a }   deriving (Invariant, HFunctor, Inject) +instance HTraversable DecAlt1 where+    htraverse f =+        foldChain1A+          (fmap (DecAlt1_ . Done1) . f)+          (\case IN.Night x (Comp y) g h k ->+                     (\x' y' -> DecAlt1_ (More1 (IN.Night x' y' g h k)))+                   <$> f x <*> (unDecAlt1 <$> y)+          )+      . unDecAlt1++instance HTraversable1 DecAlt1 where+    htraverse1 f =+        foldChain1A+          (fmap (DecAlt1_ . Done1) . f)+          (\case IN.Night x (Comp y) g h k ->+                     (\x' y' -> DecAlt1_ (More1 (IN.Night x' y' g h k)))+                   <$> f x <.> (unDecAlt1 <$> y)+          )+      . unDecAlt1+ -- | The invariant version of 'ListF' and 'Dec': combines the capabilities of -- both 'ListF' and 'Dec' together. --@@ -502,4 +580,13 @@  instance Inject DecAlt where     inject x = DecAlt $ More (IN.Night x (Done IN.refuted) Left id absurd)++instance HTraversable DecAlt where+    htraverse f =+        foldChainA (pure . DecAlt . Done)+          (\case IN.Night x (Comp y) g h k ->+                     (\x' y' -> DecAlt (More (IN.Night x' y' g h k)))+                  <$> f x <*> (unDecAlt <$> y)+          )+      . unDecAlt 

@@ -0,0 +1,419 @@+-- |+-- Module      : Data.HFunctor.HTraversable+-- Copyright   : (c) Justin Le 2019+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides a "higher-order" version of 'Traversable' and 'Traversable1',+-- in the same way that 'HFunctor' is a higher-order version of 'Functor'.+--+-- Note that in theory we could have 'HFoldable' as well, in the hierarchy,+-- to represent something that does not have an 'HFunctor' instance.+-- But it is not clear exactly why it would be useful as an abstraction.+-- This may be added in the future if use cases pop up.  For the most part,+-- the things you would want to do with an 'HFoldable', you could do with+-- 'hfoldMap' or 'iget'; it could in theory be useful for things without+-- 'HTraversable' or 'Interpret' instances, but it isn't clear what those+-- instances might be.+--+-- For instances of 'Interpret', there is some overlap with the+-- functionality of 'iget', 'icollect', and 'icollect1'.+--+-- @since 0.3.6.0+module Data.HFunctor.HTraversable (+  -- * 'HTraversable'+    HTraversable(..)+  , hsequence, hfoldMap, htoList, hmapDefault+  -- * 'HTraversable1'+  , HTraversable1(..)+  , hsequence1, hfoldMap1, htoNonEmpty+  ) where++import           Control.Applicative+import           Control.Applicative.Backwards+import           Control.Applicative.Free+import           Control.Applicative.Lift+import           Control.Applicative.ListF+import           Control.Applicative.Step+import           Control.Comonad.Trans.Env+import           Control.Monad.Trans.Compose+import           Control.Monad.Trans.Identity+import           Control.Monad.Trans.Maybe+import           Control.Natural+import           Data.Bifunctor.Joker+import           Data.Bitraversable+import           Data.Coerce+import           Data.Functor.Apply+import           Data.Functor.Coyoneda+import           Data.Functor.Day                    (Day(..))+import           Data.Functor.Identity+import           Data.Functor.Product+import           Data.Functor.Reverse+import           Data.Functor.Sum+import           Data.Functor.These+import           Data.HFunctor+import           Data.HFunctor.Internal+import           Data.HFunctor.Interpret+import           Data.List.NonEmpty                  (NonEmpty)+import           Data.Semigroup                      (Endo(..))+import           Data.Semigroup.Traversable+import           Data.Tagged+import           Data.Vinyl.CoRec+import           Data.Vinyl.Core                     (Rec)+import           Data.Vinyl.Recursive+import           GHC.Generics+import qualified Control.Alternative.Free            as Alt+import qualified Control.Applicative.Free            as Ap+import qualified Control.Applicative.Free.Fast       as FAF+import qualified Control.Applicative.Free.Final      as FA+import qualified Control.Applicative.Lift            as Lift+import qualified Data.Functor.Contravariant.Coyoneda as CCY+import qualified Data.Functor.Invariant.Day          as ID+import qualified Data.Functor.Invariant.Night        as IN+import qualified Data.SOP                            as SOP+++-- | A higher-kinded version of 'Traversable1', in the same way that+-- 'HFunctor' is the higher-kinded version of 'Functor'.  Gives you an+-- "effectful" 'hmap', in the same way that 'traverse1' gives you an+-- effectful 'fmap', guaranteeing at least one item.+--+-- The typical analogues of 'Traversable1' laws apply.+--+-- @since 0.3.6.0+class HTraversable t => HTraversable1 t where+    -- | An "effectful" 'hmap', in the same way that 'traverse1' is an+    -- effectful 'fmap', guaranteeing at least one item.+    htraverse1 :: Apply h => (forall x. f x -> h (g x)) -> t f a -> h (t g a)++-- | A wrapper over a common pattern of "inverting" layers of a functor+-- combinator that always contains at least one @f@ item.+--+-- @since 0.3.6.0+hsequence1 :: (HTraversable1 t, Apply h) => t (h :.: f) a -> h (t f a)+hsequence1 = htraverse1 unComp1++-- | Collect all the @f x@s inside a @t f a@ into a semigroupoidal result+-- using a projecting function.+--+-- See 'iget'.+--+-- @since 0.3.6.0+hfoldMap1 :: (HTraversable1 t, Semigroup m) => (forall x. f x -> m) -> t f a -> m+hfoldMap1 f = getConst . htraverse1 (Const . f)++-- | Collect all the @f x@s inside a @t f a@ into a non-empty list, using+-- a projecting function.+--+-- See 'icollect1'.+--+-- @since 0.3.6.0+htoNonEmpty :: HTraversable1 t => (forall x. f x -> b) -> t f a -> NonEmpty b+htoNonEmpty f = fromNDL . hfoldMap1 (ndlSingleton . f)++-- | A higher-kinded version of 'Traversable', in the same way that+-- 'HFunctor' is the higher-kinded version of 'Functor'.  Gives you an+-- "effectful" 'hmap', in the same way that 'traverse' gives you an+-- effectful 'fmap'.+--+-- The typical analogues of 'Traversable' laws apply.+--+-- @since 0.3.6.0+class HFunctor t => HTraversable t where+    -- | An "effectful" 'hmap', in the same way that 'traverse' is an+    -- effectful 'fmap'.+    htraverse :: Applicative h => (forall x. f x -> h (g x)) -> t f a -> h (t g a)++-- | A wrapper over a common pattern of "inverting" layers of a functor+-- combinator.+--+-- @since 0.3.6.0+hsequence :: (HTraversable t, Applicative h) => t (h :.: f) a -> h (t f a)+hsequence = htraverse unComp1++-- | Collect all the @f x@s inside a @t f a@ into a monoidal result using+-- a projecting function.+--+-- See 'iget'.+--+-- @since 0.3.6.0+hfoldMap :: (HTraversable t, Monoid m) => (forall x. f x -> m) -> t f a -> m+hfoldMap f = getConst . htraverse (Const . f)++-- | Collect all the @f x@s inside a @t f a@ into a list, using+-- a projecting function.+--+-- See 'icollect'.+--+-- @since 0.3.6.0+htoList :: HTraversable t => (forall x. f x -> b) -> t f a -> [b]+htoList f = flip appEndo [] . hfoldMap (Endo . (:) . f)++-- | An implementation of 'hmap' defined using 'htraverse'.+--+-- @since 0.3.6.0+hmapDefault :: HTraversable t => (f ~> g) -> t f ~> t g+hmapDefault f = runIdentity . htraverse (Identity . f)++instance HTraversable Coyoneda where+    htraverse f (Coyoneda g x) = Coyoneda g <$> f x++instance HTraversable1 Coyoneda where+    htraverse1 f (Coyoneda g x) = Coyoneda g <$> f x++instance HTraversable CCY.Coyoneda where+    htraverse f (CCY.Coyoneda g x) = CCY.Coyoneda g <$> f x++instance HTraversable1 CCY.Coyoneda where+    htraverse1 f (CCY.Coyoneda g x) = CCY.Coyoneda g <$> f x++instance HTraversable Ap where+    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> Ap f a -> h (Ap g a)+    htraverse f = go+      where+        go :: Ap f b -> h (Ap g b)+        go = \case+          Ap.Pure x  -> pure (Ap.Pure x)+          Ap.Ap x xs -> Ap.Ap <$> f x <*> go xs++instance HTraversable ListF where+    htraverse f (ListF xs) = ListF <$> traverse f xs++instance HTraversable NonEmptyF where+    htraverse f (NonEmptyF xs) = NonEmptyF <$> traverse f xs++instance HTraversable1 NonEmptyF where+    htraverse1 f (NonEmptyF xs) = NonEmptyF <$> traverse1 f xs++instance HTraversable MaybeF where+    htraverse f (MaybeF xs) = MaybeF <$> traverse f xs++instance HTraversable (MapF k) where+    htraverse f (MapF xs) = MapF <$> traverse f xs++instance HTraversable (NEMapF k) where+    htraverse f (NEMapF xs) = NEMapF <$> traverse f xs++instance HTraversable1 (NEMapF k) where+    htraverse1 f (NEMapF xs) = NEMapF <$> traverse1 f xs++instance HTraversable Alt.Alt where+    htraverse f (Alt.Alt xs) = Alt.Alt <$> traverse (htraverse f) xs++instance HTraversable Alt.AltF where+    htraverse f = \case+      Alt.Ap x xs -> Alt.Ap <$> f x <*> htraverse f xs+      Alt.Pure x  -> pure (Alt.Pure x)++instance HTraversable Step where+    htraverse f (Step n x) = Step n <$> f x++instance HTraversable1 Step where+    htraverse1 f (Step n x) = Step n <$> f x++instance HTraversable Steps where+    htraverse f (Steps x) = Steps <$> traverse f x++instance HTraversable1 Steps where+    htraverse1 f (Steps x) = Steps <$> traverse1 f x++instance HTraversable Flagged where+    htraverse f (Flagged b x) = Flagged b <$> f x++instance HTraversable1 Flagged where+    htraverse1 f (Flagged b x) = Flagged b <$> f x++instance HTraversable MaybeT where+    htraverse f (MaybeT x) = MaybeT <$> f x++instance HTraversable1 MaybeT where+    htraverse1 f (MaybeT x) = MaybeT <$> f x++instance HTraversable FAF.Ap where+    htraverse = itraverse++instance HTraversable FA.Ap where+    htraverse = itraverse++instance HTraversable IdentityT where+    htraverse f (IdentityT x) = IdentityT <$> f x++instance HTraversable1 IdentityT where+    htraverse1 f (IdentityT x) = IdentityT <$> f x++instance HTraversable Lift where+    htraverse f = \case+      Lift.Pure  x -> pure (Lift.Pure x)+      Lift.Other y -> Lift.Other <$> f y++instance HTraversable MaybeApply where+    htraverse f (MaybeApply x) = MaybeApply <$> bitraverse f pure x++instance HTraversable Backwards where+    htraverse f (Backwards x) = Backwards <$> f x++instance HTraversable WrappedApplicative where+    htraverse f (WrapApplicative x) = WrapApplicative <$> f x++instance HTraversable Tagged where+    htraverse _ = pure . coerce++instance HTraversable Reverse where+    htraverse f (Reverse x) = Reverse <$> f x++instance HTraversable1 Reverse where+    htraverse1 f (Reverse x) = Reverse <$> f x++instance (HTraversable s, HTraversable t) => HTraversable (ComposeT s t) where+    htraverse f (ComposeT x) = ComposeT <$> htraverse (htraverse f) x++instance Traversable f => HTraversable ((:.:) f) where+    htraverse f (Comp1 x) = Comp1 <$> traverse f x++instance Traversable1 f => HTraversable1 ((:.:) f) where+    htraverse1 f (Comp1 x) = Comp1 <$> traverse1 f x++instance HTraversable (M1 i c) where+    htraverse f (M1 x) = M1 <$> f x++instance HTraversable1 (M1 i c) where+    htraverse1 f (M1 x) = M1 <$> f x++instance HTraversable Void2 where+    htraverse _ = \case {}++instance HTraversable1 Void2 where+    htraverse1 _ = \case {}++instance HTraversable (EnvT e) where+    htraverse f (EnvT e x) = EnvT e <$> f x++instance HTraversable1 (EnvT e) where+    htraverse1 f (EnvT e x) = EnvT e <$> f x++instance HTraversable Rec where+    htraverse = rtraverse++instance HTraversable CoRec where+    htraverse f (CoRec x) = CoRec <$> f x++instance HTraversable SOP.NP where+    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> SOP.NP f a -> h (SOP.NP g a)+    htraverse f = go+      where+        go :: SOP.NP f b -> h (SOP.NP g b)+        go = \case+          SOP.Nil     -> pure SOP.Nil+          x SOP.:* xs -> (SOP.:*) <$> f x <*> go xs++instance HTraversable SOP.NS where+    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> SOP.NS f a -> h (SOP.NS g a)+    htraverse f = go+      where+        go :: SOP.NS f b -> h (SOP.NS g b)+        go = \case+          SOP.Z x  -> SOP.Z <$> f x+          SOP.S xs -> SOP.S <$> go xs++instance HTraversable1 SOP.NS where+    htraverse1+        :: forall f g h a. Apply h+        => (forall x. f x -> h (g x))+        -> SOP.NS f a+        -> h (SOP.NS g a)+    htraverse1 f = go+      where+        go :: SOP.NS f b -> h (SOP.NS g b)+        go = \case+          SOP.Z x  -> SOP.Z <$> f x+          SOP.S xs -> SOP.S <$> go xs++instance HTraversable (Day f) where+    htraverse f (Day x y g) = (\y' -> Day x y' g) <$> f y++instance HTraversable1 (Day f) where+    htraverse1 f (Day x y g) = (\y' -> Day x y' g) <$> f y++instance HTraversable (ID.Day f) where+    htraverse f (ID.Day x y g h) = (\y' -> ID.Day x y' g h) <$> f y++instance HTraversable1 (ID.Day f) where+    htraverse1 f (ID.Day x y g h) = (\y' -> ID.Day x y' g h) <$> f y++instance HTraversable (IN.Night f) where+    htraverse f (IN.Night x y g h j) = (\y' -> IN.Night x y' g h j) <$> f y++instance HTraversable1 (IN.Night f) where+    htraverse1 f (IN.Night x y g h j) = (\y' -> IN.Night x y' g h j) <$> f y++instance HTraversable ((:*:) f) where+    htraverse f (x :*: y) = (x :*:) <$> f y++instance HTraversable1 ((:*:) f) where+    htraverse1 f (x :*: y) = (x :*:) <$> f y++instance HTraversable ((:+:) f) where+    htraverse f = \case+      L1 x -> pure (L1 x)+      R1 y -> R1 <$> f y++instance HTraversable (Product f) where+    htraverse f (Pair x y) = Pair x <$> f y++instance HTraversable1 (Product f) where+    htraverse1 f (Pair x y) = Pair x <$> f y++instance HTraversable (Sum f) where+    htraverse f = \case+      InL x -> pure (InL x)+      InR y -> InR <$> f y++instance HTraversable (Joker f) where+    htraverse _ = pure . coerce++instance HTraversable (These1 f) where+    htraverse f = \case+      This1  x   -> pure $ This1 x+      That1    y -> That1 <$> f y+      These1 x y -> These1 x <$> f y++instance HTraversable (Void3 f) where+    htraverse _ = \case {}++instance HTraversable ProxyF where+    htraverse _ = pure . coerce++instance HTraversable (ConstF e) where+    htraverse _ = pure . coerce++instance HTraversable t => HTraversable (HLift t) where+    htraverse f = \case+      HPure  x -> HPure  <$> f x+      HOther x -> HOther <$> htraverse f x++instance HTraversable1 t => HTraversable1 (HLift t) where+    htraverse1 f = \case+      HPure  x -> HPure  <$> f x+      HOther x -> HOther <$> htraverse1 f x++instance HTraversable t => HTraversable (HFree t) where+    htraverse :: forall f g h a. Applicative h => (forall x. f x -> h (g x)) -> HFree t f a -> h (HFree t g a)+    htraverse f = go+      where+        go :: HFree t f b -> h (HFree t g b)+        go = \case+          HReturn x -> HReturn <$> f x+          HJoin   x -> HJoin   <$> htraverse go x++instance HTraversable1 t => HTraversable1 (HFree t) where+    htraverse1 :: forall f g h a. Apply h => (forall x. f x -> h (g x)) -> HFree t f a -> h (HFree t g a)+    htraverse1 f = go+      where+        go :: HFree t f b -> h (HFree t g b)+        go = \case+          HReturn x -> HReturn <$> f x+          HJoin   x -> HJoin   <$> htraverse1 go x+

@@ -233,6 +233,12 @@ instance HFunctor Alt.Alt where     hmap = Alt.hoistAlt +-- | @since 0.3.6.0+instance HFunctor Alt.AltF where+    hmap f = \case+      Alt.Ap x xs -> Alt.Ap (f x) (hmap f xs)+      Alt.Pure x  -> Alt.Pure x+ instance HFunctor Step where     hmap f (Step n x) = Step n (f x) @@ -322,6 +328,15 @@ instance HFunctor SOP.NS where     hmap f = SOP.cata_NS (SOP.Z . f) SOP.S +instance HFunctor (Joker f) where+    hmap _ = coerce++instance HFunctor (Void3 f) where+    hmap _ = \case {}++instance HFunctor (Comp f) where+    hmap f (x :>>= h) = x :>>= (f . h)+ instance HBifunctor (:*:) where     hleft  f (x :*: y) = f x :*:   y     hright g (x :*: y) =   x :*: g y@@ -413,7 +428,4 @@ deriving via (WrappedHBifunctor (:+:) f)    instance HFunctor ((:+:) f) deriving via (WrappedHBifunctor Product f)  instance HFunctor (Product f) deriving via (WrappedHBifunctor Sum f)      instance HFunctor (Sum f)-deriving via (WrappedHBifunctor Joker f)    instance HFunctor (Joker f) deriving via (WrappedHBifunctor These1 f)   instance HFunctor (These1 f)-deriving via (WrappedHBifunctor Void3 f)    instance HFunctor (Void3 f)-deriving via (WrappedHBifunctor Comp f)     instance HFunctor (Comp f)

@@ -46,6 +46,7 @@   , iget   , icollect   , icollect1+  , itraverse   , iapply   , ifanout   , ifanout1@@ -183,6 +184,10 @@ --      -> Int -- @ --+-- Note that in many cases, you can also use+-- 'Data.HFunctor.HTraversable.hfoldMap' and+-- 'Data.HFunctor.HTraversable.hfoldMap1'.+-- -- @since 0.3.1.0 iget     :: Interpret t (AltConst b)@@ -213,6 +218,9 @@ --      -> [Int] -- @ --+-- Note that in many cases, you can also use+-- 'Data.HFunctor.HTraversable.htoList'.+-- -- @since 0.3.1.0 icollect     :: (forall m. Monoid m => Interpret t (AltConst m))@@ -242,6 +250,9 @@ --      -> 'NonEmpty' Int -- @ --+-- Note that in many cases, you can also use+-- 'Data.HFunctor.HTraversable.htoNonEmpty'.+-- -- @since 0.3.1.0 icollect1     :: (forall m. Semigroup m => Interpret t (AltConst m))@@ -249,6 +260,21 @@     -> t f a     -> NonEmpty b icollect1 f = fromNDL . iget (ndlSingleton . f)++-- | Useful wrapper over 'interpret' to allow you to do an "effectful"+-- 'hmap'.+--+-- This can be useful in some situations, but if you want to do this, it's+-- probably better to just use 'Data.HFunctor.HTraversable.htraverse',+-- which is a more principled system for effectful hmapping.+--+-- @since 0.3.6.0+itraverse+    :: (Functor h, Interpret t (Comp h (t g)))+    => (forall x. f x -> h (g x))+    -> t f a+    -> h (t g a)+itraverse f = unComp . interpret (\x -> f x :>>= inject)  -- | Useful wrapper over 'interpret' to allow you to directly consume -- a value of type @a@ with a @t f a@ to create a @b@.  Do this by

@@ -47,6 +47,7 @@ import           Data.Functor.Invariant import           Data.Functor.Plus import           Data.HFunctor+import           Data.HFunctor.HTraversable import           Data.HFunctor.Interpret import           Data.Profunctor import           Data.Void@@ -183,6 +184,9 @@ instance Inject t => Inject (PreT t) where     inject = PreT . inject . (id :>$<:) +instance HTraversable t => HTraversable (PreT t) where+    htraverse f = fmap PreT . htraverse (htraverse f) . unPreT+ instance Interpret t f => Interpret (PreT t) f where     interpret f = interpret f . hmap getPre . unPreT @@ -222,6 +226,9 @@ instance Inject t => Inject (PostT t) where     inject = PostT . inject . (id :<$>:) +instance HTraversable t => HTraversable (PostT t) where+    htraverse f = fmap PostT . htraverse (htraverse f) . unPostT+ -- | @since 0.3.4.2 instance Interpret t f => Interpret (PostT t) f where     interpret f = interpret f . hmap getPost . unPostT@@ -480,6 +487,12 @@  instance HFunctor (Pre a) where     hmap g (f :>$<: x) = f :>$<: g x++instance HTraversable (Post a) where+    htraverse g (f :<$>: x) = (f :<$>:) <$> g x++instance HTraversable (Pre a) where+    htraverse g (f :>$<: x) = (f :>$<:) <$> g x  instance Monoid a => Inject (Post a) where     inject x = const mempty :<$>: x

@@ -171,9 +171,6 @@     default genHF :: (Inject t, MonadGen m) => m (f a) -> m (t f a)     genHF = fmap inject -class HFunctor t => HTraversable t where-    htraverse :: Applicative h => (forall x. f x -> h (g x)) -> t f a -> h (t g a)- instance TestHFunctor Step where     genHF gx = Step <$> Gen.integral (Range.linear 0 25) <*> gx @@ -260,9 +257,6 @@  instance TestHFunctor Flagged where     genHF gx = Flagged <$> Gen.bool <*> gx--instance HTraversable Flagged where-    htraverse f (Flagged b x) = Flagged b <$> f x  class HBifunctor t => TestHBifunctor t where     genHB