functor-combinators 0.4.1.3 → 0.4.1.4

raw patch · 35 files changed

+5890/−4986 lines, 35 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• functor-combinators.cabal +176/−89
• src/Control/Applicative/ListF.hs +144/−126
• src/Control/Applicative/Step.hs +123/−116
• src/Control/Monad/Freer/Church.hs +233/−185
• src/Control/Natural/IsoF.hs +28/−23
• src/Data/Functor/Apply/Free.hs +56/−54
• src/Data/Functor/Combinator.hs +156/−119
• src/Data/Functor/Combinator/Unsafe.hs +43/−42
• src/Data/Functor/Contravariant/Conclude.hs +9/−10
• src/Data/Functor/Contravariant/Decide.hs +61/−37
• src/Data/Functor/Contravariant/Divise.hs +62/−52
• src/Data/Functor/Contravariant/Divisible/Free.hs +114/−97
• src/Data/Functor/Contravariant/Night.hs +50/−43
• src/Data/Functor/Invariant/Inplicative.hs +419/−265
• src/Data/Functor/Invariant/Inplicative/Free.hs +131/−114
• src/Data/Functor/Invariant/Internative.hs +211/−134
• src/Data/Functor/Invariant/Internative/Free.hs +107/−94
• src/Data/Functor/Invariant/Night.hs +79/−69
• src/Data/HBifunctor.hs +41/−39
• src/Data/HBifunctor/Associative.hs +471/−449
• src/Data/HBifunctor/Tensor.hs +391/−378
• src/Data/HBifunctor/Tensor/Internal.hs +131/−129
• src/Data/HFunctor.hs +269/−246
• src/Data/HFunctor/Chain.hs +153/−141
• src/Data/HFunctor/Chain/Internal.hs +212/−181
• src/Data/HFunctor/Final.hs +251/−198
• src/Data/HFunctor/HTraversable.hs +189/−178
• src/Data/HFunctor/Internal.hs +196/−193
• src/Data/HFunctor/Interpret.hs +218/−214
• src/Data/HFunctor/Route.hs +188/−143
• test/Spec.hs +10/−8
• test/Tests/HBifunctor.hs +528/−430
• test/Tests/HFunctor.hs +232/−213
• test/Tests/Util.hs +199/−177

@@ -1,6 +1,15 @@ Changelog ========= +Version 0.4.1.4+---------------++*June 12, 2025*++<https://github.com/mstksg/functor-combinators/releases/tag/v0.4.1.4>++*   Optimize `(.>)` for `Final` (#10) (@rhendric)+ Version 0.4.1.3 --------------- 

@@ -1,4 +1,4 @@-cabal-version: 1.12+cabal-version:      1.24  -- This file has been generated from package.yaml by hpack version 0.33.0. --@@ -6,85 +6,128 @@ -- -- hash: c98f05061d45352f630dd964c7671a2a414e5708a12f8f4f8a39d61b986f6f5d -name:           functor-combinators-version:        0.4.1.3-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"-                them in some way.  In the process, you can design featureful programs by-                composing smaller "primitives" using basic unversal combinators.-                .-                The main entry point is "Data.Functor.Combinators", but more fine-grained-                functionality and extra combinators (some of them re-implementations for-                compatibility) are available in other modules as well.-                .-                This library does not define new functor combinators for the most part,-                but rather re-exports them from different parts of the Haskell ecosystem-                and provides a uniform interface.-                .-                See the README for a quick overview, and also-                <https://blog.jle.im/entry/functor-combinatorpedia.html> for an in-depth-                dive into the motivation behind functor combinator-driven development,-                examples of the functor combinators in this library, and details about how-                to use these abstractions!-category:       Data-homepage:       https://github.com/mstksg/functor-combinators#readme-bug-reports:    https://github.com/mstksg/functor-combinators/issues-author:         Justin Le-maintainer:     justin@jle.im-copyright:      (c) Justin Le 2019-license:        BSD3-license-file:   LICENSE-tested-with:    GHC >= 8.6-build-type:     Simple+name:               functor-combinators+version:            0.4.1.4+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"+  them in some way.  In the process, you can design featureful programs by+  composing smaller "primitives" using basic unversal combinators.+  .+  The main entry point is "Data.Functor.Combinators", but more fine-grained+  functionality and extra combinators (some of them re-implementations for+  compatibility) are available in other modules as well.+  .+  This library does not define new functor combinators for the most part,+  but rather re-exports them from different parts of the Haskell ecosystem+  and provides a uniform interface.+  .+  See the README for a quick overview, and also+  <https://blog.jle.im/entry/functor-combinatorpedia.html> for an in-depth+  dive into the motivation behind functor combinator-driven development,+  examples of the functor combinators in this library, and details about how+  to use these abstractions!++category:           Data+homepage:           https://github.com/mstksg/functor-combinators#readme+bug-reports:        https://github.com/mstksg/functor-combinators/issues+author:             Justin Le+maintainer:         justin@jle.im+copyright:          (c) Justin Le 2025+license:            BSD3+license-file:       LICENSE+tested-with:        GHC >=8.6+build-type:         Simple extra-source-files:-    README.md-    CHANGELOG.md+  CHANGELOG.md+  README.md  source-repository head-  type: git+  type:     git   location: https://github.com/mstksg/functor-combinators  library   exposed-modules:-      Control.Applicative.ListF-      Control.Applicative.Step-      Control.Monad.Freer.Church-      Control.Natural.IsoF-      Data.Functor.Apply.Free-      Data.Functor.Combinator-      Data.Functor.Combinator.Unsafe-      Data.Functor.Contravariant.Conclude-      Data.Functor.Contravariant.Decide-      Data.Functor.Contravariant.Divise-      Data.Functor.Contravariant.Divisible.Free-      Data.Functor.Contravariant.Night-      Data.Functor.Invariant.Inplicative-      Data.Functor.Invariant.Inplicative.Free-      Data.Functor.Invariant.Internative-      Data.Functor.Invariant.Internative.Free-      Data.Functor.Invariant.Night-      Data.HBifunctor-      Data.HBifunctor.Associative-      Data.HBifunctor.Tensor-      Data.HFunctor-      Data.HFunctor.Chain-      Data.HFunctor.Final-      Data.HFunctor.HTraversable-      Data.HFunctor.Interpret-      Data.HFunctor.Route+    Control.Applicative.ListF+    Control.Applicative.Step+    Control.Monad.Freer.Church+    Control.Natural.IsoF+    Data.Functor.Apply.Free+    Data.Functor.Combinator+    Data.Functor.Combinator.Unsafe+    Data.Functor.Contravariant.Conclude+    Data.Functor.Contravariant.Decide+    Data.Functor.Contravariant.Divise+    Data.Functor.Contravariant.Divisible.Free+    Data.Functor.Contravariant.Night+    Data.Functor.Invariant.Inplicative+    Data.Functor.Invariant.Inplicative.Free+    Data.Functor.Invariant.Internative+    Data.Functor.Invariant.Internative.Free+    Data.Functor.Invariant.Night+    Data.HBifunctor+    Data.HBifunctor.Associative+    Data.HBifunctor.Tensor+    Data.HFunctor+    Data.HFunctor.Chain+    Data.HFunctor.Final+    Data.HFunctor.HTraversable+    Data.HFunctor.Interpret+    Data.HFunctor.Route+   other-modules:-      Data.HFunctor.Internal-      Data.HFunctor.Chain.Internal-      Data.HBifunctor.Tensor.Internal-  hs-source-dirs:-      src-  default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies EmptyCase ExistentialQuantification ExplicitNamespaces FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms QuantifiedConstraints RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies PolyKinds TypeOperators UndecidableInstances UndecidableSuperClasses ViewPatterns-  ghc-options: -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns+    Data.HBifunctor.Tensor.Internal+    Data.HFunctor.Chain.Internal+    Data.HFunctor.Internal++  hs-source-dirs:     src+  default-extensions:+    AllowAmbiguousTypes+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingStrategies+    EmptyCase+    ExistentialQuantification+    ExplicitNamespaces+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    InstanceSigs+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    OverloadedStrings+    PatternSynonyms+    PolyKinds+    QuantifiedConstraints+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UndecidableInstances+    UndecidableSuperClasses+    ViewPatterns++  ghc-options:+    -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns+    -Wunused-packages+   build-depends:-      StateVar-    , assoc-    , base >=4.12 && <5+      assoc+    , base                    >=4.12    && <5     , bifunctors     , comonad     , constraints@@ -98,42 +141,86 @@     , mmorph     , mtl     , natural-transformation-    , nonempty-containers >=0.3.4.4+    , nonempty-containers     >=0.3.4.4     , pointed     , profunctors     , semigroupoids     , sop-core+    , StateVar     , tagged     , these     , transformers-    , trivial-constraint >=0.5+    , trivial-constraint      >=0.5     , unordered-containers     , vinyl-  default-language: Haskell2010 +  default-language:   Haskell2010+ test-suite functor-combinators-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs+  type:               exitcode-stdio-1.0+  main-is:            Spec.hs   other-modules:-      Tests.HBifunctor-      Tests.HFunctor-      Tests.Util-      Paths_functor_combinators-  hs-source-dirs:-      test-  default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies EmptyCase ExistentialQuantification ExplicitNamespaces FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms QuantifiedConstraints RankNTypes ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies PolyKinds TypeOperators UndecidableInstances UndecidableSuperClasses ViewPatterns-  ghc-options: -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns -threaded -rtsopts -with-rtsopts=-N+    Paths_functor_combinators+    Tests.HBifunctor+    Tests.HFunctor+    Tests.Util++  hs-source-dirs:     test+  default-extensions:+    AllowAmbiguousTypes+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingStrategies+    EmptyCase+    ExistentialQuantification+    ExplicitNamespaces+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    InstanceSigs+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    OverloadedStrings+    PatternSynonyms+    PolyKinds+    QuantifiedConstraints+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UndecidableInstances+    UndecidableSuperClasses+    ViewPatterns++  ghc-options:+    -Wall -Wcompat -Wredundant-constraints -Werror=incomplete-patterns+    -threaded -rtsopts -with-rtsopts=-N -Wunused-packages+   build-depends:-      base >=4.12 && <5+      base                 >=4.12    && <5     , bifunctors     , dependent-sum     , free     , functor-combinators-    , hedgehog >=0.6-    , nonempty-containers >=0.3.4.4+    , hedgehog             >=0.6+    , nonempty-containers  >=0.3.4.4     , semigroupoids     , tasty     , tasty-hedgehog     , transformers-    , trivial-constraint >=0.5-  default-language: Haskell2010+    , trivial-constraint   >=0.5++  default-language:   Haskell2010

@@ -1,6 +1,6 @@ -- | -- Module      : Control.Applicative.ListF--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -16,41 +16,49 @@ -- f :*: f :*: f@, etc. module Control.Applicative.ListF (   -- * 'ListF'-    ListF(..), mapListF+  ListF (..),+  mapListF,+   -- * 'NonEmptyF'-  , NonEmptyF(.., ProdNonEmpty, nonEmptyProd), mapNonEmptyF-  , toListF, fromListF+  NonEmptyF (.., ProdNonEmpty, nonEmptyProd),+  mapNonEmptyF,+  toListF,+  fromListF,+   -- * 'MaybeF'-  , MaybeF(..), mapMaybeF-  , listToMaybeF, maybeToListF+  MaybeF (..),+  mapMaybeF,+  listToMaybeF,+  maybeToListF,+   -- * 'MapF'-  , MapF(..)-  , NEMapF(..)-  ) where+  MapF (..),+  NEMapF (..),+) where -import           Control.Applicative-import           Control.Natural-import           Data.Coerce-import           Data.Data-import           Data.Deriving-import           Data.Foldable-import           Data.Functor.Bind-import           Data.Functor.Classes-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.Plus-import           Data.List.NonEmpty                   (NonEmpty(..))-import           Data.Maybe-import           Data.Pointed-import           Data.Semigroup.Foldable-import           Data.Semigroup.Traversable-import           GHC.Generics-import qualified Data.Map                             as M-import qualified Data.Map.NonEmpty                    as NEM+import Control.Applicative+import Control.Natural+import Data.Coerce+import Data.Data+import Data.Deriving+import Data.Foldable+import Data.Functor.Bind+import Data.Functor.Classes+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.Plus+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map as M+import qualified Data.Map.NonEmpty as NEM+import Data.Maybe+import Data.Pointed+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import GHC.Generics  -- | A list of @f a@s.  Can be used to describe a product of many different -- values of type @f a@.@@ -59,7 +67,7 @@ -- -- Incidentally, if used with a 'Contravariant' @f@, this is instead the -- free 'Divisible'.-newtype ListF f a = ListF { runListF :: [f a] }+newtype ListF f a = ListF {runListF :: [f a]}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''ListF@@ -68,69 +76,72 @@ deriveOrd1 ''ListF  instance Apply f => Apply (ListF f) where-    ListF fs <.> ListF xs = ListF $ liftF2 (<.>) fs xs+  ListF fs <.> ListF xs = ListF $ liftF2 (<.>) fs xs instance Applicative f => Applicative (ListF f) where-    pure  = ListF . (:[]) . pure-    ListF fs <*> ListF xs = ListF $ liftA2 (<*>) fs xs+  pure = ListF . (: []) . pure+  ListF fs <*> ListF xs = ListF $ liftA2 (<*>) fs xs  instance Functor f => Alt (ListF f) where-    (<!>) = (<>)+  (<!>) = (<>)  instance Functor f => Plus (ListF f) where-    zero = mempty+  zero = mempty  instance Applicative f => Alternative (ListF f) where-    empty = zero-    (<|>) = (<!>)+  empty = zero+  (<|>) = (<!>)  instance Semigroup (ListF f a) where-    ListF xs <> ListF ys = ListF (xs ++ ys)+  ListF xs <> ListF ys = ListF (xs ++ ys)  instance Monoid (ListF f a) where-    mempty = ListF []+  mempty = ListF []  instance Pointed f => Pointed (ListF f) where-    point = ListF . (: []) . point+  point = ListF . (: []) . point  -- | @since 0.3.0.0 instance Contravariant f => Contravariant (ListF f) where-    contramap f (ListF xs) = ListF ((map . contramap) f xs)+  contramap f (ListF xs) = ListF ((map . contramap) f xs)  -- | @since 0.3.0.0 instance Invariant f => Invariant (ListF f) where-    invmap f g (ListF xs) = ListF (map (invmap f g) xs)+  invmap f g (ListF xs) = ListF (map (invmap f g) xs)  -- | @since 0.3.0.0 instance Contravariant f => Divise (ListF f) where-    divise f (ListF xs) (ListF ys) = ListF $-         (map . contramap) (fst . f) xs-      <> (map . contramap) (snd . f) ys+  divise f (ListF xs) (ListF ys) =+    ListF $+      (map . contramap) (fst . f) xs+        <> (map . contramap) (snd . f) ys  -- | @since 0.3.0.0 instance Contravariant f => Divisible (ListF f) where-    divide  = divise-    conquer = ListF []+  divide = divise+  conquer = ListF []  -- | @since 0.3.0.0 instance Decide f => Decide (ListF f) where-    decide f (ListF xs) (ListF ys) = ListF $-        liftA2 (decide f) xs ys+  decide f (ListF xs) (ListF ys) =+    ListF $+      liftA2 (decide f) xs ys  -- | @since 0.3.0.0 instance Conclude f => Conclude (ListF f) where-    conclude f = ListF [conclude f]+  conclude f = ListF [conclude f]  -- | @since 0.3.0.0 instance Decidable f => Decidable (ListF f) where-    lose f = ListF [lose f]-    choose f (ListF xs) (ListF ys) = ListF $-        liftA2 (choose f) xs ys+  lose f = ListF [lose f]+  choose f (ListF xs) (ListF ys) =+    ListF $+      liftA2 (choose f) xs ys  -- | Map a function over the inside of a 'ListF'.-mapListF-    :: ([f a] -> [g b])-    -> ListF f a-    -> ListF g b+mapListF ::+  ([f a] -> [g b]) ->+  ListF f a ->+  ListF g b mapListF = coerce  -- | A non-empty list of @f a@s.  Can be used to describe a product between@@ -151,7 +162,7 @@ -- -- Incidentally, if used with a 'Contravariant' @f@, this is instead the -- free 'Divise'.-newtype NonEmptyF f a = NonEmptyF { runNonEmptyF :: NonEmpty (f a) }+newtype NonEmptyF f a = NonEmptyF {runNonEmptyF :: NonEmpty (f a)}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''NonEmptyF@@ -160,39 +171,44 @@ deriveOrd1 ''NonEmptyF  instance Applicative f => Applicative (NonEmptyF f) where-    pure  = NonEmptyF . (:| []) . pure-    NonEmptyF fs <*> NonEmptyF xs = NonEmptyF $ liftA2 (<*>) fs xs+  pure = NonEmptyF . (:| []) . pure+  NonEmptyF fs <*> NonEmptyF xs = NonEmptyF $ liftA2 (<*>) fs xs  instance Functor f => Alt (NonEmptyF f) where-    (<!>) = (<>)+  (<!>) = (<>)  -- | @since 0.3.0.0 instance Contravariant f => Contravariant (NonEmptyF f) where-    contramap f (NonEmptyF xs) = NonEmptyF (fmap (contramap f) xs)+  contramap f (NonEmptyF xs) = NonEmptyF (fmap (contramap f) xs)+ -- | @since 0.3.0.0 instance Invariant f => Invariant (NonEmptyF f) where-    invmap f g (NonEmptyF xs) = NonEmptyF (fmap (invmap f g) xs)+  invmap f g (NonEmptyF xs) = NonEmptyF (fmap (invmap f g) xs)+ -- | @since 0.3.0.0 instance Contravariant f => Divise (NonEmptyF f) where-    divise f (NonEmptyF xs) (NonEmptyF ys) = NonEmptyF $-         (fmap . contramap) (fst . f) xs-      <> (fmap . contramap) (snd . f) ys+  divise f (NonEmptyF xs) (NonEmptyF ys) =+    NonEmptyF $+      (fmap . contramap) (fst . f) xs+        <> (fmap . contramap) (snd . f) ys+ -- | @since 0.3.0.0 instance Decide f => Decide (NonEmptyF f) where-    decide f (NonEmptyF xs) (NonEmptyF ys) = NonEmptyF $+  decide f (NonEmptyF xs) (NonEmptyF ys) =+    NonEmptyF $       decide f <$> xs <*> ys  instance Semigroup (NonEmptyF f a) where-    NonEmptyF xs <> NonEmptyF ys = NonEmptyF (xs <> ys)+  NonEmptyF xs <> NonEmptyF ys = NonEmptyF (xs <> ys)  instance Pointed f => Pointed (NonEmptyF f) where-    point = NonEmptyF . (:| []) . point+  point = NonEmptyF . (:| []) . point  -- | Map a function over the inside of a 'NonEmptyF'.-mapNonEmptyF-    :: (NonEmpty (f a) -> NonEmpty (g b))-    -> NonEmptyF f a-    -> NonEmptyF g b+mapNonEmptyF ::+  (NonEmpty (f a) -> NonEmpty (g b)) ->+  NonEmptyF f a ->+  NonEmptyF g b mapNonEmptyF = coerce  -- | Convert a 'NonEmptyF' into a 'ListF' with at least one item.@@ -203,18 +219,18 @@ -- the list was empty. fromListF :: ListF f ~> (Proxy :+: NonEmptyF f) fromListF (ListF xs) = case xs of-    []   -> L1 Proxy-    y:ys -> R1 $ NonEmptyF (y :| ys)+  [] -> L1 Proxy+  y : ys -> R1 $ NonEmptyF (y :| ys)  -- | Treat a @'NonEmptyF' f@ as a product between an @f@ and a @'ListF' f@. -- -- 'nonEmptyProd' is the record accessor. pattern ProdNonEmpty :: (f :*: ListF f) a -> NonEmptyF f a-pattern ProdNonEmpty { nonEmptyProd-                     }-            <- ((\case NonEmptyF (x :| xs) -> x :*: ListF xs) -> nonEmptyProd)+pattern ProdNonEmpty{nonEmptyProd} <-+  (\case NonEmptyF (x :| xs) -> x :*: ListF xs -> nonEmptyProd)   where     ProdNonEmpty (x :*: ListF xs) = NonEmptyF (x :| xs)+ {-# COMPLETE ProdNonEmpty #-}  -- | A maybe @f a@.@@ -223,7 +239,7 @@ -- -- This is the free structure for a "fail"-like typeclass that would only -- have @zero :: f a@.-newtype MaybeF f a = MaybeF { runMaybeF :: Maybe (f a) }+newtype MaybeF f a = MaybeF {runMaybeF :: Maybe (f a)}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''MaybeF@@ -232,68 +248,71 @@ deriveOrd1 ''MaybeF  instance Applicative f => Applicative (MaybeF f) where-    pure = MaybeF . Just . pure-    MaybeF f <*> MaybeF x = MaybeF $ liftA2 (<*>) f x+  pure = MaybeF . Just . pure+  MaybeF f <*> MaybeF x = MaybeF $ liftA2 (<*>) f x  instance Functor f => Alt (MaybeF f) where-    (<!>) = (<>)+  (<!>) = (<>)  instance Functor f => Plus (MaybeF f) where-    zero = mempty+  zero = mempty  instance Applicative f => Alternative (MaybeF f) where-    empty = zero-    (<|>) = (<!>)+  empty = zero+  (<|>) = (<!>)  -- | @since 0.3.3.0 instance Contravariant f => Contravariant (MaybeF f) where-    contramap f (MaybeF x) = MaybeF $ (fmap . contramap) f x+  contramap f (MaybeF x) = MaybeF $ (fmap . contramap) f x  -- | @since 0.3.3.0 instance Invariant f => Invariant (MaybeF f) where-    invmap f g (MaybeF x) = MaybeF $ fmap (invmap f g) x+  invmap f g (MaybeF x) = MaybeF $ fmap (invmap f g) x  -- | @since 0.3.3.0 instance Contravariant f => Divise (MaybeF f) where-    divise f (MaybeF x) (MaybeF y) = MaybeF $-          (fmap . contramap) (fst . f) x-      <|> (fmap . contramap) (snd . f) y+  divise f (MaybeF x) (MaybeF y) =+    MaybeF $+      (fmap . contramap) (fst . f) x+        <|> (fmap . contramap) (snd . f) y  -- | @since 0.3.3.0 instance Contravariant f => Divisible (MaybeF f) where-    divide  = divise-    conquer = MaybeF Nothing+  divide = divise+  conquer = MaybeF Nothing  -- | @since 0.3.3.0 instance Decide f => Decide (MaybeF f) where-    decide f (MaybeF x) (MaybeF y) = MaybeF $-        liftA2 (decide f) x y+  decide f (MaybeF x) (MaybeF y) =+    MaybeF $+      liftA2 (decide f) x y  -- | @since 0.3.3.0 instance Conclude f => Conclude (MaybeF f) where-    conclude f = MaybeF (Just (conclude f))+  conclude f = MaybeF (Just (conclude f))  -- | @since 0.3.3.0 instance Decidable f => Decidable (MaybeF f) where-    choose f (MaybeF x) (MaybeF y) = MaybeF $-        liftA2 (choose f) x y-    lose f = MaybeF (Just (lose f))+  choose f (MaybeF x) (MaybeF y) =+    MaybeF $+      liftA2 (choose f) x y+  lose f = MaybeF (Just (lose f))  -- | Picks the first 'Just'. instance Semigroup (MaybeF f a) where-    MaybeF xs <> MaybeF ys = MaybeF (xs <!> ys)+  MaybeF xs <> MaybeF ys = MaybeF (xs <!> ys)  instance Monoid (MaybeF f a) where-    mempty = MaybeF Nothing+  mempty = MaybeF Nothing  instance Pointed f => Pointed (MaybeF f) where-    point = MaybeF . Just . point+  point = MaybeF . Just . point  -- | Map a function over the inside of a 'MaybeF'.-mapMaybeF-    :: (Maybe (f a) -> Maybe (g b))-    -> MaybeF f a-    -> MaybeF g b+mapMaybeF ::+  (Maybe (f a) -> Maybe (g b)) ->+  MaybeF f a ->+  MaybeF g b mapMaybeF = coerce  -- | Convert a 'MaybeF' into a 'ListF' with zero or one items.@@ -333,7 +352,7 @@ -- -- See 'NEMapF' for a non-empty variant, if you want to enforce that your -- bag has at least one @f a@.-newtype MapF k f a = MapF { runMapF :: M.Map k (f a) }+newtype MapF k f a = MapF {runMapF :: M.Map k (f a)}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''MapF@@ -341,24 +360,24 @@ deriveOrd1 ''MapF  instance (Ord k, Read k, Read1 f) => Read1 (MapF k f) where-    liftReadsPrec = $(makeLiftReadsPrec ''MapF)+  liftReadsPrec = $(makeLiftReadsPrec ''MapF)  -- | A union, combining matching keys with '<!>'. instance (Ord k, Alt f) => Semigroup (MapF k f a) where-    MapF xs <> MapF ys = MapF $ M.unionWith (<!>) xs ys+  MapF xs <> MapF ys = MapF $ M.unionWith (<!>) xs ys  instance (Ord k, Alt f) => Monoid (MapF k f a) where-    mempty = MapF M.empty+  mempty = MapF M.empty  -- | Left-biased union instance (Functor f, Ord k) => Alt (MapF k f) where-    MapF xs <!> MapF ys = MapF $ M.union xs ys+  MapF xs <!> MapF ys = MapF $ M.union xs ys  instance (Functor f, Ord k) => Plus (MapF k f) where-    zero = MapF M.empty+  zero = MapF M.empty  instance (Monoid k, Pointed f) => Pointed (MapF k f) where-    point = MapF . M.singleton mempty . point+  point = MapF . M.singleton mempty . point  -- | A non-empty map of @f a@s, indexed by keys of type @k@.  It can be -- useful for represeting a product of many different values of type @f a@,@@ -371,7 +390,7 @@ -- keys. -- -- See 'MapF' for some use cases.-newtype NEMapF k f a = NEMapF { runNEMapF :: NEM.NEMap k (f a) }+newtype NEMapF k f a = NEMapF {runNEMapF :: NEM.NEMap k (f a)}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''NEMapF@@ -379,25 +398,24 @@ deriveOrd1 ''NEMapF  instance (Ord k, Read k, Read1 f) => Read1 (NEMapF k f) where-    liftReadsPrec = $(makeLiftReadsPrec ''NEMapF)+  liftReadsPrec = $(makeLiftReadsPrec ''NEMapF)  instance Foldable1 f => Foldable1 (NEMapF k f) where-    fold1      = foldMap1 fold1 . runNEMapF-    foldMap1 f = (foldMap1 . foldMap1) f . runNEMapF-    toNonEmpty = foldMap1 toNonEmpty . runNEMapF+  fold1 = foldMap1 fold1 . runNEMapF+  foldMap1 f = (foldMap1 . foldMap1) f . runNEMapF+  toNonEmpty = foldMap1 toNonEmpty . runNEMapF  instance Traversable1 f => Traversable1 (NEMapF k f) where-    traverse1 f = fmap NEMapF . (traverse1 . traverse1) f . runNEMapF-    sequence1   = fmap NEMapF . traverse1 sequence1 . runNEMapF+  traverse1 f = fmap NEMapF . (traverse1 . traverse1) f . runNEMapF+  sequence1 = fmap NEMapF . traverse1 sequence1 . runNEMapF  -- | A union, combining matching keys with '<!>'. instance (Ord k, Alt f) => Semigroup (NEMapF k f a) where-    NEMapF xs <> NEMapF ys = NEMapF $ NEM.unionWith (<!>) xs ys+  NEMapF xs <> NEMapF ys = NEMapF $ NEM.unionWith (<!>) xs ys  -- | Left-biased union instance (Functor f, Ord k) => Alt (NEMapF k f) where-    NEMapF xs <!> NEMapF ys = NEMapF $ NEM.union xs ys+  NEMapF xs <!> NEMapF ys = NEMapF $ NEM.union xs ys  instance (Monoid k, Pointed f) => Pointed (NEMapF k f) where-    point = NEMapF . NEM.singleton mempty . point-+  point = NEMapF . NEM.singleton mempty . point

@@ -2,7 +2,7 @@  -- | -- Module      : Control.Applicative.Step--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -16,47 +16,49 @@ -- ':+:' and 'Data.Functor.These.These1'. module Control.Applicative.Step (   -- * Fixed Points-    Step(..)-  , Steps(..)-  , Flagged(..)+  Step (..),+  Steps (..),+  Flagged (..),+   -- ** Steppers-  , stepUp-  , stepDown-  , stepping-  , stepsUp-  , stepsDown-  , steppings+  stepUp,+  stepDown,+  stepping,+  stepsUp,+  stepsDown,+  steppings,+   -- * Void-  , absurd1-  , Void2-  , absurd2-  , Void3-  , absurd3-  ) where+  absurd1,+  Void2,+  absurd2,+  Void3,+  absurd3,+) where -import           Control.Natural-import           Control.Natural.IsoF-import           Data.Bifunctor-import           Data.Data-import           Data.Deriving-import           Data.Functor.Alt-import           Data.Functor.Bind-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.These-import           Data.Map.NonEmpty                    (NEMap)-import           Data.Pointed-import           Data.Semigroup-import           Data.Semigroup.Foldable-import           Data.Semigroup.Traversable-import           Data.These-import           GHC.Generics-import           GHC.Natural-import qualified Data.Map.NonEmpty                    as NEM+import Control.Natural+import Control.Natural.IsoF+import Data.Bifunctor+import Data.Data+import Data.Deriving+import Data.Functor.Alt+import Data.Functor.Bind+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.These+import Data.Map.NonEmpty (NEMap)+import qualified Data.Map.NonEmpty as NEM+import Data.Pointed+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.These+import GHC.Generics+import GHC.Natural  -- | An @f a@, along with a 'Natural' index. --@@ -79,7 +81,7 @@ -- -- Note that this type and its instances equivalent to -- @'Control.Comonad.Trans.Env.EnvT' ('Data.Semigroup.Sum' 'Natural')@.-data Step f a = Step { stepPos :: Natural, stepVal :: f a }+data Step f a = Step {stepPos :: Natural, stepVal :: f a}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''Step@@ -89,50 +91,53 @@  -- | @since 0.3.0.0 instance Apply f => Apply (Step f) where-    Step n f <.> Step m x = Step (n + m) (f <.> x)+  Step n f <.> Step m x = Step (n + m) (f <.> x)  instance Applicative f => Applicative (Step f) where-    pure = Step 0 . pure-    Step n f <*> Step m x = Step (n + m) (f <*> x)+  pure = Step 0 . pure+  Step n f <*> Step m x = Step (n + m) (f <*> x)  -- | @since 0.3.0.0 instance Contravariant f => Contravariant (Step f) where-    contramap f (Step x y) = Step x (contramap f y)+  contramap f (Step x y) = Step x (contramap f y)  -- | @since 0.3.0.0 instance Divisible f => Divisible (Step f) where-    divide f (Step n x) (Step m y) = Step (n + m) (divide f x y)-    conquer = Step 0 conquer+  divide f (Step n x) (Step m y) = Step (n + m) (divide f x y)+  conquer = Step 0 conquer+ -- | @since 0.3.0.0 instance Divise f => Divise (Step f) where-    divise f (Step n x) (Step m y) = Step (n + m) (divise f x y)+  divise f (Step n x) (Step m y) = Step (n + m) (divise f x y)  -- | @since 0.3.0.0 instance Decide f => Decide (Step f) where-    decide f (Step n x) (Step m y) = Step (n + m) (decide f x y)+  decide f (Step n x) (Step m y) = Step (n + m) (decide f x y)+ -- | @since 0.3.0.0 instance Conclude f => Conclude (Step f) where-    conclude = Step 0 . conclude+  conclude = Step 0 . conclude+ -- | @since 0.3.0.0 instance Decidable f => Decidable (Step f) where-    choose f (Step n x) (Step m y) = Step (n + m) (choose f x y)-    lose = Step 0 . lose+  choose f (Step n x) (Step m y) = Step (n + m) (choose f x y)+  lose = Step 0 . lose  -- | @since 0.3.0.0 instance Invariant f => Invariant (Step f) where-    invmap f g (Step x y) = Step x (invmap f g y)+  invmap f g (Step x y) = Step x (invmap f g y)  instance Pointed f => Pointed (Step f) where-    point = Step 0 . point+  point = Step 0 . point  instance Foldable1 f => Foldable1 (Step f) where-    fold1      = fold1 . stepVal-    foldMap1 f = foldMap1 f . stepVal-    toNonEmpty = toNonEmpty . stepVal+  fold1 = fold1 . stepVal+  foldMap1 f = foldMap1 f . stepVal+  toNonEmpty = toNonEmpty . stepVal  instance Traversable1 f => Traversable1 (Step f) where-    traverse1 f (Step n x) = Step n <$> traverse1 f x-    sequence1 (Step n x) = Step n <$> sequence1 x+  traverse1 f (Step n x) = Step n <$> traverse1 f x+  sequence1 (Step n x) = Step n <$> sequence1 x  -- | "Uncons and cons" an @f@ branch before a 'Step'.  This is basically -- a witness that 'stepDown' and 'stepUp' form an isomorphism.@@ -164,8 +169,8 @@ -- Forms an isomorphism with 'stepUp' (see 'stepping'). stepDown :: Step f ~> f :+: Step f stepDown (Step n x) = case minusNaturalMaybe n 1 of-    Nothing -> L1 x-    Just m  -> R1 (Step m x)+  Nothing -> L1 x+  Just m -> R1 (Step m x)  -- | Unshift an item into a 'Step'.  Because a @'Step' f@ is @f :+: f :+: -- f :+: f :+: ...@ forever, this basically conses an additional@@ -193,8 +198,8 @@ -- Forms an isomorphism with 'stepDown' (see 'stepping'). stepUp :: f :+: Step f ~> Step f stepUp = \case-    L1 x          -> Step 0       x-    R1 (Step n y) -> Step (n + 1) y+  L1 x -> Step 0 x+  R1 (Step n y) -> Step (n + 1) y  -- | We have a natural transformation between 'V1' and any other -- functor @f@ with no constraints.@@ -230,7 +235,7 @@ -- -- This type is essentailly the same as @'Control.Applicative.ListF.NEMapF' -- ('Sum' 'Natural')@ (except with a different 'Semigroup' instance).-newtype Steps f a = Steps { getSteps :: NEMap Natural (f a) }+newtype Steps f a = Steps {getSteps :: NEMap Natural (f a)}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''Steps@@ -239,39 +244,39 @@ deriveOrd1 ''Steps  instance Foldable1 f => Foldable1 (Steps f) where-    fold1      = foldMap1 fold1 . getSteps-    foldMap1 f = (foldMap1 . foldMap1) f . getSteps-    toNonEmpty = foldMap1 toNonEmpty . getSteps+  fold1 = foldMap1 fold1 . getSteps+  foldMap1 f = (foldMap1 . foldMap1) f . getSteps+  toNonEmpty = foldMap1 toNonEmpty . getSteps  instance Traversable1 f => Traversable1 (Steps f) where-    traverse1 f = fmap Steps . (traverse1 . traverse1) f . getSteps-    sequence1   = fmap Steps . traverse1 sequence1 . getSteps+  traverse1 f = fmap Steps . (traverse1 . traverse1) f . getSteps+  sequence1 = fmap Steps . traverse1 sequence1 . getSteps  -- | Appends the items back-to-back, shifting all of the items in the -- second map.  Matches the behavior as the fixed-point of 'These1'. instance Semigroup (Steps f a) where-    Steps xs <> Steps ys = Steps $+  Steps xs <> Steps ys =+    Steps $       let (k, _) = NEM.findMax xs-      in  xs <> NEM.mapKeysMonotonic (+ (k + 1)) ys+       in xs <> NEM.mapKeysMonotonic (+ (k + 1)) ys  -- | @since 0.3.0.0 instance Contravariant f => Contravariant (Steps f) where-    contramap f (Steps xs) = Steps ((fmap . contramap) f xs)+  contramap f (Steps xs) = Steps ((fmap . contramap) f xs)  -- TODO: consider what Divisible/Decidable should be.  Maybe no need to -- rush into this.  -- | @since 0.3.0.0 instance Invariant f => Invariant (Steps f) where-    invmap f g (Steps xs) = Steps (fmap (invmap f g) xs)-+  invmap f g (Steps xs) = Steps (fmap (invmap f g) xs)  -- | Left-biased untion instance Functor f => Alt (Steps f) where-    Steps xs <!> Steps ys = Steps $ NEM.union xs ys+  Steps xs <!> Steps ys = Steps $ NEM.union xs ys  instance Pointed f => Pointed (Steps f) where-    point = Steps . NEM.singleton 0 . point+  point = Steps . NEM.singleton 0 . point  -- | "Uncons and cons" an @f@ branch before a 'Steps'.  This is basically -- a witness that 'stepsDown' and 'stepsUp' form an isomorphism.@@ -303,15 +308,16 @@ -- -- Forms an isomorphism with 'stepsUp' (see 'steppings'). stepsDown :: Steps f ~> These1 f (Steps f)-stepsDown = these This1 That1 These1-          . bimap getFirst Steps-          . NEM.foldMapWithKey decr-          . getSteps+stepsDown =+  these This1 That1 These1+    . bimap getFirst Steps+    . NEM.foldMapWithKey decr+    . getSteps  decr :: Natural -> f a -> These (First (f a)) (NEMap Natural (f a)) decr i x = case minusNaturalMaybe i 1 of-      Nothing -> This $ First x-      Just i' -> That $ NEM.singleton i' x+  Nothing -> This $ First x+  Just i' -> That $ NEM.singleton i' x  -- | Unshift an item into a 'Steps'.  Because a @'Steps' f@ is @f `These1` -- f `These1` f `These1` f `These1` ...@ forever, this basically conses an@@ -341,16 +347,19 @@ -- Forms an isomorphism with 'stepDown' (see 'stepping'). stepsUp :: These1 f (Steps f) ~> Steps f stepsUp = \case-    This1  x    -> Steps $ NEM.singleton 0 x-    That1    xs -> Steps . NEM.mapKeysMonotonic (+ 1)-                         . getSteps-                         $ xs-    These1 x xs -> Steps . NEM.insertMapMin 0 x-                         . NEM.toMap-                         . NEM.mapKeysMonotonic (+ 1)-                         . getSteps-                         $ xs-+  This1 x -> Steps $ NEM.singleton 0 x+  That1 xs ->+    Steps+      . NEM.mapKeysMonotonic (+ 1)+      . getSteps+      $ xs+  These1 x xs ->+    Steps+      . NEM.insertMapMin 0 x+      . NEM.toMap+      . NEM.mapKeysMonotonic (+ 1)+      . getSteps+      $ xs  -- | An @f a@, along with a 'Bool' flag --@@ -377,7 +386,7 @@ -- -- *   @'Data.HFunctor.HLift' 'Control.Monad.Trans.Identity.IdentityT'@ -- *   @'Control.COmonad.Trans.Env.EnvT' 'Data.Semigroup.Any'@-data Flagged f a = Flagged { flaggedFlag :: Bool, flaggedVal :: f a }+data Flagged f a = Flagged {flaggedFlag :: Bool, flaggedVal :: f a}   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable, Typeable, Generic, Data)  deriveShow1 ''Flagged@@ -387,25 +396,21 @@  -- | Uses 'False' for 'pure', and '||' for '<*>'. instance Applicative f => Applicative (Flagged f) where-    pure = Flagged False . pure-    Flagged n f <*> Flagged m x = Flagged (n || m) (f <*> x)+  pure = Flagged False . pure+  Flagged n f <*> Flagged m x = Flagged (n || m) (f <*> x)  -- | Uses 'False' for 'point'. instance Pointed f => Pointed (Flagged f) where-    point = Flagged False . point+  point = Flagged False . point  instance Foldable1 f => Foldable1 (Flagged f) where-    fold1      = fold1 . flaggedVal-    foldMap1 f = foldMap1 f . flaggedVal-    toNonEmpty = toNonEmpty . flaggedVal+  fold1 = fold1 . flaggedVal+  foldMap1 f = foldMap1 f . flaggedVal+  toNonEmpty = toNonEmpty . flaggedVal  instance Traversable1 f => Traversable1 (Flagged f) where-    traverse1 f (Flagged n x) = Flagged n <$> traverse1 f x-    sequence1 (Flagged n x) = Flagged n <$> sequence1 x----+  traverse1 f (Flagged n x) = Flagged n <$> traverse1 f x+  sequence1 (Flagged n x) = Flagged n <$> sequence1 x  -- | @'Void2' a b@ is uninhabited for all @a@ and @b@. data Void2 a b@@ -417,23 +422,24 @@ deriveOrd1 ''Void2  instance Semigroup (Void2 a b) where-    x <> _ = case x of {}+  x <> _ = case x of {}  instance Alt (Void2 a) where-    x <!> _ = absurd2 x+  x <!> _ = absurd2 x  instance Bind (Void2 a) where-    x >>- _ = case x of {}+  x >>- _ = case x of {}  instance Apply (Void2 a) where-    x <.> _ = case x of {}+  x <.> _ = case x of {}  -- | @since 0.3.0.0 instance Contravariant (Void2 a) where-    contramap _ = \case {}+  contramap _ = \case {}+ -- | @since 0.3.0.0 instance Invariant (Void2 a) where-    invmap _ _ = \case {}+  invmap _ _ = \case {}  -- | If you treat a @'Void2' f a@ as a functor combinator, then 'absurd2' -- lets you convert from a @'Void2' f a@ into a @t f a@ for any functor@@ -451,23 +457,24 @@ deriveOrd1 ''Void3  instance Semigroup (Void3 a b c) where-    x <> _ = case x of {}+  x <> _ = case x of {}  instance Alt (Void3 a b) where-    x <!> _ = absurd3 x+  x <!> _ = absurd3 x  instance Bind (Void3 a b) where-    x >>- _ = case x of {}+  x >>- _ = case x of {}  instance Apply (Void3 a b) where-    x <.> _ = case x of {}+  x <.> _ = case x of {}  -- | @since 0.3.0.0 instance Contravariant (Void3 a b) where-    contramap _ = \case {}+  contramap _ = \case {}+ -- | @since 0.3.0.0 instance Invariant (Void3 a b) where-    invmap _ _ = \case {}+  invmap _ _ = \case {}  -- | If you treat a @'Void3' f a@ as a binary functor combinator, then -- 'absurd3' lets you convert from a @'Void3' f a@ into a @t f a@ for any

@@ -1,6 +1,6 @@ -- | -- Module      : Control.Monad.Freer.Church--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -17,40 +17,61 @@ -- 'Data.Functor.Tensor.HBifunctor' and the related typeclasses. module Control.Monad.Freer.Church (   -- * 'Free'-    Free(..), reFree+  Free (..),+  reFree,+   -- ** Interpretation-  , liftFree, interpretFree, retractFree, hoistFree+  liftFree,+  interpretFree,+  retractFree,+  hoistFree,+   -- ** Folding-  , foldFree, foldFree', foldFreeC+  foldFree,+  foldFree',+  foldFreeC,+   -- * 'Free1'-  , Free1(.., DoneF1, MoreF1)-  , reFree1, toFree+  Free1 (.., DoneF1, MoreF1),+  reFree1,+  toFree,+   -- ** Interpretation-  , liftFree1, interpretFree1, retractFree1, hoistFree1+  liftFree1,+  interpretFree1,+  retractFree1,+  hoistFree1,+   -- ** Conversion-  , free1Comp, matchFree1+  free1Comp,+  matchFree1,+   -- ** Folding-  , foldFree1, foldFree1', foldFree1C+  foldFree1,+  foldFree1',+  foldFree1C,+   -- * 'Comp'-  , Comp(.., Comp, unComp), comp-  ) where+  Comp (.., Comp, unComp),+  comp,+) where -import           Control.Applicative-import           Control.Monad-import           Control.Natural-import           Data.Foldable-import           Data.Functor-import           Data.Functor.Bind-import           Data.Functor.Classes-import           Data.Functor.Coyoneda-import           Data.Functor.Invariant-import           Data.Functor.Plus-import           Data.Pointed-import           Data.Semigroup.Foldable-import           Data.Semigroup.Traversable-import           GHC.Generics-import           Text.Read-import qualified Control.Monad.Free         as M+import Control.Applicative+import Control.Monad+import qualified Control.Monad.Free as M+import Control.Natural+import Data.Foldable+import Data.Functor+import Data.Functor.Bind+import Data.Functor.Classes+import Data.Functor.Coyoneda+import Data.Functor.Invariant+import Data.Functor.Plus+import Data.Pointed+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import GHC.Generics+import Text.Read  -- | A @'Free' f@ is @f@ enhanced with "sequential binding" capabilities. -- It allows you to sequence multiple @f@s one after the other, and also to@@ -86,84 +107,87 @@ -- a way that is compatible with 'Data.Functor.HFunctor.HFunctor' and -- 'Data.Functor.HFunctor.Interpret'. newtype Free f a = Free-    { runFree :: forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r-    }+  { runFree :: forall r. (a -> r) -> (forall s. f s -> (s -> r) -> r) -> r+  }  instance Functor (Free f) where-    fmap f x = Free $ \p b -> runFree x (p . f) b+  fmap f x = Free $ \p b -> runFree x (p . f) b  -- | @since 0.4.1.2 instance Invariant (Free f) where-    invmap f _ = fmap f+  invmap f _ = fmap f  instance Apply (Free f) where-    (<.>) = ap+  (<.>) = ap  instance Applicative (Free f) where-    pure x = Free $ \p _ -> p x-    (<*>) = (<.>)+  pure x = Free $ \p _ -> p x+  (<*>) = (<.>)  instance Pointed (Free f) where-    point = pure+  point = pure  instance Bind (Free f) where-    x >>- f  = Free $ \p b -> runFree x (\y -> runFree (f y) p b) b+  x >>- f = Free $ \p b -> runFree x (\y -> runFree (f y) p b) b  instance Monad (Free f) where-    (>>=)    = (>>-)+  (>>=) = (>>-)  instance M.MonadFree f (Free f) where-    wrap x = Free $ \p b -> b x $ \y -> runFree y p b+  wrap x = Free $ \p b -> b x $ \y -> runFree y p b  instance Foldable f => Foldable (Free f) where-    foldMap f = foldFreeC f fold+  foldMap f = foldFreeC f fold  instance Traversable f => Traversable (Free f) where-    traverse f = foldFree (fmap pure   . f        )-                          (fmap M.wrap . sequenceA)+  traverse f =+    foldFree+      (fmap pure . f)+      (fmap M.wrap . sequenceA)  instance (Functor f, Eq1 f) => Eq1 (Free f) where-    liftEq eq x y = liftEq @(M.Free f) eq (reFree x) (reFree y)+  liftEq eq x y = liftEq @(M.Free f) eq (reFree x) (reFree y)  instance (Functor f, Ord1 f) => Ord1 (Free f) where-    liftCompare c x y = liftCompare @(M.Free f) c (reFree x) (reFree y)+  liftCompare c x y = liftCompare @(M.Free f) c (reFree x) (reFree y)  instance (Functor f, Eq1 f, Eq a) => Eq (Free f a) where-    (==) = eq1+  (==) = eq1  instance (Functor f, Ord1 f, Ord a) => Ord (Free f a) where-    compare = compare1+  compare = compare1  instance (Functor f, Show1 f) => Show1 (Free f) where-    liftShowsPrec sp sl d x = case reFree x of-        M.Pure y  -> showsUnaryWith sp "pure" d y-        M.Free ys -> showsUnaryWith (liftShowsPrec sp' sl') "wrap" d ys-      where-        sp' = liftShowsPrec sp sl-        sl' = liftShowList sp sl+  liftShowsPrec sp sl d x = case reFree x of+    M.Pure y -> showsUnaryWith sp "pure" d y+    M.Free ys -> showsUnaryWith (liftShowsPrec sp' sl') "wrap" d ys+    where+      sp' = liftShowsPrec sp sl+      sl' = liftShowList sp sl  -- | Show in terms of 'pure' and 'M.wrap'. instance (Functor f, Show1 f, Show a) => Show (Free f a) where-    showsPrec = liftShowsPrec showsPrec showList+  showsPrec = liftShowsPrec showsPrec showList  instance (Functor f, Read1 f) => Read1 (Free f) where-    liftReadsPrec rp rl = go-      where-        go = readsData $-            readsUnaryWith rp "pure" pure-         <> readsUnaryWith (liftReadsPrec go (liftReadList rp rl)) "wrap" M.wrap+  liftReadsPrec rp rl = go+    where+      go =+        readsData $+          readsUnaryWith rp "pure" pure+            <> readsUnaryWith (liftReadsPrec go (liftReadList rp rl)) "wrap" M.wrap  -- | Read in terms of 'pure' and 'M.wrap'. instance (Functor f, Read1 f, Read a) => Read (Free f a) where-    readPrec = readPrec1-    readListPrec = readListPrecDefault-    readList = readListDefault+  readPrec = readPrec1+  readListPrec = readListPrecDefault+  readList = readListDefault  -- | Convert a @'Free' f@ into any instance of @'M.MonadFree' f@.-reFree-    :: (M.MonadFree f m, Functor f)-    => Free f a-    -> m a+reFree ::+  (M.MonadFree f m, Functor f) =>+  Free f a ->+  m a reFree = foldFree pure M.wrap  -- | Lift an @f@ into @'Free' f@, so you can use it as a 'Monad'.@@ -193,20 +217,22 @@  -- | A version of 'foldFree' that doesn't require @'Functor' f@, by taking -- a RankN folding function.  This is essentially a flipped 'runFree'.-foldFree'-    :: (a -> r)-    -> (forall s. f s -> (s -> r) -> r)-    -> Free f a-    -> r+foldFree' ::+  (a -> r) ->+  (forall s. f s -> (s -> r) -> r) ->+  Free f a ->+  r foldFree' f g x = runFree x f g  -- | A version of 'foldFree' that doesn't require @'Functor' f@, by folding -- over a 'Coyoneda' instead.-foldFreeC-    :: (a -> r)                 -- ^ handle 'pure'-    -> (Coyoneda f r -> r)      -- ^ handle 'M.wrap'-    -> Free f a-    -> r+foldFreeC ::+  -- | handle 'pure'+  (a -> r) ->+  -- | handle 'M.wrap'+  (Coyoneda f r -> r) ->+  Free f a ->+  r foldFreeC f g = foldFree' f (\y n -> g (Coyoneda n y))  -- | Recursively fold down a 'Free' by handling the 'pure' case and the@@ -216,12 +242,14 @@ -- -- This requires @'Functor' f@; see 'foldFree'' and 'foldFreeC' for -- a version that doesn't require @'Functor' f@.-foldFree-    :: Functor f-    => (a -> r)                 -- ^ handle 'pure'-    -> (f r -> r)               -- ^ handle 'M.wrap'-    -> Free f a-    -> r+foldFree ::+  Functor f =>+  -- | handle 'pure'+  (a -> r) ->+  -- | handle 'M.wrap'+  (f r -> r) ->+  Free f a ->+  r foldFree f g = foldFreeC f (g . lowerCoyoneda)  -- | The Free 'Bind'.  Imbues any functor @f@ with a 'Bind' instance.@@ -235,75 +263,82 @@ -- Sometimes we want an @f :.: f@, or an @f :.: f :.: f@, or an @f :.: -- f :.: f :.: f@...just as long as we have at least one @f@. newtype Free1 f a = Free1-    { runFree1 :: forall r. (forall s. f s -> (s -> a) -> r)-                         -> (forall s. f s -> (s -> r) -> r)-                         -> r-    }+  { runFree1 ::+      forall r.+      (forall s. f s -> (s -> a) -> r) ->+      (forall s. f s -> (s -> r) -> r) ->+      r+  }  instance Functor (Free1 f) where-    fmap f x = Free1 $ \p b -> runFree1 x (\y c -> p y (f . c)) b+  fmap f x = Free1 $ \p b -> runFree1 x (\y c -> p y (f . c)) b  -- | @since 0.4.1.2 instance Invariant (Free1 f) where-    invmap f _ = fmap f+  invmap f _ = fmap f  instance Apply (Free1 f) where-    (<.>) = apDefault+  (<.>) = apDefault  instance Bind (Free1 f) where-    x >>- f = Free1 $ \p b ->-        runFree1 x (\y c -> b y ((\q -> runFree1 q p b) . f . c)) b+  x >>- f = Free1 $ \p b ->+    runFree1 x (\y c -> b y ((\q -> runFree1 q p b) . f . c)) b  instance Foldable f => Foldable (Free1 f) where-    foldMap f = foldFree1C (foldMap f) fold+  foldMap f = foldFree1C (foldMap f) fold  instance Traversable f => Traversable (Free1 f) where-    traverse f = foldFree1 (fmap DoneF1 . traverse f)-                           (fmap MoreF1 . sequenceA )+  traverse f =+    foldFree1+      (fmap DoneF1 . traverse f)+      (fmap MoreF1 . sequenceA)  instance Foldable1 f => Foldable1 (Free1 f) where-    foldMap1 f = foldFree1C (foldMap1 f) fold1+  foldMap1 f = foldFree1C (foldMap1 f) fold1  instance Traversable1 f => Traversable1 (Free1 f) where-    traverse1 f = foldFree1 (fmap DoneF1 . traverse1 f)-                            (fmap MoreF1 . sequence1  )+  traverse1 f =+    foldFree1+      (fmap DoneF1 . traverse1 f)+      (fmap MoreF1 . sequence1)  instance (Functor f, Eq1 f) => Eq1 (Free1 f) where-    liftEq eq x y = liftEq @(Free f) eq (toFree x) (toFree y)+  liftEq eq x y = liftEq @(Free f) eq (toFree x) (toFree y)  instance (Functor f, Ord1 f) => Ord1 (Free1 f) where-    liftCompare c x y = liftCompare @(Free f) c (toFree x) (toFree y)+  liftCompare c x y = liftCompare @(Free f) c (toFree x) (toFree y)  instance (Functor f, Eq1 f, Eq a) => Eq (Free1 f a) where-    (==) = eq1+  (==) = eq1  instance (Functor f, Ord1 f, Ord a) => Ord (Free1 f a) where-    compare = compare1+  compare = compare1  instance (Functor f, Show1 f) => Show1 (Free1 f) where-    liftShowsPrec sp sl d = \case-        DoneF1 x -> showsUnaryWith (liftShowsPrec sp  sl ) "DoneF1" d x-        MoreF1 x -> showsUnaryWith (liftShowsPrec sp' sl') "MoreF1" d x-      where-        sp' = liftShowsPrec sp sl-        sl' = liftShowList sp sl+  liftShowsPrec sp sl d = \case+    DoneF1 x -> showsUnaryWith (liftShowsPrec sp sl) "DoneF1" d x+    MoreF1 x -> showsUnaryWith (liftShowsPrec sp' sl') "MoreF1" d x+    where+      sp' = liftShowsPrec sp sl+      sl' = liftShowList sp sl  -- | Show in terms of 'DoneF1' and 'MoreF1'. instance (Functor f, Show1 f, Show a) => Show (Free1 f a) where-    showsPrec = liftShowsPrec showsPrec showList+  showsPrec = liftShowsPrec showsPrec showList  instance (Functor f, Read1 f) => Read1 (Free1 f) where-    liftReadsPrec rp rl = go-      where-        go = readsData $-            readsUnaryWith (liftReadsPrec rp rl) "DoneF1" DoneF1-         <> readsUnaryWith (liftReadsPrec go (liftReadList rp rl)) "MoreF1" MoreF1+  liftReadsPrec rp rl = go+    where+      go =+        readsData $+          readsUnaryWith (liftReadsPrec rp rl) "DoneF1" DoneF1+            <> readsUnaryWith (liftReadsPrec go (liftReadList rp rl)) "MoreF1" MoreF1  -- | Read in terms of 'DoneF1' and 'MoreF1'. instance (Functor f, Read1 f, Read a) => Read (Free1 f a) where-    readPrec = readPrec1-    readListPrec = readListPrecDefault-    readList = readListDefault+  readPrec = readPrec1+  readListPrec = readListPrecDefault+  readList = readListDefault  -- | Constructor matching on the case that a @'Free1' f@ consists of just -- a single un-nested @f@.  Used as a part of the 'Show' and 'Read'@@ -321,13 +356,14 @@ pattern MoreF1 x <- (matchFree1 -> R1 (Comp x))   where     MoreF1 x = liftFree1 x >>- id+ {-# COMPLETE DoneF1, MoreF1 #-}  -- | Convert a @'Free1' f@ into any instance of @'M.MonadFree' f@.-reFree1-    :: (M.MonadFree f m, Functor f)-    => Free1 f a-    -> m a+reFree1 ::+  (M.MonadFree f m, Functor f) =>+  Free1 f a ->+  m a reFree1 = foldFree1 (M.wrap . fmap pure) M.wrap  -- | @'Free1' f@ is a special subset of @'Free' f@ that consists of at least one@@ -347,8 +383,8 @@ -- format. free1Comp :: Free1 f ~> Comp f (Free f) free1Comp = foldFree1' (\y c -> y :>>= (pure . c)) $ \y n ->-    y :>>= \z -> case n z of-      q :>>= m -> liftFree q >>= m+  y :>>= \z -> case n z of+    q :>>= m -> liftFree q >>= m  -- | Inject an @f@ into a @'Free1' f@ liftFree1 :: f ~> Free1 f@@ -365,8 +401,10 @@ -- always have at least one @g@, so we do not need a full 'Monad' -- constraint. interpretFree1 :: Bind g => (f ~> g) -> Free1 f ~> g-interpretFree1 f = foldFree1' (\y c -> c <$> f y)-                              (\y n -> f y >>- n)+interpretFree1 f =+  foldFree1'+    (\y c -> c <$> f y)+    (\y n -> f y >>- n)  -- | A @'Free1' f@ is either a single un-nested @f@, or a @f@ nested with -- another @'Free1' f@.  This decides which is the case.@@ -374,27 +412,29 @@ matchFree1 = foldFree1 L1 (R1 . Comp . fmap shuffle)   where     shuffle :: f :+: Comp f (Free1 f) ~> Free1 f-    shuffle (L1 y         ) = liftFree1 y+    shuffle (L1 y) = liftFree1 y     shuffle (R1 (y :>>= n)) = liftFree1 y >>- n  -- | A version of 'foldFree1' that doesn't require @'Functor' f@, by taking -- a RankN folding function.  This is essentially a flipped 'runFree'.-foldFree1'-    :: (forall s. f s -> (s -> a) -> r)-    -> (forall s. f s -> (s -> r) -> r)-    -> Free1 f a-    -> r+foldFree1' ::+  (forall s. f s -> (s -> a) -> r) ->+  (forall s. f s -> (s -> r) -> r) ->+  Free1 f a ->+  r foldFree1' f g x = runFree1 x f g  -- | A version of 'foldFree1' that doesn't require @'Functor' f@, by -- folding over a 'Coyoneda' instead.-foldFree1C-    :: (Coyoneda f a -> r)-    -> (Coyoneda f r -> r)-    -> Free1 f a-    -> r-foldFree1C f g = foldFree1' (\y c -> f (Coyoneda c y))-                            (\y n -> g (Coyoneda n y))+foldFree1C ::+  (Coyoneda f a -> r) ->+  (Coyoneda f r -> r) ->+  Free1 f a ->+  r+foldFree1C f g =+  foldFree1'+    (\y c -> f (Coyoneda c y))+    (\y n -> g (Coyoneda n y))  -- | Recursively fold down a 'Free1' by handling the single @f@ case and -- the nested/wrapped case.@@ -403,14 +443,18 @@ -- -- This requires @'Functor' f@; see 'foldFree'' and 'foldFreeC' for -- a version that doesn't require @'Functor' f@.-foldFree1-    :: Functor f-    => (f a -> r)       -- ^ handle @'DoneF1'@.-    -> (f r -> r)       -- ^ handle @'MoreF1'@.-    -> Free1 f a-    -> r-foldFree1 f g = foldFree1C (f . lowerCoyoneda)-                           (g . lowerCoyoneda)+foldFree1 ::+  Functor f =>+  -- | handle @'DoneF1'@.+  (f a -> r) ->+  -- | handle @'MoreF1'@.+  (f r -> r) ->+  Free1 f a ->+  r+foldFree1 f g =+  foldFree1C+    (f . lowerCoyoneda)+    (g . lowerCoyoneda)  -- | Functor composition.  @'Comp' f g a@ is equivalent to @f (g a)@, and -- the 'Comp' pattern synonym is a way of getting the @f (g a)@ in@@ -432,84 +476,88 @@ -- -- The "free monoid" over 'Comp' is 'Free', and the "free semigroup" over -- 'Comp' is 'Free1'.-data Comp f g a =-    forall x. f x :>>= (x -> g a)+data Comp f g a+  = forall x. f x :>>= (x -> g a)  instance Functor g => Functor (Comp f g) where-    fmap f (x :>>= h) = x :>>= (fmap f . h)+  fmap f (x :>>= h) = x :>>= (fmap f . h)  -- | @since 0.4.1.2 instance Invariant g => Invariant (Comp f g) where-    invmap f g (x :>>= h) = x :>>= (invmap f g . h)+  invmap f g (x :>>= h) = x :>>= (invmap f g . 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'))+  (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)-                           :>>= (\(x', y') -> f x' <*> g y')-    liftA2 h (x :>>= f) (y :>>= g)-            = ((,) <$> x <*> y)-         :>>= (\(x', y') -> liftA2 h (f x') (g y'))+  pure x = pure () :>>= (pure . const x)+  (x :>>= f) <*> (y :>>= g) =+    ((,) <$> x <*> y)+      :>>= (\(x', y') -> f x' <*> g y')+  liftA2 h (x :>>= f) (y :>>= g) =+    ((,) <$> x <*> y)+      :>>= (\(x', y') -> liftA2 h (f x') (g y'))  instance (Foldable f, Foldable g) => Foldable (Comp f g) where-    foldMap f (x :>>= h) = foldMap (foldMap f . h) x+  foldMap f (x :>>= h) = foldMap (foldMap f . h) x  instance (Traversable f, Traversable g) => Traversable (Comp f g) where-    traverse f (x :>>= h) = (:>>= id)-                        <$> traverse (traverse f . h) x+  traverse f (x :>>= h) =+    (:>>= id)+      <$> traverse (traverse f . h) x  instance (Alternative f, Alternative g) => Alternative (Comp f g) where-    empty = empty :>>= id-    (x :>>= f) <|> (y :>>= g) = ((f <$> x) <|> (g <$> y)) :>>= id+  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+  (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+  zero = zero :>>= id  instance (Functor f, Show1 f, Show1 g) => Show1 (Comp f g) where-    liftShowsPrec sp sl d (Comp x) =-        showsUnaryWith (liftShowsPrec sp' sl') "Comp" d x-      where-        sp' = liftShowsPrec sp sl-        sl' = liftShowList sp sl+  liftShowsPrec sp sl d (Comp x) =+    showsUnaryWith (liftShowsPrec sp' sl') "Comp" d x+    where+      sp' = liftShowsPrec sp sl+      sl' = liftShowList sp sl  instance (Functor f, Show1 f, Show1 g, Show a) => Show (Comp f g a) where-    showsPrec = liftShowsPrec showsPrec showList+  showsPrec = liftShowsPrec showsPrec showList  instance (Functor f, Read1 f, Read1 g) => Read1 (Comp f g) where-    liftReadPrec rp rl = readData $-        readUnaryWith (liftReadPrec rp' rl') "Comp" Comp-      where-        rp' = liftReadPrec rp rl-        rl' = liftReadListPrec rp rl+  liftReadPrec rp rl =+    readData $+      readUnaryWith (liftReadPrec rp' rl') "Comp" Comp+    where+      rp' = liftReadPrec rp rl+      rl' = liftReadListPrec rp rl  instance (Functor f, Read1 f, Read1 g, Read a) => Read (Comp f g a) where-    readPrec = readPrec1-    readListPrec = readListPrecDefault-    readList = readListDefault+  readPrec = readPrec1+  readListPrec = readListPrecDefault+  readList = readListDefault  instance (Functor f, Eq1 f, Eq1 g) => Eq1 (Comp f g) where-    liftEq eq (Comp x) (Comp y) = liftEq (liftEq eq) x y+  liftEq eq (Comp x) (Comp y) = liftEq (liftEq eq) x y  instance (Functor f, Ord1 f, Ord1 g) => Ord1 (Comp f g) where-    liftCompare c (Comp x) (Comp y) = liftCompare (liftCompare c) x y+  liftCompare c (Comp x) (Comp y) = liftCompare (liftCompare c) x y  instance (Functor f, Eq1 f, Eq1 g, Eq a) => Eq (Comp f g a) where-    (==) = eq1+  (==) = eq1  instance (Functor f, Ord1 f, Ord1 g, Ord a) => Ord (Comp f g a) where-    compare = compare1+  compare = compare1  -- | "Smart constructor" for 'Comp' that doesn't require @'Functor' f@. comp :: f (g a) -> Comp f g a@@ -518,8 +566,8 @@ -- | Pattern match on and construct a @'Comp' f g a@ as if it were @f -- (g a)@. pattern Comp :: Functor f => f (g a) -> Comp f g a-pattern Comp { unComp } <- ((\case x :>>= f -> f <$> x)->unComp)+pattern Comp{unComp} <- (\case x :>>= f -> f <$> x -> unComp)   where     Comp x = comp x-{-# COMPLETE Comp #-} +{-# COMPLETE Comp #-}

@@ -1,6 +1,6 @@ -- | -- Module      : Control.Natural.IsoF--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -10,19 +10,21 @@ -- Types describing isomorphisms between two functors, and functions to -- manipulate them. module Control.Natural.IsoF (-    type (~>)-  , type (<~>)-  , isoF-  , coercedF-  , viewF, reviewF, overF-  , fromF-  ) where+  type (~>),+  type (<~>),+  isoF,+  coercedF,+  viewF,+  reviewF,+  overF,+  fromF,+) where -import           Control.Natural-import           Data.Coerce-import           Data.Kind-import           Data.Profunctor-import           Data.Tagged+import Control.Natural+import Data.Coerce+import Data.Kind+import Data.Profunctor+import Data.Tagged  -- | The type of an isomorphism between two functors.  @f '<~>' g@ means that -- @f@ and @g@ are isomorphic to each other.@@ -61,20 +63,22 @@ -- 'Data.HBifunctor.Tensor.splittingSF' :: 'Data.HBifunctor.Tensor.Monoidal' t => 'Data.HBifunctor.Associative.SF' t a '<~>' t f ('Data.HBifunctor.Tensor.MF' t f) -- 'Data.HBifunctor.Tensor.splitSF'     :: Monoidal t => SF t a  '~>' t f (MF t f) -- @-type f <~> g  = forall p a. Profunctor p => p (g a) (g a) -> p (f a) (f a)+type f <~> g = forall p a. Profunctor p => p (g a) (g a) -> p (f a) (f a)+ infixr 0 <~>  -- | Create an @f '<~>' g@ by providing both legs of the isomorphism (the -- @f a -> g a@ and the @g a -> f a@.-isoF-    :: f ~> g-    -> g ~> f-    -> f <~> g+isoF ::+  f ~> g ->+  g ~> f ->+  f <~> g isoF f g a = dimap f g a  -- | An isomorphism between two functors that are coercible/have the same -- internal representation.  Useful for newtype wrappers.-coercedF :: forall f g. (forall x. Coercible (f x) (g x), forall x. Coercible (g x) (f x)) => f <~> g+coercedF ::+  forall f g. (forall x. Coercible (f x) (g x), forall x. Coercible (g x) (f x)) => f <~> g coercedF = isoF coerce coerce  -- | Use a '<~>' by retrieving the "forward" function:@@ -106,8 +110,9 @@ -- 'viewF'   ('fromF' i) == 'reviewF' i -- 'reviewF' ('fromF' i) == 'viewF' i -- @-fromF-    :: forall (f :: Type -> Type) (g :: Type -> Type). ()-    => f <~> g-    -> g <~> f+fromF ::+  forall (f :: Type -> Type) (g :: Type -> Type).+  () =>+  f <~> g ->+  g <~> f fromF i = isoF (reviewF i) (viewF i)

@@ -1,6 +1,6 @@ -- | -- Module      : Data.Functor.Apply.Free--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -13,25 +13,26 @@ -- Ideally 'Ap1' would be in the /free/ package.  However, it is defined -- here for now. module Data.Functor.Apply.Free (-    Ap1(.., DayAp1, ap1Day)-  , toAp, fromAp-  , liftAp1-  , retractAp1-  , runAp1-  ) where+  Ap1 (.., DayAp1, ap1Day),+  toAp,+  fromAp,+  liftAp1,+  retractAp1,+  runAp1,+) where -import           Control.Applicative.Free-import           Control.Natural-import           Data.Function-import           Data.Functor.Apply-import           Data.Functor.Day-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+import Control.Applicative.Free+import Control.Natural+import Data.Function+import Data.Functor.Apply+import Data.Functor.Day+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  -- | One or more @f@s convolved with itself. --@@ -57,7 +58,7 @@ -- The construction here is based on 'Ap', similar to now -- 'Data.List.NonEmpty.NonEmpty' is built on list. data Ap1 :: (Type -> Type) -> Type -> Type where-    Ap1 :: f a -> Ap f (a -> b) -> Ap1 f b+  Ap1 :: f a -> Ap f (a -> b) -> Ap1 f b  -- | An 'Ap1' is a "non-empty" 'Ap'; this function "forgets" the non-empty -- property and turns it back into a normal 'Ap'.@@ -68,25 +69,26 @@ -- return the 'Pure' value instead. fromAp :: Ap f ~> (Identity :+: Ap1 f) fromAp = \case-    Pure x  -> L1 $ Identity x-    Ap x xs -> R1 $ Ap1 x xs+  Pure x -> L1 $ Identity x+  Ap x xs -> R1 $ Ap1 x xs  -- | @since 0.3.0.0 instance Invariant (Ap1 f) where-    invmap f _ = fmap f+  invmap f _ = fmap f  -- | An @'Ap1' f@ is just a @'Day' f ('Ap' f)@.  This bidirectional pattern -- synonym lets you treat it as such. pattern DayAp1 :: Day f (Ap f) a -> Ap1 f a-pattern DayAp1 { ap1Day } <- ((\case Ap1 x y -> Day x y (&)) -> ap1Day)+pattern DayAp1{ap1Day} <- (\case Ap1 x y -> Day x y (&) -> ap1Day)   where     DayAp1 (Day x y f) = Ap1 x (flip f <$> y)+ {-# COMPLETE DayAp1 #-}  deriving instance Functor (Ap1 f)  instance Apply (Ap1 f) where-    Ap1 x xs <.> ys = Ap1 x (flip <$> xs <*> toAp ys)+  Ap1 x xs <.> ys = Ap1 x (flip <$> xs <*> toAp ys)  -- | Embed an @f@ into 'Ap1'. liftAp1 :: f ~> Ap1 f@@ -101,60 +103,60 @@ retractAp1 (Ap1 x xs) = retractAp1_ x xs  -- | Interpret an @'Ap' f@ into some 'Apply' context @g@.-runAp1-    :: Apply g-    => (f ~> g)-    -> Ap1 f ~> g+runAp1 ::+  Apply g =>+  (f ~> g) ->+  Ap1 f ~> g runAp1 f (Ap1 x xs) = runAp1_ f x xs  instance HFunctor Ap1 where-    hmap f (Ap1 x xs) = Ap1 (f x) (hmap f xs)+  hmap f (Ap1 x xs) = Ap1 (f x) (hmap f xs)  instance Inject Ap1 where-    inject = liftAp1+  inject = liftAp1  instance HBind Ap1 where-    hbind = runAp1+  hbind = runAp1  instance HTraversable Ap1 where-    htraverse f (Ap1 x xs) = Ap1 <$> f x <*> htraverse f xs+  htraverse f (Ap1 x xs) = Ap1 <$> f x <*> htraverse f xs  instance HTraversable1 Ap1 where-    htraverse1 f (Ap1 x xs) = traverseAp1_ f x xs+  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_ ::+  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+      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-    interpret = runAp1+  retract = retractAp1+  interpret = runAp1  retractAp1_ :: Apply f => f a -> Ap f (a -> b) -> f b retractAp1_ x = \case-    Pure y  ->   y <$> x-    Ap y ys -> (&) <$> x <.> retractAp1_ y ys+  Pure y -> y <$> x+  Ap y ys -> (&) <$> x <.> retractAp1_ y ys -runAp1_-    :: forall f g a b. Apply g-    => (f ~> g)-    -> f a-    -> Ap f (a -> b)-    -> g b+runAp1_ ::+  forall f g a b.+  Apply g =>+  (f ~> g) ->+  f a ->+  Ap f (a -> b) ->+  g b runAp1_ f = go   where     go :: f x -> Ap f (x -> y) -> g y     go x = \case-      Pure y  ->   y <$> f x+      Pure y -> y <$> f x       Ap y ys -> (&) <$> f x <.> go y ys-

@@ -1,6 +1,6 @@ -- | -- Module      : Data.Functor.Combinator--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -30,128 +30,163 @@ -- combinator. module Data.Functor.Combinator (   -- * Classes+   -- | A lot of type signatures are stated in terms of '~>'.  '~>'   -- represents a "natural transformation" between two functors: a value of   -- type @f '~>' g@ is a value of type 'f a -> g a@ that works for /any/   -- @a@.-    type (~>)-  , type (<~>)+  type (~>),+  type (<~>),+   -- ** Single Functors+   -- | Classes that deal with single-functor combinators, that enhance   -- a single functor.-  , HFunctor(..)-  , Inject(..)-  , Interpret(..)-  , forI-  , iget, icollect, icollect1-  , iapply, ifanout, ifanout1-  , getI, collectI-  , injectMap, injectContramap-  , AltConst(..)+  HFunctor (..),+  Inject (..),+  Interpret (..),+  forI,+  iget,+  icollect,+  icollect1,+  iapply,+  ifanout,+  ifanout1,+  getI,+  collectI,+  injectMap,+  injectContramap,+  AltConst (..),+   -- ** 'HTraversable'-  , HTraversable(..), hsequence, hfoldMap, htoList-  , HTraversable1(..), hsequence1, hfoldMap1, htoNonEmpty+  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.-  , HBifunctor(..)+  HBifunctor (..),+   -- *** Associative-  , Associative(..)-  , SemigroupIn(..)-  , biget, biapply+  Associative (..),+  SemigroupIn (..),+  biget,+  biapply,   -- , biget, bicollect, bicollect1-  , (!*!)-  , (!+!)-  , (!$!)+  (!*!),+  (!+!),+  (!$!),+   -- *** Tensor-  , Tensor(..)-  , MonoidIn(..)-  , nilLB, consLB-  , inL, inR-  , outL, outR+  Tensor (..),+  MonoidIn (..),+  nilLB,+  consLB,+  inL,+  inR,+  outL,+  outR,+   -- * Combinators+   -- | Functor combinators   -- ** Single-  , Coyoneda(..)-  , ListF(..)-  , NonEmptyF(..)-  , MaybeF(..)-  , MapF(..)-  , NEMapF(..)-  , Ap-  , Ap1(..)-  , Alt-  , Free-  , Free1-  , Lift-  , Step(..)-  , Steps(..)-  , ProxyF(..)-  , ConstF(..)-  , EnvT(..)-  , ReaderT(..)-  , Flagged(..)-  , IdentityT(..)-  , Void2-  , Final(..)-  , FreeOf(..)-  , ComposeT(..)+  Coyoneda (..),+  ListF (..),+  NonEmptyF (..),+  MaybeF (..),+  MapF (..),+  NEMapF (..),+  Ap,+  Ap1 (..),+  Alt,+  Free,+  Free1,+  Lift,+  Step (..),+  Steps (..),+  ProxyF (..),+  ConstF (..),+  EnvT (..),+  ReaderT (..),+  Flagged (..),+  IdentityT (..),+  Void2,+  Final (..),+  FreeOf (..),+  ComposeT (..),+   -- ** Multi-  , Day(..)-  , (:*:)(..), prodOutL, prodOutR-  , (:+:)(..), V1-  , These1(..)-  , Night(..), Not(..), refuted-  , Comp(Comp, unComp)-  , LeftF(..)-  , RightF(..)+  Day (..),+  (:*:) (..),+  prodOutL,+  prodOutR,+  (:+:) (..),+  V1,+  These1 (..),+  Night (..),+  Not (..),+  refuted,+  Comp (Comp, unComp),+  LeftF (..),+  RightF (..),+   -- ** Combinator Combinators-  , HLift(..)-  , HFree(..)+  HLift (..),+  HFree (..),+   -- * Util+   -- ** Natural Transformations-  , generalize-  , absorb-  -- ** Divisible-  , dsum-  , dsum1-  , concludeN-  , decideN-  ) where+  generalize,+  absorb, -import           Control.Alternative.Free-import           Control.Applicative.Free-import           Control.Applicative.Lift-import           Control.Applicative.ListF-import           Control.Applicative.Step-import           Control.Comonad.Trans.Env-import           Control.Monad.Freer.Church-import           Control.Monad.Trans.Compose-import           Control.Monad.Trans.Identity-import           Control.Monad.Trans.Reader-import           Control.Natural-import           Control.Natural.IsoF-import           Data.Functor.Apply.Free-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Coyoneda-import           Data.Functor.Day-import           Data.Functor.Invariant.Night-import           Data.Functor.These-import           Data.HBifunctor-import           Data.HBifunctor.Associative-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-import qualified Data.SOP                             as SOP+  -- ** Divisible+  dsum,+  dsum1,+  concludeN,+  decideN,+) where +import Control.Alternative.Free+import Control.Applicative.Free+import Control.Applicative.Lift+import Control.Applicative.ListF+import Control.Applicative.Step+import Control.Comonad.Trans.Env+import Control.Monad.Freer.Church+import Control.Monad.Trans.Compose+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Reader+import Control.Natural+import Control.Natural.IsoF+import Data.Functor.Apply.Free+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Coyoneda+import Data.Functor.Day+import Data.Functor.Invariant.Night+import Data.Functor.These+import Data.HBifunctor+import Data.HBifunctor.Associative+import Data.HBifunctor.Tensor+import Data.HFunctor+import Data.HFunctor.Final+import Data.HFunctor.HTraversable+import Data.HFunctor.Internal+import Data.HFunctor.Interpret+import qualified Data.SOP as SOP+import GHC.Generics  -- | Convenient helper function to build up a 'Divisible' by splitting -- input across many different @f a@s.  Most useful when used alongside@@ -166,11 +201,11 @@ -- @ -- -- @since 0.3.3.0-dsum-    :: (Foldable t, Divisible f)-    => t (f a)-    -> f a-dsum = foldr (divide (\x -> (x,x))) conquer+dsum ::+  (Foldable t, Divisible f) =>+  t (f a) ->+  f a+dsum = foldr (divide (\x -> (x, x))) conquer  -- | Convenient helper function to build up a 'Conclude' by providing -- each component of it.  This makes it much easier to build up longer@@ -204,14 +239,15 @@ --      otherwise you'd need to manually peel off eithers one-by-one. -- -- @since 0.3.0.0-concludeN-    :: Conclude f-    => SOP.NP f as-    -> f (SOP.NS SOP.I as)+concludeN ::+  Conclude f =>+  SOP.NP f as ->+  f (SOP.NS SOP.I as) concludeN = \case-    SOP.Nil     -> conclude (\case {})-    x SOP.:* xs -> decide-      (\case SOP.Z y  -> Left (SOP.unI y); SOP.S ys -> Right ys)+  SOP.Nil -> conclude (\case {})+  x SOP.:* xs ->+    decide+      (\case SOP.Z y -> Left (SOP.unI y); SOP.S ys -> Right ys)       x       (concludeN xs) @@ -219,14 +255,15 @@ -- and so only requires a 'Decide' constraint. -- -- @since 0.3.0.0-decideN-    :: Decide f-    => SOP.NP f (a ': as)-    -> f (SOP.NS SOP.I (a ': as))+decideN ::+  Decide f =>+  SOP.NP f (a ': as) ->+  f (SOP.NS SOP.I (a ': as)) decideN = \case-    x SOP.:* xs -> case xs of-      SOP.Nil    -> contramap (SOP.unI . SOP.unZ) x-      _ SOP.:* _ -> decide+  x SOP.:* xs -> case xs of+    SOP.Nil -> contramap (SOP.unI . SOP.unZ) x+    _ SOP.:* _ ->+      decide         (\case SOP.Z z -> Left (SOP.unI z); SOP.S zs -> Right zs)         x         (decideN xs)

@@ -1,6 +1,6 @@ -- | -- Module      : Data.Functor.Combinator.Unsafe--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -20,32 +20,32 @@ -- coherence.  Because of this, you should always use these with /specific/ -- @f@s, and never in a polymorphic way over @f@. module Data.Functor.Combinator.Unsafe (-    unsafePlus-  , unsafeApply-  , unsafeBind-  , unsafePointed-  , unsafeConclude-  , unsafeDivise-  , unsafeInvariantCo-  , unsafeInvariantContra-  , unsafeInplyCo-  , unsafeInplyContra-  , unsafeInplicativeCo-  , unsafeInplicativeContra-  ) where+  unsafePlus,+  unsafeApply,+  unsafeBind,+  unsafePointed,+  unsafeConclude,+  unsafeDivise,+  unsafeInvariantCo,+  unsafeInvariantContra,+  unsafeInplyCo,+  unsafeInplyContra,+  unsafeInplicativeCo,+  unsafeInplicativeContra,+) where -import           Control.Applicative-import           Data.Constraint-import           Data.Constraint.Unsafe-import           Data.Functor.Bind-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Inplicative-import           Data.Functor.Plus-import           Data.Pointed+import Control.Applicative+import Data.Constraint+import Data.Constraint.Unsafe+import Data.Functor.Bind+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.Invariant.Inplicative+import Data.Functor.Plus+import Data.Pointed  -- | For any @'Alternative' f@, produce a value that would require @'Plus' -- f@.@@ -58,7 +58,7 @@ -- \@MyFunctor@. unsafePlus :: forall f proxy r. Alternative f => proxy f -> (Plus f => r) -> r unsafePlus _ x = case unsafeCoerceConstraint @(Plus (WrappedApplicative f)) @(Plus f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Applicative' f@, produce a value that would require @'Apply' -- f@.@@ -71,7 +71,7 @@ -- \@MyFunctor@. unsafeApply :: forall f proxy r. Applicative f => proxy f -> (Apply f => r) -> r unsafeApply _ x = case unsafeCoerceConstraint @(Apply (WrappedApplicative f)) @(Apply f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Monad' f@, produce a value that would require @'Bind' -- f@.@@ -84,12 +84,12 @@ -- \@MyFunctor@. unsafeBind :: forall f proxy r. Monad f => proxy f -> (Bind f => r) -> r unsafeBind _ x = case unsafeCoerceConstraint @(Bind (WrappedMonad f)) @(Bind f) of-    Sub Dict -> x+  Sub Dict -> x  newtype PointMe f a = PointMe (f a)  instance Applicative f => Pointed (PointMe f) where-    point = PointMe . pure+  point = PointMe . pure  -- | For any @'Applicative' f@, produce a value that would require -- @'Pointed' f@.@@ -102,7 +102,7 @@ -- \@MyFunctor@. unsafePointed :: forall f proxy r. Applicative f => proxy f -> (Pointed f => r) -> r unsafePointed _ x = case unsafeCoerceConstraint @(Pointed (PointMe f)) @(Pointed f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Decidable' f@, produce a value that would require @'Conclude' -- f@.@@ -117,7 +117,7 @@ -- @since 0.3.0.0 unsafeConclude :: forall f proxy r. Decidable f => proxy f -> (Conclude f => r) -> r unsafeConclude _ x = case unsafeCoerceConstraint @(Conclude (WrappedDivisible f)) @(Conclude f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Divisible' f@, produce a value that would require @'Divise' -- f@.@@ -132,7 +132,7 @@ -- @since 0.3.0.0 unsafeDivise :: forall f proxy r. Divisible f => proxy f -> (Divise f => r) -> r unsafeDivise _ x = case unsafeCoerceConstraint @(Divise (WrappedDivisible f)) @(Divise f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Functor' f@, produce a value that would require @'Invariant' -- f@.@@ -147,7 +147,7 @@ -- @since 0.4.1.0 unsafeInvariantCo :: forall f proxy r. Functor f => proxy f -> (Invariant f => r) -> r unsafeInvariantCo _ x = case unsafeCoerceConstraint @(Invariant (WrappedFunctor f)) @(Invariant f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Contravariant' f@, produce a value that would require @'Invariant' -- f@.@@ -162,7 +162,7 @@ -- @since 0.4.1.0 unsafeInvariantContra :: forall f proxy r. Contravariant f => proxy f -> (Invariant f => r) -> r unsafeInvariantContra _ x = case unsafeCoerceConstraint @(Invariant (WrappedContravariant f)) @(Invariant f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Apply' f@, produce a value that would require @'Inply' -- f@.@@ -177,7 +177,7 @@ -- @since 0.4.1.0 unsafeInplyCo :: forall f proxy r. Apply f => proxy f -> (Inply f => r) -> r unsafeInplyCo _ x = case unsafeCoerceConstraint @(Inply (WrappedFunctor f)) @(Inply f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Divise' f@, produce a value that would require @'Inply' -- f@.@@ -192,7 +192,7 @@ -- @since 0.4.1.0 unsafeInplyContra :: forall f proxy r. Divise f => proxy f -> (Inply f => r) -> r unsafeInplyContra _ x = case unsafeCoerceConstraint @(Inply (WrappedContravariant f)) @(Inply f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Applicative' f@, produce a value that would require -- @'Inplicative' f@.@@ -205,9 +205,10 @@ -- \@MyFunctor@. -- -- @since 0.4.1.0-unsafeInplicativeCo :: forall f proxy r. (Applicative f, Invariant f) => proxy f -> (Inplicative f => r) -> r+unsafeInplicativeCo ::+  forall f proxy r. (Applicative f, Invariant f) => proxy f -> (Inplicative f => r) -> r unsafeInplicativeCo _ x = case unsafeCoerceConstraint @(Inply (WrappedApplicativeOnly f)) @(Inplicative f) of-    Sub Dict -> x+  Sub Dict -> x  -- | For any @'Divisibl3' f@, produce a value that would require -- @'Inplicative' f@.@@ -220,7 +221,7 @@ -- \@MyFunctor@. -- -- @since 0.4.1.0-unsafeInplicativeContra :: forall f proxy r. (Divisible f, Invariant f) => proxy f -> (Inplicative f => r) -> r+unsafeInplicativeContra ::+  forall f proxy r. (Divisible f, Invariant f) => proxy f -> (Inplicative f => r) -> r unsafeInplicativeContra _ x = case unsafeCoerceConstraint @(Inply (WrappedDivisibleOnly f)) @(Inplicative f) of-    Sub Dict -> x-+  Sub Dict -> x

@@ -1,10 +1,10 @@-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Data.Functor.Contravariant.Conclude--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -18,9 +18,9 @@ -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Conclude (-    Conclude(..)-  , concluded-  ) where+  Conclude (..),+  concluded,+) where  import Control.Applicative.Backwards import Control.Monad.Trans.Identity@@ -97,8 +97,8 @@ -- 'Decide', it adds a way to construct an "identity" @conclude@ where -- @decide f x (conclude q) == x@, and @decide g (conclude r) y == y@. class Decide f => Conclude f where-    -- | The consumer that cannot ever receive /any/ input.-    conclude :: (a -> Void) -> f a+  -- | The consumer that cannot ever receive /any/ input.+  conclude :: (a -> Void) -> f a  -- | A potentially more meaningful form of 'conclude', the consumer that cannot -- ever receive /any/ input.  That is because it expects only input of type@@ -111,7 +111,7 @@ concluded = conclude id  instance Decidable f => Conclude (WrappedDivisible f) where-    conclude f = WrapDivisible (lose f)+  conclude f = WrapDivisible (lose f)  instance Conclude Comparison where conclude = lose instance Conclude Equivalence where conclude = lose@@ -194,4 +194,3 @@  lazyFst :: (a, b) -> a lazyFst ~(a, _) = a-

@@ -1,10 +1,10 @@-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Data.Functor.Contravariant.Decide--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -18,14 +18,20 @@ -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Decide (-    Decide(..)-  , decided-  ) where+  Decide (..),+  decided,+) where  import Control.Applicative.Backwards import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Reader+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict import Data.Functor.Apply import Data.Functor.Compose import Data.Functor.Contravariant@@ -33,12 +39,6 @@ import Data.Functor.Contravariant.Divisible import Data.Functor.Product import Data.Functor.Reverse-import qualified Control.Monad.Trans.RWS.Lazy      as Lazy-import qualified Control.Monad.Trans.RWS.Strict    as Strict-import qualified Control.Monad.Trans.State.Lazy    as Lazy-import qualified Control.Monad.Trans.State.Strict  as Strict-import qualified Control.Monad.Trans.Writer.Lazy   as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict  #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt(..))@@ -81,9 +81,9 @@ -- That is, it is possible to define a function @(f `EitherDay` f) a -> -- f a@ in a way that is associative. class Contravariant f => Decide f where-    -- | Takes the "decision" method and the two potential consumers, and-    -- returns the wrapped/combined consumer.-    decide :: (a -> Either b c) -> f b -> f c -> f a+  -- | Takes the "decision" method and the two potential consumers, and+  -- returns the wrapped/combined consumer.+  decide :: (a -> Either b c) -> f b -> f c -> f a  -- | For @'decided' x y@, the resulting @f ('Either' b c)@ will direct -- 'Left's to be consumed by @x@, and 'Right's to be consumed by y.@@ -91,7 +91,7 @@ decided = decide id  instance Decidable f => Decide (WrappedDivisible f) where-    decide f (WrapDivisible x) (WrapDivisible y) = WrapDivisible (choose f x y)+  decide f (WrapDivisible x) (WrapDivisible y) = WrapDivisible (choose f x y)  instance Decide Comparison where decide = choose instance Decide Equivalence where decide = choose@@ -135,17 +135,27 @@  instance Decide m => Decide (Lazy.RWST r w s m) where   decide abc (Lazy.RWST rsmb) (Lazy.RWST rsmc) = Lazy.RWST $ \r s ->-    decide (\ ~(a, s', w) -> either (Left  . betuple3 s' w)-                                    (Right . betuple3 s' w)-                                    (abc a))-           (rsmb r s) (rsmc r s)+    decide+      ( \ ~(a, s', w) ->+          either+            (Left . betuple3 s' w)+            (Right . betuple3 s' w)+            (abc a)+      )+      (rsmb r s)+      (rsmc r s)  instance Decide m => Decide (Strict.RWST r w s m) where   decide abc (Strict.RWST rsmb) (Strict.RWST rsmc) = Strict.RWST $ \r s ->-    decide (\(a, s', w) -> either (Left  . betuple3 s' w)-                                  (Right . betuple3 s' w)-                                  (abc a))-           (rsmb r s) (rsmc r s)+    decide+      ( \(a, s', w) ->+          either+            (Left . betuple3 s' w)+            (Right . betuple3 s' w)+            (abc a)+      )+      (rsmb r s)+      (rsmc r s)  #if !MIN_VERSION_transformers(0,6,0) instance Divise m => Decide (ListT m) where@@ -153,29 +163,43 @@ #endif  instance Divise m => Decide (MaybeT m) where-  decide f (MaybeT l) (MaybeT r) = MaybeT $-    divise ( maybe (Nothing, Nothing)-                   (either (\b -> (Just b, Nothing))-                           (\c -> (Nothing, Just c)) . f)-           ) l r+  decide f (MaybeT l) (MaybeT r) =+    MaybeT $+      divise+        ( maybe+            (Nothing, Nothing)+            ( either+                (\b -> (Just b, Nothing))+                (\c -> (Nothing, Just c))+                . f+            )+        )+        l+        r  instance Decide m => Decide (Lazy.StateT s m) where   decide f (Lazy.StateT l) (Lazy.StateT r) = Lazy.StateT $ \s ->-    decide (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a))-           (l s) (r s)+    decide+      (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a))+      (l s)+      (r s)  instance Decide m => Decide (Strict.StateT s m) where   decide f (Strict.StateT l) (Strict.StateT r) = Strict.StateT $ \s ->-    decide (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a))-           (l s) (r s)+    decide+      (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a))+      (l s)+      (r s)  instance Decide m => Decide (Lazy.WriterT w m) where-  decide f (Lazy.WriterT l) (Lazy.WriterT r) = Lazy.WriterT $-    decide (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r+  decide f (Lazy.WriterT l) (Lazy.WriterT r) =+    Lazy.WriterT $+      decide (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r  instance Decide m => Decide (Strict.WriterT w m) where-  decide f (Strict.WriterT l) (Strict.WriterT r) = Strict.WriterT $-    decide (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r+  decide f (Strict.WriterT l) (Strict.WriterT r) =+    Strict.WriterT $+      decide (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r  -- | Unlike 'Decidable', requires only 'Apply' on @f@. instance (Apply f, Decide g) => Decide (Compose f g) where

@@ -1,10 +1,10 @@-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Data.Functor.Contravariant.Divise--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -17,35 +17,35 @@ -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Divise (-    Divise(..)-  , (<:>)-  , dsum1-  , WrappedDivisible(..)-  ) where+  Divise (..),+  (<:>),+  dsum1,+  WrappedDivisible (..),+) where -import           Control.Applicative-import           Control.Applicative.Backwards-import           Control.Arrow-import           Control.Monad.Trans.Except-import           Control.Monad.Trans.Identity-import           Control.Monad.Trans.Maybe-import           Control.Monad.Trans.Reader-import           Data.Deriving-import           Data.Functor.Apply-import           Data.Functor.Compose-import           Data.Functor.Constant-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.Product-import           Data.Functor.Reverse-import qualified Control.Monad.Trans.RWS.Lazy         as Lazy-import qualified Control.Monad.Trans.RWS.Strict       as Strict-import qualified Control.Monad.Trans.State.Lazy       as Lazy-import qualified Control.Monad.Trans.State.Strict     as Strict-import qualified Control.Monad.Trans.Writer.Lazy      as Lazy-import qualified Control.Monad.Trans.Writer.Strict    as Strict-import qualified Data.Semigroup.Foldable              as F1+import Control.Applicative+import Control.Applicative.Backwards+import Control.Arrow+import Control.Monad.Trans.Except+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import Control.Monad.Trans.Reader+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import Data.Deriving+import Data.Functor.Apply+import Data.Functor.Compose+import Data.Functor.Constant+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.Product+import Data.Functor.Reverse+import qualified Data.Semigroup.Foldable as F1  #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt(..))@@ -98,20 +98,22 @@ -- convolution.  That is, it is possible to define a function @(f `Day` f) -- a -> f a@ in a way that is associative. class Contravariant f => Divise f where-    -- | Takes a "splitting" method and the two sub-consumers, and-    -- returns the wrapped/combined consumer.-    divise :: (a -> (b, c)) -> f b -> f c -> f a-    divise f x y = contramap f (divised x y)-    -- | Combine a consumer of @a@ with a consumer of @b@ to get a consumer-    -- of @(a, b)@.-    divised :: f a -> f b -> f (a, b)-    divised = divise id-    {-# MINIMAL divise | divised #-}+  -- | Takes a "splitting" method and the two sub-consumers, and+  -- returns the wrapped/combined consumer.+  divise :: (a -> (b, c)) -> f b -> f c -> f a+  divise f x y = contramap f (divised x y) +  -- | Combine a consumer of @a@ with a consumer of @b@ to get a consumer+  -- of @(a, b)@.+  divised :: f a -> f b -> f (a, b)+  divised = divise id++  {-# MINIMAL divise | divised #-}+ -- | The Contravariant version of '<|>': split the same input over two -- different consumers. (<:>) :: Divise f => f a -> f a -> f a-x <:> y = divise (\r -> (r,r)) x y+x <:> y = divise (\r -> (r, r)) x y  -- | Convenient helper function to build up a 'Divise' by splitting -- input across many different @f a@s.  Most useful when used alongside@@ -129,7 +131,7 @@ dsum1 = foldr1 (<:>) . F1.toNonEmpty  -- | Wrap a 'Divisible' to be used as a member of 'Divise'-newtype WrappedDivisible f a = WrapDivisible { unwrapDivisible :: f a }+newtype WrappedDivisible f a = WrapDivisible {unwrapDivisible :: f a}   deriving (Generic, Eq, Show, Ord, Read, Functor, Foldable, Traversable)   deriving newtype (Divisible, Contravariant) @@ -223,15 +225,21 @@  instance Divise m => Divise (Lazy.RWST r w s m) where   divise abc (Lazy.RWST rsmb) (Lazy.RWST rsmc) = Lazy.RWST $ \r s ->-    divise (\ ~(a, s', w) -> case abc a of-                                  ~(b, c) -> ((b, s', w), (c, s', w)))-           (rsmb r s) (rsmc r s)+    divise+      ( \ ~(a, s', w) -> case abc a of+          ~(b, c) -> ((b, s', w), (c, s', w))+      )+      (rsmb r s)+      (rsmc r s)  instance Divise m => Divise (Strict.RWST r w s m) where   divise abc (Strict.RWST rsmb) (Strict.RWST rsmc) = Strict.RWST $ \r s ->-    divise (\(a, s', w) -> case abc a of-                                (b, c) -> ((b, s', w), (c, s', w)))-           (rsmb r s) (rsmc r s)+    divise+      ( \(a, s', w) -> case abc a of+          (b, c) -> ((b, s', w), (c, s', w))+      )+      (rsmb r s)+      (rsmc r s)  instance Divise m => Divise (Lazy.StateT s m) where   divise f (Lazy.StateT l) (Lazy.StateT r) = Lazy.StateT $ \s ->@@ -242,12 +250,14 @@     divise (strictFanout f) (l s) (r s)  instance Divise m => Divise (Lazy.WriterT w m) where-  divise f (Lazy.WriterT l) (Lazy.WriterT r) = Lazy.WriterT $-    divise (lazyFanout f) l r+  divise f (Lazy.WriterT l) (Lazy.WriterT r) =+    Lazy.WriterT $+      divise (lazyFanout f) l r  instance Divise m => Divise (Strict.WriterT w m) where-  divise f (Strict.WriterT l) (Strict.WriterT r) = Strict.WriterT $-    divise (strictFanout f) l r+  divise f (Strict.WriterT l) (Strict.WriterT r) =+    Strict.WriterT $+      divise (strictFanout f) l r  -- | Unlike 'Divisible', requires only 'Apply' on @f@. instance (Apply f, Divise g) => Divise (Compose f g) where

@@ -2,7 +2,7 @@  -- | -- Module      : Data.Functor.Contravariant.Divisible.Free--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -14,42 +14,54 @@ -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Divisible.Free (-    Div(.., Conquer, Divide)-  , hoistDiv, liftDiv, runDiv-  , divListF, listFDiv-  , Div1(.., Div1_)-  , hoistDiv1, liftDiv1, toDiv, runDiv1-  , div1NonEmptyF, nonEmptyFDiv1-  , Dec(..)-  , hoistDec, liftDec, runDec-  , Dec1(..)-  , hoistDec1, liftDec1, toDec, runDec1-  ) where+  Div (.., Conquer, Divide),+  hoistDiv,+  liftDiv,+  runDiv,+  divListF,+  listFDiv,+  Div1 (.., Div1_),+  hoistDiv1,+  liftDiv1,+  toDiv,+  runDiv1,+  div1NonEmptyF,+  nonEmptyFDiv1,+  Dec (..),+  hoistDec,+  liftDec,+  runDec,+  Dec1 (..),+  hoistDec1,+  liftDec1,+  toDec,+  runDec1,+) where -import           Control.Applicative.ListF-import           Control.Natural-import           Data.Bifunctor-import           Data.Bifunctor.Assoc-import           Data.Foldable-import           Data.Functor.Apply-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Coyoneda-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Inplicative-import           Data.Functor.Invariant.Internative-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+import Control.Applicative.ListF+import qualified Control.Monad.Trans.Compose as CT+import Control.Natural+import Data.Bifunctor+import Data.Bifunctor.Assoc+import Data.Foldable+import Data.Functor.Apply+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Coyoneda+import qualified Data.Functor.Contravariant.Day as CD+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.Invariant.Inplicative+import Data.Functor.Invariant.Internative+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  -- | The free 'Divisible'.  Used to sequence multiple contravariant -- consumers, splitting out the input across all consumers.@@ -63,15 +75,15 @@ -- The wrapping in 'Coyoneda' is also to provide a usable -- 'Data.HBifunctor.Associative.Associative' instance for the contravariant -- 'CD.Day'.-newtype Div f a = Div { unDiv :: [Coyoneda f a] }+newtype Div f a = Div {unDiv :: [Coyoneda f a]}   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+  htraverse f (Div xs) = Div <$> traverse (htraverse f) xs  instance Invariant (Div f) where-    invmap _ = contramap+  invmap _ = contramap  deriving via WrappedDivisible (Div f) instance Inply (Div f) deriving via WrappedDivisible (Div f) instance Inplicative (Div f)@@ -94,6 +106,7 @@ pattern Divide f x xs <- (divDay_ -> Just (CD.Day x xs f))   where     Divide f x (Div xs) = Div $ Coyoneda (fst . f) x : (map . contramap) (snd . f) xs+ {-# COMPLETE Conquer, Divide #-}  divDay_ :: Div f a -> Maybe (CD.Day f (Div f) a)@@ -122,10 +135,10 @@ runDiv :: forall f g. Divisible g => (f ~> g) -> Div f ~> g runDiv f = foldr go conquer . unDiv   where-    go (Coyoneda g x) = divide (\y -> (y,y)) (contramap g (f x))+    go (Coyoneda g x) = divide (\y -> (y, y)) (contramap g (f x))  instance Divisible f => Interpret Div f where-    interpret = runDiv+  interpret = runDiv  -- | The free 'Divise': a non-empty version of 'Div'. --@@ -138,23 +151,23 @@ -- The wrapping in 'Coyoneda' is also to provide a usable -- 'Data.HBifunctor.Associative.Associative' instance for the contravariant -- 'CD.Day'.-newtype Div1 f a = Div1 { unDiv1 :: NonEmpty (Coyoneda f a) }+newtype Div1 f a = Div1 {unDiv1 :: NonEmpty (Coyoneda f a)}   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+  htraverse f (Div1 xs) = Div1 <$> traverse (htraverse f) xs  instance HTraversable1 Div1 where-    htraverse1 f (Div1 xs) = Div1 <$> traverse1 (htraverse1 f) xs+  htraverse1 f (Div1 xs) = Div1 <$> traverse1 (htraverse1 f) xs  instance Invariant (Div1 f) where-    invmap _ = contramap+  invmap _ = contramap  deriving via WrappedDivisible (Div1 f) instance Inply (Div1 f)  instance Divise f => Interpret Div1 f where-    interpret = runDiv1+  interpret = runDiv1  -- | Pattern matching on a 'Div1', exposing the raw @f@ instead of -- having it wrapped in a 'Coyoneda'.  This is the analogue of@@ -166,9 +179,10 @@ -- -- @since 0.3.3.0 pattern Div1_ :: (a -> (b, c)) -> f b -> Div f c -> Div1 f a-pattern Div1_ f x xs <- (div1_->CD.Day x xs f)+pattern Div1_ f x xs <- (div1_ -> CD.Day x xs f)   where     Div1_ f x (Div xs) = Div1 $ Coyoneda (fst . f) x :| (map . contramap) (snd . f) xs+ {-# COMPLETE Div1_ #-}  div1_ :: Div1 f ~> CD.Day f (Div f)@@ -189,7 +203,7 @@  -- | Interpret a 'Div1' into a context @g@, provided @g@ is 'Divise'. runDiv1 :: Divise g => (f ~> g) -> Div1 f ~> g-runDiv1 f = foldr1 (divise (\y->(y,y))) . fmap go . unDiv1+runDiv1 f = foldr1 (divise (\y -> (y, y))) . fmap go . unDiv1   where     go (Coyoneda g x) = contramap g (f x) @@ -206,39 +220,40 @@ -- | The free 'Decide'.  Used to aggregate multiple possible consumers, -- directing the input into an appropriate consumer. data Dec :: (Type -> Type) -> Type -> Type where-    Lose   :: (a -> Void) -> Dec f a-    Choose :: (a -> Either b c) -> f b -> Dec f c -> Dec f a+  Lose :: (a -> Void) -> Dec f a+  Choose :: (a -> Either b c) -> f b -> Dec f c -> Dec f a  instance Contravariant (Dec f) where-    contramap f = \case-      Lose   g      -> Lose   (g . f)-      Choose g x xs -> Choose (g . f) x xs+  contramap f = \case+    Lose g -> Lose (g . f)+    Choose g x xs -> Choose (g . f) x xs instance Invariant (Dec f) where-    invmap _ = contramap+  invmap _ = contramap deriving via WrappedDivisible (Dec f) instance Inalt (Dec f) deriving via WrappedDivisible (Dec f) instance Inplus (Dec f) instance Decide (Dec f) where-    decide f = \case-      Lose   g      -> contramap (either (absurd . g) id . f)-      Choose g x xs -> Choose (assoc . first g . f) x-                     . decide id xs+  decide f = \case+    Lose g -> contramap (either (absurd . g) id . f)+    Choose g x xs ->+      Choose (assoc . first g . f) x+        . decide id xs instance Conclude (Dec f) where-    conclude = Lose+  conclude = Lose instance HFunctor Dec where-    hmap = hoistDec+  hmap = hoistDec instance Inject Dec where-    inject = liftDec+  inject = liftDec instance Conclude f => Interpret Dec f where-    interpret = runDec+  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+  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@@ -262,10 +277,9 @@       Lose g -> conclude g       Choose g x xs -> decide g (f x) (go xs) - -- | The free 'Decide': a non-empty version of 'Dec'. data Dec1 :: (Type -> Type) -> Type -> Type where-    Dec1 :: (a -> Either b c) -> f b -> Dec f c -> Dec1 f a+  Dec1 :: (a -> Either b c) -> f b -> Dec f c -> Dec1 f a  -- | A 'Dec1' is a "non-empty" 'Dec'; this function "forgets" the non-empty -- property and turns it back into a normal 'Dec'.@@ -273,26 +287,27 @@ toDec (Dec1 f x xs) = Choose f x xs  instance Contravariant (Dec1 f) where-    contramap f (Dec1 g x xs) = Dec1 (g . f) x xs+  contramap f (Dec1 g x xs) = Dec1 (g . f) x xs instance Invariant (Dec1 f) where-    invmap _ = contramap+  invmap _ = contramap deriving via WrappedDivisible (Dec1 f) instance Inalt (Dec1 f) instance Decide (Dec1 f) where-    decide f (Dec1 g x xs) = Dec1 (assoc . first g . f) x-                           . decide id xs-                           . toDec+  decide f (Dec1 g x xs) =+    Dec1 (assoc . first g . f) x+      . decide id xs+      . toDec instance HFunctor Dec1 where-    hmap = hoistDec1+  hmap = hoistDec1 instance Inject Dec1 where-    inject = liftDec1+  inject = liftDec1 instance Decide f => Interpret Dec1 f where-    interpret = runDec1+  interpret = runDec1  instance HTraversable Dec1 where-    htraverse f (Dec1 g x xs) = Dec1 g <$> f x <*> htraverse f xs+  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+  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@@ -306,30 +321,32 @@ runDec1 :: Decide g => (f ~> g) -> Dec1 f ~> g runDec1 f (Dec1 g x xs) = runDec1_ f g x xs -runDec1_-    :: forall f g a b c. Decide g-    => (f ~> g)-    -> (a -> Either b c)-    -> f b-    -> Dec f c-    -> g a+runDec1_ ::+  forall f g a b c.+  Decide g =>+  (f ~> g) ->+  (a -> Either b c) ->+  f b ->+  Dec f c ->+  g a runDec1_ f = go   where     go :: (x -> Either y z) -> f y -> Dec f z -> g x     go g x = \case-      Lose h        -> contramap (either id (absurd . h) . g) (f x)+      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_ ::+  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+      Lose h -> (\x' -> Dec1 g x' (Lose h)) <$> f x       Choose h y ys -> Dec1 g <$> f x <.> (toDec <$> go h y ys)

@@ -1,7 +1,6 @@- -- | -- Module      : Data.Functor.Contravariant.Night--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -13,26 +12,32 @@ -- -- @since 0.3.0.0 module Data.Functor.Contravariant.Night (-    Night(..)-  , night-  , runNight, necide-  , assoc, unassoc-  , swapped-  , trans1, trans2-  , intro1, intro2-  , elim1, elim2-  , Not(..), refuted-  ) where+  Night (..),+  night,+  runNight,+  necide,+  assoc,+  unassoc,+  swapped,+  trans1,+  trans2,+  intro1,+  intro2,+  elim1,+  elim2,+  Not (..),+  refuted,+) where -import           Control.Natural-import           Data.Bifunctor-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Invariant-import           Data.Kind-import           Data.Void-import qualified Data.Bifunctor.Assoc              as B-import qualified Data.Bifunctor.Swap               as B+import Control.Natural+import Data.Bifunctor+import qualified Data.Bifunctor.Assoc as B+import qualified Data.Bifunctor.Swap as B+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Decide+import Data.Functor.Invariant+import Data.Kind+import Data.Void  -- | A pairing of contravariant functors to create a new contravariant -- functor that represents the "choice" between the two.@@ -52,43 +57,44 @@ -- about in Haskell (which uses @(,)@).  Therefore, it is an alternative to -- the typical 'Data.Functor.Day' convolution --- hence, the name 'Night'. data Night :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) where-    Night :: f b-          -> g c-          -> (a -> Either b c)-          -> Night f g a+  Night ::+    f b ->+    g c ->+    (a -> Either b c) ->+    Night f g a  instance Contravariant (Night f g) where-    contramap f (Night x y g) = Night x y (g . f)+  contramap f (Night x y g) = Night x y (g . f)  instance Invariant (Night f g) where-    invmap _ f (Night x y g) = Night x y (g . f)+  invmap _ f (Night x y g) = Night x y (g . f)  -- | Inject into a 'Night'. -- -- @'night' x y@ is a consumer of @'Either' a b@; 'Left' will be passed -- to @x@, and 'Right' will be passed to @y@.-night-    :: f a-    -> g b-    -> Night f g (Either a b)+night ::+  f a ->+  g b ->+  Night f g (Either a b) night x y = Night x y id  -- | Interpret out of a 'Night' into any instance of 'Decide' by providing -- two interpreting functions.-runNight-    :: Decide h-    => (f ~> h)-    -> (g ~> h)-    -> Night f g ~> h+runNight ::+  Decide h =>+  (f ~> h) ->+  (g ~> h) ->+  Night f g ~> h runNight f g (Night x y z) = decide z (f x) (g y)  -- | Squash the two items in a 'Night' using their natural 'Decide' -- instances. -- -- @since 0.4.0.0-necide-    :: Decide f-    => Night f f ~> f+necide ::+  Decide f =>+  Night f f ~> f necide (Night x y z) = decide z x y  -- | 'Night' is associative.@@ -112,7 +118,7 @@ trans2 f (Night x y z) = Night x (f y) z  -- | A value of type @'Not' a@ is "proof" that @a@ is uninhabited.-newtype Not a = Not { refute :: a -> Void }+newtype Not a = Not {refute :: a -> Void}  -- | A useful shortcut for a common usage: 'Void' is always not so. --@@ -121,13 +127,14 @@ refuted = Not id  instance Contravariant Not where-    contramap f (Not g) = Not (g . f)+  contramap f (Not g) = Not (g . f)+ -- | @since 0.3.1.0 instance Invariant Not where-    invmap _ = contramap+  invmap _ = contramap  instance Semigroup (Not a) where-    Not f <> Not g = Not (f <> g)+  Not f <> Not g = Not (f <> g)  -- | The left identity of 'Night' is 'Not'; this is one side of that -- isomorphism.

@@ -1,5 +1,5 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE DerivingVia               #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingVia #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}  -- |@@ -17,77 +17,80 @@ -- @since 0.4.0.0 module Data.Functor.Invariant.Inplicative (   -- * Typeclass-    Inply(..)-  , Inplicative(..)+  Inply (..),+  Inplicative (..),+   -- * Deriving-  , WrappedApplicativeOnly(..)-  , WrappedDivisibleOnly(..)+  WrappedApplicativeOnly (..),+  WrappedDivisibleOnly (..),+   -- * Invariant 'Day'-  , runDay-  , dather-  , runDayApply-  , runDayDivise+  runDay,+  dather,+  runDayApply,+  runDayDivise,+   -- * Assembling Helpers-  , gatheredN-  , gatheredNMap-  , gatheredN1-  , gatheredN1Map-  , gatheredNRec-  , gatheredNMapRec-  , gatheredN1Rec-  , gatheredN1MapRec-  , gatherN-  , gatherN1-  ) where+  gatheredN,+  gatheredNMap,+  gatheredN1,+  gatheredN1Map,+  gatheredNRec,+  gatheredNMapRec,+  gatheredN1Rec,+  gatheredN1MapRec,+  gatherN,+  gatherN1,+) where -import           Control.Applicative-import           Control.Applicative.Backwards               (Backwards(..))-import           Control.Applicative.Lift                    (Lift(Pure, Other))-import           Control.Arrow                               (Arrow)-import           Control.Monad.Trans.Cont                    (ContT)-import           Control.Monad.Trans.Except                  (ExceptT(..))-import           Control.Monad.Trans.Identity                (IdentityT(..))-import           Control.Monad.Trans.Maybe                   (MaybeT(..))-import           Control.Monad.Trans.RWS                     (RWST(..))-import           Control.Monad.Trans.Reader                  (ReaderT(..))-import           Control.Monad.Trans.State                   (StateT)-import           Control.Monad.Trans.Writer                  (WriterT(..))-import           Control.Natural-import           Data.Complex                                (Complex)-import           Data.Deriving-import           Data.Functor.Apply-import           Data.Functor.Bind.Class                     (Bind)-import           Data.Functor.Constant                       (Constant)-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Identity-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Day-import           Data.Functor.Product                        (Product(..))-import           Data.Functor.Reverse                        (Reverse(..))-import           Data.Hashable                               (Hashable)-import           Data.Kind-import           Data.List.NonEmpty                          (NonEmpty)-import           Data.SOP hiding                             (hmap)-import           Data.Sequence                               (Seq)-import           Data.StateVar                               (SettableStateVar)-import           Data.Tagged                                 (Tagged)-import           Data.Tree                                   (Tree)-import           GHC.Generics                                (Generic)-import qualified Control.Monad.Trans.RWS.Strict as Strict    (RWST(..))-import qualified Control.Monad.Trans.State.Strict as Strict  (StateT)-import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(..))-import qualified Data.HashMap.Lazy                           as HM-import qualified Data.IntMap                                 as IM-import qualified Data.Map                                    as M-import qualified Data.Monoid                                 as Monoid-import qualified Data.Semigroup                              as Semigroup-import qualified Data.Sequence.NonEmpty                      as NESeq-import qualified Data.Vinyl                                  as V-import qualified Data.Vinyl.Curry                            as V-import qualified Data.Vinyl.Functor                          as V-import qualified GHC.Generics                                as Generics+import Control.Applicative+import Control.Applicative.Backwards (Backwards (..))+import Control.Applicative.Lift (Lift (Other, Pure))+import Control.Arrow (Arrow)+import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Except (ExceptT (..))+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.Maybe (MaybeT (..))+import Control.Monad.Trans.RWS (RWST (..))+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST (..))+import Control.Monad.Trans.Reader (ReaderT (..))+import Control.Monad.Trans.State (StateT)+import qualified Control.Monad.Trans.State.Strict as Strict (StateT)+import Control.Monad.Trans.Writer (WriterT (..))+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT (..))+import Control.Natural+import Data.Complex (Complex)+import Data.Deriving+import Data.Functor.Apply+import Data.Functor.Bind.Class (Bind)+import Data.Functor.Constant (Constant)+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Identity+import Data.Functor.Invariant+import Data.Functor.Invariant.Day+import Data.Functor.Product (Product (..))+import Data.Functor.Reverse (Reverse (..))+import qualified Data.HashMap.Lazy as HM+import Data.Hashable (Hashable)+import qualified Data.IntMap as IM+import Data.Kind+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Map as M+import qualified Data.Monoid as Monoid+import Data.SOP hiding (hmap)+import qualified Data.Semigroup as Semigroup+import Data.Sequence (Seq)+import qualified Data.Sequence.NonEmpty as NESeq+import Data.StateVar (SettableStateVar)+import Data.Tagged (Tagged)+import Data.Tree (Tree)+import qualified Data.Vinyl as V+import qualified Data.Vinyl.Curry as V+import qualified Data.Vinyl.Functor as V+import GHC.Generics (Generic)+import qualified GHC.Generics as Generics  #if !MIN_VERSION_transformers(0,6,0) import           Control.Monad.Trans.Error@@ -112,42 +115,44 @@ -- -- @since 0.4.0.0 class Invariant f => Inply f where-    -- | Like '<.>', '<*>', 'divise', or 'divide', but requires both-    -- a splitting and a recombining function.  '<.>' and '<*>' require-    -- only a combining function, and 'divise' and 'divide' require only-    -- a splitting function.-    ---    -- It is used to merge @f b@ (producer and consumer of @b@) and @f c@-    -- (producer and consumer of @c@) into a @f a@.  You can think of it-    -- as, for the @f a@, it "splits" the a into @b@ and @c@ with the @a ->-    -- (b, c)@, feeds it to the original @f b@ and @f c@, and then-    -- re-combines the output back into a @a@ with the @b -> c -> a@.-    ---    -- An important property is that it will always use @both@ of the-    -- ccomponents given in order to fulfil its job.  If you gather an @f-    -- a@ and an @f b@ into an @f c@, in order to consume/produdce the @c@,-    -- it will always use both the @f a@ or the @f b@ -- exactly one of-    -- them.-    ---    -- @since 0.4.0.0-    gather-        :: (b -> c -> a)-        -> (a -> (b, c))-        -> f b-        -> f c-        -> f a-    gather f g x y = invmap (uncurry f) g (gathered x y)-    -- | A simplified version of 'gather' that combines into a tuple.  You-    -- can then use 'invmap' to reshape it into the proper shape.-    ---    -- @since 0.4.0.0-    gathered-        :: f a-        -> f b-        -> f (a, b)-    gathered = gather (,) id-    {-# MINIMAL gather | gathered #-}+  -- | Like '<.>', '<*>', 'divise', or 'divide', but requires both+  -- a splitting and a recombining function.  '<.>' and '<*>' require+  -- only a combining function, and 'divise' and 'divide' require only+  -- a splitting function.+  --+  -- It is used to merge @f b@ (producer and consumer of @b@) and @f c@+  -- (producer and consumer of @c@) into a @f a@.  You can think of it+  -- as, for the @f a@, it "splits" the a into @b@ and @c@ with the @a ->+  -- (b, c)@, feeds it to the original @f b@ and @f c@, and then+  -- re-combines the output back into a @a@ with the @b -> c -> a@.+  --+  -- An important property is that it will always use @both@ of the+  -- ccomponents given in order to fulfil its job.  If you gather an @f+  -- a@ and an @f b@ into an @f c@, in order to consume/produdce the @c@,+  -- it will always use both the @f a@ or the @f b@ -- exactly one of+  -- them.+  --+  -- @since 0.4.0.0+  gather ::+    (b -> c -> a) ->+    (a -> (b, c)) ->+    f b ->+    f c ->+    f a+  gather f g x y = invmap (uncurry f) g (gathered x y) +  -- | A simplified version of 'gather' that combines into a tuple.  You+  -- can then use 'invmap' to reshape it into the proper shape.+  --+  -- @since 0.4.0.0+  gathered ::+    f a ->+    f b ->+    f (a, b)+  gathered = gather (,) id++  {-# MINIMAL gather | gathered #-}+ -- | The invariant counterpart of 'Applicative' and 'Divisible'. -- -- The main important action is described in 'Inply', but this adds 'knot',@@ -160,7 +165,7 @@ -- -- @since 0.4.0.0 class Inply f => Inplicative f where-    knot :: a -> f a+  knot :: a -> f a  -- | Interpret out of a contravariant 'Day' into any instance of 'Inply' by -- providing two interpreting functions.@@ -169,11 +174,11 @@ -- a different package. -- -- @since 0.4.0.0-runDay-    :: Inply h-    => (f ~> h)-    -> (g ~> h)-    -> Day f g ~> h+runDay ::+  Inply h =>+  (f ~> h) ->+  (g ~> h) ->+  Day f g ~> h runDay f g (Day x y a b) = gather a b (f x) (g y)  -- | Squash the two items in a 'Day' using their natural 'Inply'@@ -183,38 +188,40 @@ -- a different package. -- -- @since 0.4.0.0-dather-    :: Inply f-    => Day f f ~> f+dather ::+  Inply f =>+  Day f f ~> f dather (Day x y a b) = gather a b x y  -- | Ignores the contravariant part of 'gather' instance Apply f => Inply (WrappedFunctor f) where-    gather f _ (WrapFunctor x) (WrapFunctor y) = WrapFunctor (liftF2 f x y)-    gathered (WrapFunctor x) (WrapFunctor y) = WrapFunctor (liftF2 (,) x y)+  gather f _ (WrapFunctor x) (WrapFunctor y) = WrapFunctor (liftF2 f x y)+  gathered (WrapFunctor x) (WrapFunctor y) = WrapFunctor (liftF2 (,) x y)+ -- | @'knot' = 'pure'@ instance (Applicative f, Apply f) => Inplicative (WrappedFunctor f) where-    knot = pure+  knot = pure  -- | Ignores the covariant part of 'gather' instance Divise f => Inply (WrappedContravariant f) where-    gather _ g (WrapContravariant x) (WrapContravariant y) = WrapContravariant (divise g x y)-    gathered (WrapContravariant x) (WrapContravariant y) = WrapContravariant (divised x y)+  gather _ g (WrapContravariant x) (WrapContravariant y) = WrapContravariant (divise g x y)+  gathered (WrapContravariant x) (WrapContravariant y) = WrapContravariant (divised x y)+ -- | @'knot' _ = 'conquer'@ instance (Divisible f, Divise f) => Inplicative (WrappedContravariant f) where-    knot _ = conquer+  knot _ = conquer  -- | Ignores the covariant part of 'gather' instance Divise f => Inply (WrappedDivisible f) where-    gather _ g (WrapDivisible x) (WrapDivisible y) = WrapDivisible (divise g x y)-    gathered (WrapDivisible x) (WrapDivisible y) = WrapDivisible (divised x y)+  gather _ g (WrapDivisible x) (WrapDivisible y) = WrapDivisible (divise g x y)+  gathered (WrapDivisible x) (WrapDivisible y) = WrapDivisible (divised x y)+ -- | @'knot' _ = 'conquer'@ instance (Divisible f, Divise f) => Inplicative (WrappedDivisible f) where-    knot _ = conquer+  knot _ = conquer  -- | Wrap an 'Applicative' that is not necessarily an 'Apply'.-newtype WrappedApplicativeOnly f a =-    WrapApplicativeOnly { unwrapApplicativeOnly :: f a }+newtype WrappedApplicativeOnly f a = WrapApplicativeOnly {unwrapApplicativeOnly :: f a}   deriving (Generic, Eq, Show, Ord, Read, Functor, Foldable, Traversable)   deriving newtype (Applicative, Monad) @@ -224,20 +231,21 @@ deriveOrd1 ''WrappedApplicativeOnly  instance Invariant f => Invariant (WrappedApplicativeOnly f) where-    invmap f g (WrapApplicativeOnly x) = WrapApplicativeOnly (invmap f g x)+  invmap f g (WrapApplicativeOnly x) = WrapApplicativeOnly (invmap f g x) instance (Applicative f, Invariant f) => Apply (WrappedApplicativeOnly f) where-    x <.> y = x <*> y+  x <.> y = x <*> y+ -- | Ignores the contravariant part of 'gather' instance (Applicative f, Invariant f) => Inply (WrappedApplicativeOnly f) where-    gather f _ (WrapApplicativeOnly x) (WrapApplicativeOnly y) = WrapApplicativeOnly (liftA2 f x y)-    gathered (WrapApplicativeOnly x) (WrapApplicativeOnly y) = WrapApplicativeOnly (liftA2 (,) x y)+  gather f _ (WrapApplicativeOnly x) (WrapApplicativeOnly y) = WrapApplicativeOnly (liftA2 f x y)+  gathered (WrapApplicativeOnly x) (WrapApplicativeOnly y) = WrapApplicativeOnly (liftA2 (,) x y)+ -- | @'knot' = 'pure'@ instance (Applicative f, Invariant f) => Inplicative (WrappedApplicativeOnly f) where-    knot = pure+  knot = pure  -- | Wrap an 'Divisible' that is not necessarily a 'Divise'.-newtype WrappedDivisibleOnly f a =-    WrapDivisibleOnly { unwrapDivisibleOnly :: f a }+newtype WrappedDivisibleOnly f a = WrapDivisibleOnly {unwrapDivisibleOnly :: f a}   deriving (Generic, Eq, Show, Ord, Read, Functor, Foldable, Traversable)   deriving newtype (Divisible, Contravariant) @@ -247,63 +255,78 @@ deriveOrd1 ''WrappedDivisibleOnly  instance Invariant f => Invariant (WrappedDivisibleOnly f) where-    invmap f g (WrapDivisibleOnly x) = WrapDivisibleOnly (invmap f g x)+  invmap f g (WrapDivisibleOnly x) = WrapDivisibleOnly (invmap f g x) instance (Divisible f, Invariant f) => Divise (WrappedDivisibleOnly f) where-    divise g (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divide g x y)+  divise g (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divide g x y)+ -- | Ignores the covariant part of 'gather' instance (Divisible f, Invariant f) => Inply (WrappedDivisibleOnly f) where-    gather _ g (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divide g x y)-    gathered (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divided x y)+  gather _ g (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divide g x y)+  gathered (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (divided x y)+ -- | @'knot' _ = 'conquer'@ instance (Divisible f, Invariant f) => Inplicative (WrappedDivisibleOnly f) where-    knot _ = conquer+  knot _ = conquer  funzip :: Functor f => f (a, b) -> (f a, f b) funzip x = (fmap fst x, fmap snd x)  -- | @since 0.4.1.0 instance Inply f => Inply (MaybeT f) where-    gather f g (MaybeT x) (MaybeT y) = MaybeT $+  gather f g (MaybeT x) (MaybeT y) =+    MaybeT $       gather (liftA2 f) (funzip . fmap g) x y+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (MaybeT f) where-    knot x = MaybeT (knot (Just x))+  knot x = MaybeT (knot (Just x))  -- | @since 0.4.1.0 instance (Inply f, Semigroup w) => Inply (WriterT w f) where-    gather f g (WriterT x) (WriterT y) = WriterT $-      gather (\case (a, q) -> \case (b, r) -> (f a b, q <> r))-             (\case (a, s) -> case g a of (b, c) -> ((b, s), (c, s)))-             x y+  gather f g (WriterT x) (WriterT y) =+    WriterT $+      gather+        (\case (a, q) -> \case (b, r) -> (f a b, q <> r))+        (\case (a, s) -> case g a of (b, c) -> ((b, s), (c, s)))+        x+        y+ -- | @since 0.4.1.0 instance (Inplicative f, Monoid w) => Inplicative (WriterT w f) where-    knot x = WriterT (knot (x, mempty))+  knot x = WriterT (knot (x, mempty))  -- | @since 0.4.1.0 instance (Inply f, Semigroup w) => Inply (Strict.WriterT w f) where-    gather f g (Strict.WriterT x) (Strict.WriterT y) = Strict.WriterT $-      gather (\(~(a, q)) (~(b, r)) -> (f a b, q <> r))-             (\(~(a, s)) -> let ~(b, c) = g a in ((b, s), (c, s)))-             x y+  gather f g (Strict.WriterT x) (Strict.WriterT y) =+    Strict.WriterT $+      gather+        (\(~(a, q)) (~(b, r)) -> (f a b, q <> r))+        (\(~(a, s)) -> let ~(b, c) = g a in ((b, s), (c, s)))+        x+        y+ -- | @since 0.4.1.0 instance (Inplicative f, Monoid w) => Inplicative (Strict.WriterT w f) where-    knot x = Strict.WriterT (knot (x, mempty))+  knot x = Strict.WriterT (knot (x, mempty))  -- | @since 0.4.1.0 instance Inply f => Inply (ReaderT r f) where-    gather f g (ReaderT x) (ReaderT y) = ReaderT $ \r ->-      gather f g (x r) (y r)+  gather f g (ReaderT x) (ReaderT y) = ReaderT $ \r ->+    gather f g (x r) (y r)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (ReaderT r f) where-    knot x = ReaderT (\_ -> knot x)+  knot x = ReaderT (\_ -> knot x)  -- | @since 0.4.1.0 instance Inply f => Inply (ExceptT e f) where-    gather f g (ExceptT x) (ExceptT y) = ExceptT $+  gather f g (ExceptT x) (ExceptT y) =+    ExceptT $       gather (liftA2 f) (funzip . fmap g) x y+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (ExceptT e f) where-    knot x = ExceptT (knot (Right x))+  knot x = ExceptT (knot (Right x))  #if !MIN_VERSION_transformers(0,6,0) -- | @since 0.4.1.0@@ -324,148 +347,229 @@ #endif  -- | @since 0.4.1.0-deriving via WrappedFunctor (RWST r w s m) instance (Bind m, Invariant m, Semigroup w) => Inply (RWST r w s m)+deriving via+  WrappedFunctor (RWST r w s m)+  instance+    (Bind m, Invariant m, Semigroup w) => Inply (RWST r w s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (RWST r w s m) instance (Monad m, Bind m, Invariant m, Monoid w) => Inplicative (RWST r w s m)+deriving via+  WrappedFunctor (RWST r w s m)+  instance+    (Monad m, Bind m, Invariant m, Monoid w) => Inplicative (RWST r w s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Strict.RWST r w s m) instance (Bind m, Invariant m, Semigroup w) => Inply (Strict.RWST r w s m)+deriving via+  WrappedFunctor (Strict.RWST r w s m)+  instance+    (Bind m, Invariant m, Semigroup w) => Inply (Strict.RWST r w s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Strict.RWST r w s m) instance (Monad m, Bind m, Invariant m, Monoid w) => Inplicative (Strict.RWST r w s m)+deriving via+  WrappedFunctor (Strict.RWST r w s m)+  instance+    (Monad m, Bind m, Invariant m, Monoid w) => Inplicative (Strict.RWST r w s m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (StateT s m) instance (Bind m, Invariant m) => Inply (StateT s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (StateT s m) instance (Monad m, Bind m, Invariant m) => Inplicative (StateT s m)+deriving via+  WrappedFunctor (StateT s m)+  instance+    (Monad m, Bind m, Invariant m) => Inplicative (StateT s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Strict.StateT s m) instance (Bind m, Invariant m) => Inply (Strict.StateT s m)+deriving via+  WrappedFunctor (Strict.StateT s m)+  instance+    (Bind m, Invariant m) => Inply (Strict.StateT s m)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Strict.StateT s m) instance (Monad m, Bind m, Invariant m) => Inplicative (Strict.StateT s m)+deriving via+  WrappedFunctor (Strict.StateT s m)+  instance+    (Monad m, Bind m, Invariant m) => Inplicative (Strict.StateT s m)  -- | @since 0.4.1.0 instance Inply f => Inply (Generics.M1 i t f :: Type -> Type) where-    gather f g (Generics.M1 x) (Generics.M1 y) = Generics.M1 (gather f g x y)+  gather f g (Generics.M1 x) (Generics.M1 y) = Generics.M1 (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (Generics.M1 i t f :: Type -> Type) where-    knot = Generics.M1 . knot+  knot = Generics.M1 . knot+ -- | @since 0.4.1.0 instance (Inply f, Inply g) => Inply (f Generics.:*: g) where-    gather f g (x1 Generics.:*: y1) (x2 Generics.:*: y2) =-        gather f g x1 x2 Generics.:*: gather f g y1 y2+  gather f g (x1 Generics.:*: y1) (x2 Generics.:*: y2) =+    gather f g x1 x2 Generics.:*: gather f g y1 y2+ -- | @since 0.4.1.0 instance (Inplicative f, Inplicative g) => Inplicative (f Generics.:*: g) where-    knot x = knot x Generics.:*: knot x+  knot x = knot x Generics.:*: knot x+ -- | @since 0.4.1.0 instance (Inply f, Inply g) => Inply (Product f g) where-    gather f g (Pair x1 y1) (Pair x2 y2) =-      gather f g x1 x2 `Pair` gather f g y1 y2+  gather f g (Pair x1 y1) (Pair x2 y2) =+    gather f g x1 x2 `Pair` gather f g y1 y2+ -- | @since 0.4.1.0 instance (Inplicative f, Inplicative g) => Inplicative (Product f g) where-    knot x = knot x `Pair` knot x+  knot x = knot x `Pair` knot x+ -- | @since 0.4.1.0 instance Inply f => Inply (Generics.Rec1 f :: Type -> Type) where-    gather f g (Generics.Rec1 x) (Generics.Rec1 y) = Generics.Rec1 (gather f g x y)+  gather f g (Generics.Rec1 x) (Generics.Rec1 y) = Generics.Rec1 (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (Generics.Rec1 f :: Type -> Type) where-    knot = Generics.Rec1 . knot+  knot = Generics.Rec1 . knot+ -- | @since 0.4.1.0 instance Inply f => Inply (Monoid.Alt f) where-    gather f g (Monoid.Alt x) (Monoid.Alt y) = Monoid.Alt (gather f g x y)+  gather f g (Monoid.Alt x) (Monoid.Alt y) = Monoid.Alt (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (Monoid.Alt f) where-    knot = Monoid.Alt . knot+  knot = Monoid.Alt . knot+ -- | @since 0.4.1.0 instance Inply f => Inply (IdentityT f :: Type -> Type) where-    gather f g (IdentityT x) (IdentityT y) = IdentityT (gather f g x y)+  gather f g (IdentityT x) (IdentityT y) = IdentityT (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (IdentityT f :: Type -> Type) where-    knot = IdentityT . knot+  knot = IdentityT . knot+ -- | @since 0.4.1.0 instance Inply f => Inply (Reverse f :: Type -> Type) where-    gather f g (Reverse x) (Reverse y) = Reverse (gather f g x y)+  gather f g (Reverse x) (Reverse y) = Reverse (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (Reverse f :: Type -> Type) where-    knot = Reverse . knot+  knot = Reverse . knot+ -- | @since 0.4.1.0 instance Inply f => Inply (Backwards f :: Type -> Type) where-    gather f g (Backwards x) (Backwards y) = Backwards (gather f g x y)+  gather f g (Backwards x) (Backwards y) = Backwards (gather f g x y)+ -- | @since 0.4.1.0 instance Inplicative f => Inplicative (Backwards f :: Type -> Type) where-    knot = Backwards . knot+  knot = Backwards . knot+ -- | @since 0.4.1.0 instance Inply f => Inply (Lift f) where-    gather f g = \case-      Pure  x -> \case-        Pure  y -> Pure (f x y)-        Other y -> Other (invmap (f x) (snd . g) y)-      Other x -> \case-        Pure  y -> Other (invmap (`f` y) (fst . g) x)-        Other y -> Other (gather f g x y)+  gather f g = \case+    Pure x -> \case+      Pure y -> Pure (f x y)+      Other y -> Other (invmap (f x) (snd . g) y)+    Other x -> \case+      Pure y -> Other (invmap (`f` y) (fst . g) x)+      Other y -> Other (gather f g x y)+ -- | @since 0.4.1.0 instance Inply f => Inplicative (Lift f) where-    knot = Pure+  knot = Pure  -- | @since 0.4.1.0 deriving via WrappedApplicativeOnly (Tagged a) instance Inply (Tagged a)+ -- | @since 0.4.1.0 deriving via WrappedApplicativeOnly (Tagged a) instance Inplicative (Tagged a)  -- | @since 0.4.1.0 deriving via WrappedFunctor Identity instance Inply Identity+ -- | @since 0.4.1.0 deriving via WrappedFunctor Identity instance Inplicative Identity+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inply Proxy+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inplicative Proxy+ -- | @since 0.4.1.0 deriving via WrappedFunctor [] instance Inply []+ -- | @since 0.4.1.0 deriving via WrappedFunctor [] instance Inplicative []+ -- | @since 0.4.1.0 deriving via WrappedFunctor ((->) r) instance Inply ((->) r)+ -- | @since 0.4.1.0 deriving via WrappedFunctor ((->) r) instance Inplicative ((->) r)+ -- | @since 0.4.1.0 deriving via WrappedFunctor Maybe instance Inply Maybe+ -- | @since 0.4.1.0 deriving via WrappedFunctor Maybe instance Inplicative Maybe+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Either e) instance Inply (Either e)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Either e) instance Inplicative (Either e)+ -- | @since 0.4.1.0 deriving via WrappedFunctor IO instance Inply IO+ -- | @since 0.4.1.0 deriving via WrappedFunctor IO instance Inplicative IO+ -- | @since 0.4.1.0 deriving via WrappedFunctor Generics.Par1 instance Inply Generics.Par1+ -- | @since 0.4.1.0 deriving via WrappedFunctor Generics.Par1 instance Inplicative Generics.Par1+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inply Generics.U1+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inplicative Generics.U1+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Generics.K1 i c :: Type -> Type) instance Semigroup c => Inply (Generics.K1 i c)+deriving via+  WrappedFunctor (Generics.K1 i c :: Type -> Type)+  instance+    Semigroup c => Inply (Generics.K1 i c)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Generics.K1 i c :: Type -> Type) instance Monoid c => Inplicative (Generics.K1 i c)+deriving via+  WrappedFunctor (Generics.K1 i c :: Type -> Type)+  instance+    Monoid c => Inplicative (Generics.K1 i c)+ -- | @since 0.4.1.0 deriving via WrappedFunctor Complex instance Inply Complex+ -- | @since 0.4.1.0 deriving via WrappedFunctor Complex instance Inplicative Complex+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Min instance Inply Semigroup.Min+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Min instance Inplicative Semigroup.Min+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Max instance Inply Semigroup.Max+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Max instance Inplicative Semigroup.Max+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.First instance Inply Semigroup.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.First instance Inplicative Semigroup.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Last instance Inply Semigroup.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Last instance Inplicative Semigroup.Last @@ -478,50 +582,73 @@  -- | @since 0.4.1.0 deriving via WrappedFunctor ZipList instance Inply ZipList+ -- | @since 0.4.1.0 deriving via WrappedFunctor ZipList instance Inplicative ZipList+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.First instance Inply Monoid.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.First instance Inplicative Monoid.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Last instance Inply Monoid.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Last instance Inplicative Monoid.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Dual instance Inply Monoid.Dual+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Dual instance Inplicative Monoid.Dual+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Sum instance Inply Monoid.Sum+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Sum instance Inplicative Monoid.Sum+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Product instance Inply Monoid.Product+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Product instance Inplicative Monoid.Product+ -- | @since 0.4.1.0 deriving via WrappedFunctor NonEmpty instance Inply NonEmpty+ -- | @since 0.4.1.0 deriving via WrappedFunctor NonEmpty instance Inplicative NonEmpty+ -- | @since 0.4.1.0 deriving via WrappedFunctor Tree instance Inply Tree+ -- | @since 0.4.1.0 deriving via WrappedFunctor Tree instance Inplicative Tree+ -- | @since 0.4.1.0 deriving via WrappedFunctor Seq instance Inply Seq+ -- | @since 0.4.1.0 deriving via WrappedFunctor Seq instance Inplicative Seq+ -- | @since 0.4.1.0 deriving via WrappedFunctor NESeq.NESeq instance Inply NESeq.NESeq+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedArrow a b) instance Arrow a => Inply (WrappedArrow a b)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedArrow a b) instance Arrow a => Inplicative (WrappedArrow a b)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.V1 :: Type -> Type) instance Inply Generics.V1+ -- | @since 0.4.1.0 deriving via WrappedFunctor IM.IntMap instance Inply IM.IntMap+ -- | @since 0.4.1.0 deriving via WrappedFunctor (M.Map k) instance Ord k => Inply (M.Map k) @@ -537,49 +664,67 @@  -- | @since 0.4.1.0 deriving via WrappedFunctor (Const w :: Type -> Type) instance Semigroup w => Inply (Const w)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Const w :: Type -> Type) instance Monoid w => Inplicative (Const w)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Constant w :: Type -> Type) instance Semigroup w => Inply (Constant w)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (Constant w :: Type -> Type) instance Monoid w => Inplicative (Constant w)+deriving via+  WrappedFunctor (Constant w :: Type -> Type)+  instance+    Monoid w => Inplicative (Constant w)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (ContT r (m :: Type -> Type)) instance Inply (ContT r m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (ContT r (m :: Type -> Type)) instance Inplicative (ContT r m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedMonad m) instance Monad m => Inply (WrappedMonad m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedMonad m) instance Monad m => Inplicative (WrappedMonad m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor ((,) w :: Type -> Type) instance Semigroup w => Inply ((,) w)+ -- | @since 0.4.1.0 deriving via WrappedFunctor ((,) w :: Type -> Type) instance Monoid w => Inplicative ((,) w)  -- | @since 0.4.1.0 deriving via WrappedDivisible SettableStateVar instance Inply SettableStateVar+ -- | @since 0.4.1.0 deriving via WrappedDivisible SettableStateVar instance Inplicative SettableStateVar+ -- | @since 0.4.1.0 deriving via WrappedDivisible Predicate instance Inply Predicate+ -- | @since 0.4.1.0 deriving via WrappedDivisible Predicate instance Inplicative Predicate+ -- | @since 0.4.1.0 deriving via WrappedDivisible Comparison instance Inply Comparison+ -- | @since 0.4.1.0 deriving via WrappedDivisible Comparison instance Inplicative Comparison+ -- | @since 0.4.1.0 deriving via WrappedDivisible Equivalence instance Inply Equivalence+ -- | @since 0.4.1.0 deriving via WrappedDivisible Equivalence instance Inplicative Equivalence+ -- | @since 0.4.1.0 deriving via WrappedDivisible (Op r) instance Semigroup r => Inply (Op r)+ -- | @since 0.4.1.0 deriving via WrappedDivisible (Op r) instance Monoid r => Inplicative (Op r) --- -- | Convenient wrapper to build up an 'Inplicative' instance by providing -- each component of it.  This makes it much easier to build up longer -- chains because you would only need to write the splitting/joining@@ -614,13 +759,14 @@ --      otherwise you'd need to manually peel off tuples one-by-one. -- -- @since 0.4.1.0-gatheredN-    :: Inplicative f-    => NP f as-    -> f (NP I as)+gatheredN ::+  Inplicative f =>+  NP f as ->+  f (NP I as) gatheredN = \case-    Nil     -> knot Nil-    x :* xs -> gather+  Nil -> knot Nil+  x :* xs ->+    gather       (\y ys -> I y :* ys)       (\case I y :* ys -> (y, ys))       x@@ -654,25 +800,26 @@ -- See notes on 'gatheredNMap' for more details and caveats. -- -- @since 0.4.1.0-gatheredNMap-    :: Inplicative f-    => (NP I as -> b)-    -> (b -> NP I as)-    -> NP f as-    -> f b+gatheredNMap ::+  Inplicative f =>+  (NP I as -> b) ->+  (b -> NP I as) ->+  NP f as ->+  f b gatheredNMap f g = invmap f g . gatheredN  -- | A version of 'gatheredN' for non-empty 'NP', but only -- requiring an 'Inply' instance. -- -- @since 0.4.1.0-gatheredN1-    :: Inply f-    => NP f (a ': as)-    -> f (NP I (a ': as))+gatheredN1 ::+  Inply f =>+  NP f (a ': as) ->+  f (NP I (a ': as)) gatheredN1 (x :* xs) = case xs of-    Nil    -> invmap ((:* Nil) . I) (\case I y :* _ -> y) x-    _ :* _ -> gather+  Nil -> invmap ((:* Nil) . I) (\case I y :* _ -> y) x+  _ :* _ ->+    gather       (\y ys -> I y :* ys)       (\case I y :* ys -> (y, ys))       x@@ -682,12 +829,12 @@ -- requiring an 'Inply' instance. -- -- @since 0.4.1.0-gatheredN1Map-    :: Inplicative f-    => (NP I (a ': as) -> b)-    -> (b -> NP I (a ': as))-    -> NP f (a ': as)-    -> f b+gatheredN1Map ::+  Inplicative f =>+  (NP I (a ': as) -> b) ->+  (b -> NP I (a ': as)) ->+  NP f (a ': as) ->+  f b gatheredN1Map f g = invmap f g . gatheredN1  -- | A version of 'gatheredN' using 'V.XRec' from /vinyl/ instead of@@ -695,13 +842,14 @@ -- require manual unwrapping/wrapping of tuple components. -- -- @since 0.4.1.0-gatheredNRec-    :: Inplicative f-    => V.Rec f as-    -> f (V.XRec V.Identity as)+gatheredNRec ::+  Inplicative f =>+  V.Rec f as ->+  f (V.XRec V.Identity as) gatheredNRec = \case-    V.RNil    -> knot V.RNil-    x V.:& xs -> gather+  V.RNil -> knot V.RNil+  x V.:& xs ->+    gather       (V.::&)       (\case y V.::& ys -> (y, ys))       x@@ -712,12 +860,12 @@ -- require manual unwrapping/wrapping of tuple components. -- -- @since 0.4.1.0-gatheredNMapRec-    :: Inplicative f-    => (V.XRec V.Identity as -> b)-    -> (b -> V.XRec V.Identity as)-    -> V.Rec f as-    -> f b+gatheredNMapRec ::+  Inplicative f =>+  (V.XRec V.Identity as -> b) ->+  (b -> V.XRec V.Identity as) ->+  V.Rec f as ->+  f b gatheredNMapRec f g = invmap f g . gatheredNRec  -- | Convenient wrapper to 'gather' over multiple arguments using tine@@ -763,27 +911,30 @@ -- @ -- -- @since 0.4.1.0-gatherN-    :: forall f as b. (Inplicative f, V.IsoXRec V.Identity as, V.RecordCurry as)-    => V.Curried as b-    -> (b -> V.XRec V.Identity as)-    -> V.CurriedF f as (f b)-gatherN f g = V.rcurry @as @f $+gatherN ::+  forall f as b.+  (Inplicative f, V.IsoXRec V.Identity as, V.RecordCurry as) =>+  V.Curried as b ->+  (b -> V.XRec V.Identity as) ->+  V.CurriedF f as (f b)+gatherN f g =+  V.rcurry @as @f $     invmap (V.runcurry' f . V.fromXRec) g-  . gatheredNRec+      . gatheredNRec  -- | A version of 'gatheredN1' using 'V.XRec' from /vinyl/ instead of -- 'NP' from /sop-core/.  This can be more convenient because it doesn't -- require manual unwrapping/wrapping of components. -- -- @since 0.4.1.0-gatheredN1Rec-    :: Inply f-    => V.Rec f (a ': as)-    -> f (V.XRec V.Identity (a ': as))+gatheredN1Rec ::+  Inply f =>+  V.Rec f (a ': as) ->+  f (V.XRec V.Identity (a ': as)) gatheredN1Rec (x V.:& xs) = case xs of-    V.RNil   -> invmap (V.::& V.RNil) (\case z V.::& _ -> z) x-    _ V.:& _ -> gather+  V.RNil -> invmap (V.::& V.RNil) (\case z V.::& _ -> z) x+  _ V.:& _ ->+    gather       (V.::&)       (\case y V.::& ys -> (y, ys))       x@@ -794,26 +945,28 @@ -- require manual unwrapping/wrapping of tuple components. -- -- @since 0.4.1.0-gatheredN1MapRec-    :: Inplicative f-    => (V.XRec V.Identity (a ': as) -> b)-    -> (b -> V.XRec V.Identity (a ': as))-    -> V.Rec f (a ': as)-    -> f b+gatheredN1MapRec ::+  Inplicative f =>+  (V.XRec V.Identity (a ': as) -> b) ->+  (b -> V.XRec V.Identity (a ': as)) ->+  V.Rec f (a ': as) ->+  f b gatheredN1MapRec f g = invmap f g . gatheredN1Rec  -- | 'gatherN' but with at least one argument, so can be used with any -- 'Inply'. -- -- @since 0.4.1.0-gatherN1-    :: forall f a as b. (Inply f, V.IsoXRec V.Identity as, V.RecordCurry as)-    => V.Curried (a ': as) b-    -> (b -> V.XRec V.Identity (a ': as))-    -> V.CurriedF f (a ': as) (f b)-gatherN1 f g = V.rcurry @(a ': as) @f $+gatherN1 ::+  forall f a as b.+  (Inply f, V.IsoXRec V.Identity as, V.RecordCurry as) =>+  V.Curried (a ': as) b ->+  (b -> V.XRec V.Identity (a ': as)) ->+  V.CurriedF f (a ': as) (f b)+gatherN1 f g =+  V.rcurry @(a ': as) @f $     invmap (V.runcurry' f . V.fromXRec) g-  . gatheredN1Rec+      . gatheredN1Rec  -- | Interpret out of a contravariant 'Day' into any instance of 'Apply' by -- providing two interpreting functions.@@ -823,11 +976,12 @@ -- instance of 'Inply'.  However, this can be handy if you are using an -- instance of 'Apply' that has no 'Inply' instance.  Consider also -- 'unsafeInplyCo' if you are using a specific, concrete type for @h@.-runDayApply-    :: forall f g h. Apply h-    => f ~> h-    -> g ~> h-    -> Day f g ~> h+runDayApply ::+  forall f g h.+  Apply h =>+  f ~> h ->+  g ~> h ->+  Day f g ~> h runDayApply f g (Day x y j _) = liftF2 j (f x) (g y)  -- | Interpret out of a contravariant 'Day' into any instance of 'Divise'@@ -838,10 +992,10 @@ -- instance of 'Inply'.  However, this can be handy if you are using an -- instance of 'Divise' that has no 'Inply' instance.  Consider also -- 'unsafeInplyContra' if you are using a specific, concrete type for @h@.-runDayDivise-    :: forall f g h. Divise h-    => f ~> h-    -> g ~> h-    -> Day f g ~> h+runDayDivise ::+  forall f g h.+  Divise h =>+  f ~> h ->+  g ~> h ->+  Day f g ~> h runDayDivise f g (Day x y _ h) = divise h (f x) (g y)-

@@ -1,8 +1,9 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | -- Module      : Data.Functor.Invariant.Inplicative.Free--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -17,47 +18,50 @@ -- @since 0.4.0.0 module Data.Functor.Invariant.Inplicative.Free (   -- * Chain-    DivAp(.., Gather, Knot)-  , runCoDivAp-  , runContraDivAp-  , divApAp-  , divApDiv-  , foldDivAp-  , assembleDivAp-  , assembleDivApRec+  DivAp (.., Gather, Knot),+  runCoDivAp,+  runContraDivAp,+  divApAp,+  divApDiv,+  foldDivAp,+  assembleDivAp,+  assembleDivApRec,+   -- * Nonempty Chain-  , DivAp1(.., DivAp1)-  , runCoDivAp1-  , runContraDivAp1-  , divApAp1-  , divApDiv1-  , foldDivAp1-  , assembleDivAp1-  , assembleDivAp1Rec-  ) where+  DivAp1 (.., DivAp1),+  runCoDivAp1,+  runContraDivAp1,+  divApAp1,+  divApDiv1,+  foldDivAp1,+  assembleDivAp1,+  assembleDivAp1Rec,+) where -import           Control.Applicative-import           Control.Applicative.Free                  (Ap(..))-import           Control.Applicative.ListF                 (MaybeF(..))-import           Control.Natural-import           Data.Coerce-import           Data.Functor.Apply-import           Data.Functor.Apply.Free                   (Ap1(..))-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Contravariant.Divisible.Free (Div(..), Div1)-import           Data.Functor.Identity-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Day-import           Data.Functor.Invariant.Inplicative-import           Data.HBifunctor.Tensor hiding             (elim1, elim2, intro1, intro2)-import           Data.HFunctor-import           Data.HFunctor.Chain-import           Data.HFunctor.Chain.Internal-import           Data.HFunctor.Interpret-import           Data.SOP hiding                           (hmap)-import qualified Data.Vinyl                                as V-import qualified Data.Vinyl.Functor                        as V+#if !MIN_VERSION_base(4,17,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative.Free (Ap (..))+import Control.Applicative.ListF (MaybeF (..))+import Control.Natural+import Data.Coerce+import Data.Functor.Apply+import Data.Functor.Apply.Free (Ap1 (..))+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Contravariant.Divisible.Free (Div (..), Div1)+import Data.Functor.Identity+import Data.Functor.Invariant+import Data.Functor.Invariant.Day+import Data.Functor.Invariant.Inplicative+import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)+import Data.HFunctor+import Data.HFunctor.Chain+import Data.HFunctor.Chain.Internal+import Data.HFunctor.Interpret+import Data.SOP hiding (hmap)+import qualified Data.Vinyl as V+import qualified Data.Vinyl.Functor as V  -- | In the covariant direction, we can interpret into any 'Apply'. --@@ -66,10 +70,11 @@ -- of 'Inply'.  However, this can be handy if you are using an instance of -- 'Apply' that has no 'Inply' instance.  Consider also 'unsafeInplyCo' if -- you are using a specific, concrete type for @g@.-runCoDivAp1-    :: forall f g. Apply g-    => f ~> g-    -> DivAp1 f ~> g+runCoDivAp1 ::+  forall f g.+  Apply g =>+  f ~> g ->+  DivAp1 f ~> g runCoDivAp1 f = foldDivAp1 f (runDayApply f id)  -- | In the contravariant direction, we can interpret into any 'Divise'.@@ -79,10 +84,11 @@ -- of 'Inply'.  However, this can be handy if you are using an instance of -- 'Divise' that has no 'Inply' instance.  Consider also -- 'unsafeInplyContra' if you are using a specific, concrete type for @g@.-runContraDivAp1-    :: forall f g. Divise g-    => f ~> g-    -> DivAp1 f ~> g+runContraDivAp1 ::+  forall f g.+  Divise g =>+  f ~> g ->+  DivAp1 f ~> g runContraDivAp1 f = foldDivAp1 f (runDayDivise f id)  -- | In the covariant direction, we can interpret into any 'Applicative'.@@ -93,10 +99,11 @@ -- an instance of 'Applicative' that has no 'Inplicative' instance. -- Consider also 'unsafeInplicativeCo' if you are using a specific, -- concrete type for @g@.-runCoDivAp-    :: forall f g. Applicative g-    => f ~> g-    -> DivAp f ~> g+runCoDivAp ::+  forall f g.+  Applicative g =>+  f ~> g ->+  DivAp f ~> g runCoDivAp f = foldDivAp pure (\case Day x y h _ -> liftA2 h (f x) y)  -- | In the covariant direction, we can interpret into any 'Divisible'.@@ -107,10 +114,11 @@ -- an instance of 'Divisible' that has no 'Inplicative' instance.  Consider -- also 'unsafeInplicativeContra' if you are using a specific, concrete -- type for @g@.-runContraDivAp-    :: forall f g. Divisible g-    => f ~> g-    -> DivAp f ~> g+runContraDivAp ::+  forall f g.+  Divisible g =>+  f ~> g ->+  DivAp f ~> g runContraDivAp f = foldDivAp (const conquer) (\case Day x y _ g -> divide g (f x) y)  -- | General-purpose folder of 'DivAp'.  Provide a way to handle the@@ -118,26 +126,22 @@ -- ('liftA2'/'divide'/'Gather'). -- -- @since 0.3.5.0-foldDivAp-    :: (forall x. x -> g x)-    -> (Day f g ~> g)-    -> DivAp f ~> g+foldDivAp ::+  (forall x. x -> g x) ->+  (Day f g ~> g) ->+  DivAp f ~> g foldDivAp f g = foldChain (f . runIdentity) g . unDivAp  -- | General-purpose folder of 'DivAp1'.  Provide a way to handle the -- individual leaves and a way to handle a cons ('liftF2/'divise'/'Gather'). -- -- @since 0.3.5.0-foldDivAp1-    :: (f ~> g)-    -> (Day f g ~> g)-    -> DivAp1 f ~> g+foldDivAp1 ::+  (f ~> g) ->+  (Day f g ~> g) ->+  DivAp1 f ~> g foldDivAp1 f g = foldChain1 f g . unDivAp1 ---- -- | Extract the 'Ap' part out of a 'DivAp', shedding the -- contravariant bits. --@@ -173,27 +177,28 @@ -- Note that the order of the first two arguments has swapped as of -- v0.4.0.0 pattern Gather :: (b -> c -> a) -> (a -> (b, c)) -> f b -> DivAp f c -> DivAp f a-pattern Gather f g x xs <- (unGather_->MaybeF (Just (Day x xs f g)))+pattern Gather f g x xs <- (unGather_ -> MaybeF (Just (Day x xs f g)))   where     Gather f g x xs = DivAp $ More $ Day x (unDivAp xs) f g  unGather_ :: DivAp f ~> MaybeF (Day f (DivAp f)) unGather_ = \case   DivAp (More (Day x xs g f)) -> MaybeF . Just $ Day x (DivAp xs) g f-  DivAp (Done _             ) -> MaybeF Nothing+  DivAp (Done _) -> MaybeF Nothing  -- | Match on an "empty" 'DivAp'; contains no @f@s, but only the -- terminal value.  Analogous to 'Control.Applicative.Free.Pure'. pattern Knot :: a -> DivAp f a pattern Knot x = DivAp (Done (Identity x))+ {-# COMPLETE Gather, Knot #-}  instance Inply (DivAp f) where-    gather = coerce (gather @(Chain Day Identity _))+  gather = coerce (gather @(Chain Day Identity _))  -- | The free 'Inplicative' instance Inplicative (DivAp f) where-    knot = coerce (knot @(Chain Day Identity _))+  knot = coerce (knot @(Chain Day Identity _))  -- | Match on a 'DivAp1' to get the head and the rest of the items. -- Analogous to the 'Data.Functor.Apply.Free.Ap1' constructor.@@ -201,14 +206,15 @@ -- Note that the order of the first two arguments has swapped as of -- v0.4.0.0 pattern DivAp1 :: Invariant f => (b -> c -> a) -> (a -> (b, c)) -> f b -> DivAp f c -> DivAp1 f a-pattern DivAp1 f g x xs <- (coerce splitChain1->Day x xs f g)+pattern DivAp1 f g x xs <- (coerce splitChain1 -> Day x xs f g)   where     DivAp1 f g x xs = unsplitNE $ Day x xs f g+ {-# COMPLETE DivAp1 #-}  -- | The free 'Inplicative' instance Invariant f => Inply (DivAp1 f) where-    gather = coerce (gather @(Chain1 Day _))+  gather = coerce (gather @(Chain1 Day _))  -- | Convenient wrapper to build up a 'DivAp' by providing each -- component of it.  This makes it much easier to build up longer chains@@ -244,16 +250,19 @@ -- -- If each component is itself a @'DivAp' f@ (instead of @f@), you can use -- 'concatInplicative'.-assembleDivAp-    :: NP f as-    -> DivAp f (NP I as)+assembleDivAp ::+  NP f as ->+  DivAp f (NP I as) assembleDivAp = \case-    Nil     -> DivAp $ Done $ Identity Nil-    x :* xs -> DivAp $ More $ Day-      x-      (unDivAp (assembleDivAp xs))-      (\y ys -> I y :* ys)-      (\case I y :* ys -> (y, ys))+  Nil -> DivAp $ Done $ Identity Nil+  x :* xs ->+    DivAp $+      More $+        Day+          x+          (unDivAp (assembleDivAp xs))+          (\y ys -> I y :* ys)+          (\case I y :* ys -> (y, ys))  -- | A version of 'assembleDivAp' but for 'DivAp1' instead.  Can be -- useful if you intend on interpreting it into something with only@@ -261,17 +270,19 @@ -- -- If each component is itself a @'DivAp1' f@ (instead of @f@), you can use -- 'concatInply'.-assembleDivAp1-    :: Invariant f-    => NP f (a ': as)-    -> DivAp1 f (NP I (a ': as))+assembleDivAp1 ::+  Invariant f =>+  NP f (a ': as) ->+  DivAp1 f (NP I (a ': as)) assembleDivAp1 (x :* xs) = DivAp1_ $ case xs of-    Nil    -> Done1 $ invmap ((:* Nil) . I) (unI . hd) x-    _ :* _ -> More1 $ Day-      x-      (unDivAp1 (assembleDivAp1 xs))-      (\y ys -> I y :* ys)-      (\case I y :* ys -> (y, ys))+  Nil -> Done1 $ invmap ((:* Nil) . I) (unI . hd) x+  _ :* _ ->+    More1 $+      Day+        x+        (unDivAp1 (assembleDivAp1 xs))+        (\y ys -> I y :* ys)+        (\case I y :* ys -> (y, ys))  -- | A version of 'assembleDivAp' using 'V.XRec' from /vinyl/ instead of -- 'NP' from /sop-core/.  This can be more convenient because it doesn't@@ -290,16 +301,19 @@ -- -- If each component is itself a @'DivAp' f@ (instead of @f@), you can use -- 'concatDivApRec'.-assembleDivApRec-    :: V.Rec f as-    -> DivAp f (V.XRec V.Identity as)+assembleDivApRec ::+  V.Rec f as ->+  DivAp f (V.XRec V.Identity as) assembleDivApRec = \case-    V.RNil    -> DivAp $ Done $ Identity V.RNil-    x V.:& xs -> DivAp $ More $ Day-      x-      (unDivAp (assembleDivApRec xs))-      (V.::&)-      unconsRec+  V.RNil -> DivAp $ Done $ Identity V.RNil+  x V.:& xs ->+    DivAp $+      More $+        Day+          x+          (unDivAp (assembleDivApRec xs))+          (V.::&)+          unconsRec  -- | A version of 'assembleDivAp1' using 'V.XRec' from /vinyl/ instead of -- 'NP' from /sop-core/.  This can be more convenient because it doesn't@@ -307,25 +321,28 @@ -- -- If each component is itself a @'DivAp1' f@ (instead of @f@), you can use -- 'concatDivAp1Rec'.-assembleDivAp1Rec-    :: Invariant f-    => V.Rec f (a ': as)-    -> DivAp1 f (V.XRec V.Identity (a ': as))+assembleDivAp1Rec ::+  Invariant f =>+  V.Rec f (a ': as) ->+  DivAp1 f (V.XRec V.Identity (a ': as)) assembleDivAp1Rec (x V.:& xs) = case xs of-    V.RNil   -> DivAp1_ $ Done1 $ invmap (V.::& V.RNil) (\case z V.::& _ -> z) x-    _ V.:& _ -> DivAp1_ $ More1 $ Day-      x-      (unDivAp1 (assembleDivAp1Rec xs))-      (V.::&)-      unconsRec+  V.RNil -> DivAp1_ $ Done1 $ invmap (V.::& V.RNil) (\case z V.::& _ -> z) x+  _ V.:& _ ->+    DivAp1_ $+      More1 $+        Day+          x+          (unDivAp1 (assembleDivAp1Rec xs))+          (V.::&)+          unconsRec  unconsRec :: V.XRec V.Identity (a ': as) -> (a, V.XRec V.Identity as) unconsRec (y V.::& ys) = (y, ys)  -- | A free 'Inply' instance Inply f => Interpret DivAp1 f where-    interpret f (DivAp1_ x) = foldChain1 f (runDay f id) x+  interpret f (DivAp1_ x) = foldChain1 f (runDay f id) x  -- | A free 'Inplicative' instance Inplicative f => Interpret DivAp f where-    interpret f (DivAp x) = foldChain (knot . runIdentity) (runDay f id) x+  interpret f (DivAp x) = foldChain (knot . runIdentity) (runDay f id) x

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP         #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingVia #-}  -- |@@ -17,48 +17,49 @@ -- @since 0.4.0.0 module Data.Functor.Invariant.Internative (   -- * Typeclass-    Inalt(..)-  , Inplus(..)-  , Internative+  Inalt (..),+  Inplus (..),+  Internative,+   -- * Assembling Helpers-  , swervedN-  , swervedNMap-  , swervedN1-  , swervedN1Map-  ) where+  swervedN,+  swervedNMap,+  swervedN1,+  swervedN1Map,+) where -import           Control.Applicative-import           Control.Applicative.Backwards        (Backwards(..))-import           Control.Arrow                        (ArrowPlus)-import           Control.Monad-import           Control.Monad.Trans.Identity         (IdentityT(..))-import           Data.Functor.Alt-import           Data.Functor.Contravariant-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divise-import           Data.Functor.Contravariant.Divisible-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Inplicative-import           Data.Functor.Plus-import           Data.Functor.Product                 (Product(..))-import           Data.Functor.Reverse                 (Reverse(..))-import           Data.Hashable                        (Hashable)-import           Data.Kind-import           Data.List.NonEmpty                   (NonEmpty)-import           Data.SOP hiding                      (hmap)-import           Data.Sequence                        (Seq)-import           Data.StateVar                        (SettableStateVar)-import           Data.Void-import qualified Data.HashMap.Lazy                    as HM-import qualified Data.IntMap                          as IM-import qualified Data.IntMap.NonEmpty                 as NEIM-import qualified Data.Map                             as M-import qualified Data.Map.NonEmpty                    as NEM-import qualified Data.Monoid                          as Monoid-import qualified Data.Semigroup                       as Semigroup-import qualified Data.Sequence.NonEmpty               as NESeq-import qualified GHC.Generics                         as Generics+import Control.Applicative+import Control.Applicative.Backwards (Backwards (..))+import Control.Arrow (ArrowPlus)+import Control.Monad+import Control.Monad.Trans.Identity (IdentityT (..))+import Data.Functor.Alt+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divise+import Data.Functor.Contravariant.Divisible+import Data.Functor.Invariant+import Data.Functor.Invariant.Inplicative+import Data.Functor.Plus+import Data.Functor.Product (Product (..))+import Data.Functor.Reverse (Reverse (..))+import qualified Data.HashMap.Lazy as HM+import Data.Hashable (Hashable)+import qualified Data.IntMap as IM+import qualified Data.IntMap.NonEmpty as NEIM+import Data.Kind+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Map as M+import qualified Data.Map.NonEmpty as NEM+import qualified Data.Monoid as Monoid+import Data.SOP hiding (hmap)+import qualified Data.Semigroup as Semigroup+import Data.Sequence (Seq)+import qualified Data.Sequence.NonEmpty as NESeq+import Data.StateVar (SettableStateVar)+import Data.Void+import qualified GHC.Generics as Generics  -- | The invariant counterpart of 'Alt' and 'Decide'. --@@ -81,43 +82,45 @@ -- -- @since 0.4.0.0 class Invariant f => Inalt f where-    -- | Like '<!>', 'decide', or 'choose', but requires both-    -- an injecting and a choosing function.-    ---    -- It is used to merge @f b@ (producer and consumer of @b@) and @f c@-    -- (producer and consumer of @c@) into a @f a@ in an either-or manner.-    -- You can think of it as, for the @f a@, it "chooses" if the @a@ is-    -- actually a @b@ or a @c@ with the @a -> 'Either' b c@, feeds it to-    -- either the original @f b@ or the original @f c@, and then re-injects-    -- the output back into a @a@ with the @b -> a@ or the @c -> a@.-    ---    -- An important property is that it will only ever use exactly @one@ of-    -- the options given in order to fulfil its job.  If you swerve an @f-    -- a@ and an @f b@ into an @f c@, in order to consume/produdce the @c@,-    -- it will only use either the @f a@ or the @f b@ -- exactly one of-    -- them.-    ---    -- @since 0.4.0.0-    swerve-        :: (b -> a)-        -> (c -> a)-        -> (a -> Either b c)-        -> f b-        -> f c-        -> f a-    swerve f g h x y = invmap (either f g) h (swerved x y)-    -- | A simplified version of 'swerive' that splits to and from an-    -- 'Either'. You can then use 'invmap' to reshape it into the proper-    -- shape.-    ---    -- @since 0.4.0.0-    swerved-        :: f a-        -> f b-        -> f (Either a b)-    swerved = swerve Left Right id-    {-# MINIMAL swerve | swerved #-}+  -- | Like '<!>', 'decide', or 'choose', but requires both+  -- an injecting and a choosing function.+  --+  -- It is used to merge @f b@ (producer and consumer of @b@) and @f c@+  -- (producer and consumer of @c@) into a @f a@ in an either-or manner.+  -- You can think of it as, for the @f a@, it "chooses" if the @a@ is+  -- actually a @b@ or a @c@ with the @a -> 'Either' b c@, feeds it to+  -- either the original @f b@ or the original @f c@, and then re-injects+  -- the output back into a @a@ with the @b -> a@ or the @c -> a@.+  --+  -- An important property is that it will only ever use exactly @one@ of+  -- the options given in order to fulfil its job.  If you swerve an @f+  -- a@ and an @f b@ into an @f c@, in order to consume/produdce the @c@,+  -- it will only use either the @f a@ or the @f b@ -- exactly one of+  -- them.+  --+  -- @since 0.4.0.0+  swerve ::+    (b -> a) ->+    (c -> a) ->+    (a -> Either b c) ->+    f b ->+    f c ->+    f a+  swerve f g h x y = invmap (either f g) h (swerved x y) +  -- | A simplified version of 'swerive' that splits to and from an+  -- 'Either'. You can then use 'invmap' to reshape it into the proper+  -- shape.+  --+  -- @since 0.4.0.0+  swerved ::+    f a ->+    f b ->+    f (Either a b)+  swerved = swerve Left Right id++  {-# MINIMAL swerve | swerved #-}+ -- | The invariant counterpart of 'Alt' and 'Conclude'. -- -- The main important action is described in 'Inalt', but this adds 'reject',@@ -131,7 +134,7 @@  -- @since 0.4.0.0 class Inalt f => Inplus f where-    reject :: (a -> Void) -> f a+  reject :: (a -> Void) -> f a  -- | The invariant counterpart to 'Alternative' and 'Decidable': represents -- a combination of both 'Applicative' and 'Alt', or 'Divisible' and@@ -142,138 +145,176 @@  -- | Ignores the contravariant part of 'swerve' instance Alt f => Inalt (WrappedFunctor f) where-    swerved (WrapFunctor x) (WrapFunctor y) = WrapFunctor $-        (Left <$> x) <!> (Right <$> y)+  swerved (WrapFunctor x) (WrapFunctor y) =+    WrapFunctor $+      (Left <$> x) <!> (Right <$> y)+ -- | @'reject' _ = 'zero'@ instance Plus f => Inplus (WrappedFunctor f) where-    reject _ = WrapFunctor zero+  reject _ = WrapFunctor zero+ instance (Alternative f, Plus f, Apply f) => Internative (WrappedFunctor f)  -- | Ignores the covariant part of 'gather' instance Decide f => Inalt (WrappedContravariant f) where-    swerve _ _ h (WrapContravariant x) (WrapContravariant y) = WrapContravariant (decide h x y)+  swerve _ _ h (WrapContravariant x) (WrapContravariant y) = WrapContravariant (decide h x y)+ -- | @'reject' = 'conclude'@ instance Conclude f => Inplus (WrappedContravariant f) where-    reject f = WrapContravariant (conclude f)+  reject f = WrapContravariant (conclude f)+ instance (Conclude f, Divisible f, Divise f) => Internative (WrappedContravariant f)  -- | Ignores the covariant part of 'gather' instance Decide f => Inalt (WrappedDivisible f) where-    swerve _ _ h (WrapDivisible x) (WrapDivisible y) = WrapDivisible (decide h x y)+  swerve _ _ h (WrapDivisible x) (WrapDivisible y) = WrapDivisible (decide h x y)+ -- | @'reject' = 'conclude'@ instance Conclude f => Inplus (WrappedDivisible f) where-    reject f = WrapDivisible (conclude f)+  reject f = WrapDivisible (conclude f)+ instance (Conclude f, Divisible f, Divise f) => Internative (WrappedDivisible f)  -- | Ignores the covariant part of 'gather' instance (Decidable f, Invariant f) => Inalt (WrappedDivisibleOnly f) where-    swerve _ _ h (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (choose h x y)+  swerve _ _ h (WrapDivisibleOnly x) (WrapDivisibleOnly y) = WrapDivisibleOnly (choose h x y)+ -- | @'reject' = 'lose'@ instance (Decidable f, Invariant f) => Inplus (WrappedDivisibleOnly f) where-    reject f = WrapDivisibleOnly (lose f)+  reject f = WrapDivisibleOnly (lose f)+ instance (Decidable f, Invariant f) => Internative (WrappedDivisibleOnly f)  -- | @since 0.4.1.0 deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inalt Proxy+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Proxy :: Type -> Type) instance Inplus Proxy+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Proxy :: Type -> Type) instance Internative Proxy+ -- | @since 0.4.1.0 deriving via WrappedFunctor [] instance Inalt []+ -- | @since 0.4.1.0 deriving via WrappedFunctor [] instance Inplus []+ -- | @since 0.4.1.0 deriving via WrappedFunctor [] instance Internative []+ -- | @since 0.4.1.0 deriving via WrappedFunctor Maybe instance Inalt Maybe+ -- | @since 0.4.1.0 deriving via WrappedFunctor Maybe instance Inplus Maybe+ -- | @since 0.4.1.0 deriving via WrappedFunctor Maybe instance Internative Maybe+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Either e) instance Inalt (Either e)+ -- | @since 0.4.1.0 deriving via WrappedFunctor IO instance Inalt IO+ -- | @since 0.4.1.0 deriving via WrappedFunctor IO instance Inplus IO+ -- | @since 0.4.1.0 deriving via WrappedFunctor IO instance Internative IO  -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inalt Generics.U1+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Inplus Generics.U1+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.U1 :: Type -> Type) instance Internative Generics.U1  -- | @since 0.4.1.0 instance Inalt f => Inalt (Generics.M1 i t f) where-    swerve f g h (Generics.M1 x) (Generics.M1 y) = Generics.M1 (swerve f g h x y)+  swerve f g h (Generics.M1 x) (Generics.M1 y) = Generics.M1 (swerve f g h x y)+ -- | @since 0.4.1.0 instance Inplus f => Inplus (Generics.M1 i t f) where-    reject = Generics.M1 . reject+  reject = Generics.M1 . reject+ -- | @since 0.4.1.0 instance Internative f => Internative (Generics.M1 i t f)  -- | @since 0.4.1.0 instance (Inalt f, Inalt g) => Inalt (f Generics.:*: g) where-    swerve f g h (x1 Generics.:*: y1) (x2 Generics.:*: y2) =-        swerve f g h x1 x2 Generics.:*: swerve f g h y1 y2+  swerve f g h (x1 Generics.:*: y1) (x2 Generics.:*: y2) =+    swerve f g h x1 x2 Generics.:*: swerve f g h y1 y2+ -- | @since 0.4.1.0 instance (Inplus f, Inplus g) => Inplus (f Generics.:*: g) where-    reject f = reject f Generics.:*: reject f+  reject f = reject f Generics.:*: reject f+ -- | @since 0.4.1.0 instance (Internative f, Internative g) => Internative (f Generics.:*: g)  -- | @since 0.4.1.0 instance (Inalt f, Inalt g) => Inalt (Product f g) where-    swerve f g h (Pair x1 y1) (Pair x2 y2) =-        swerve f g h x1 x2 `Pair` swerve f g h y1 y2+  swerve f g h (Pair x1 y1) (Pair x2 y2) =+    swerve f g h x1 x2 `Pair` swerve f g h y1 y2+ -- | @since 0.4.1.0 instance (Inplus f, Inplus g) => Inplus (Product f g) where-    reject f = reject f `Pair` reject f+  reject f = reject f `Pair` reject f+ -- | @since 0.4.1.0 instance (Internative f, Internative g) => Internative (Product f g)  -- | @since 0.4.1.0 instance Inalt f => Inalt (Generics.Rec1 f) where-    swerve f g h (Generics.Rec1 x) (Generics.Rec1 y) = Generics.Rec1 (swerve f g h x y)+  swerve f g h (Generics.Rec1 x) (Generics.Rec1 y) = Generics.Rec1 (swerve f g h x y)+ -- | @since 0.4.1.0 instance Inplus f => Inplus (Generics.Rec1 f) where-    reject = Generics.Rec1 . reject+  reject = Generics.Rec1 . reject+ -- | @since 0.4.1.0 instance Internative f => Internative (Generics.Rec1 f)  -- | @since 0.4.1.0 instance Inalt f => Inalt (IdentityT f) where-    swerve f g h (IdentityT x) (IdentityT y) = IdentityT (swerve f g h x y)+  swerve f g h (IdentityT x) (IdentityT y) = IdentityT (swerve f g h x y)+ -- | @since 0.4.1.0 instance Inplus f => Inplus (IdentityT f) where-    reject = IdentityT . reject+  reject = IdentityT . reject+ -- | @since 0.4.1.0-instance Internative f => Internative (IdentityT f) where+instance Internative f => Internative (IdentityT f)  -- | @since 0.4.1.0 instance Inalt f => Inalt (Reverse f) where-    swerve f g h (Reverse x) (Reverse y) = Reverse (swerve f g h x y)+  swerve f g h (Reverse x) (Reverse y) = Reverse (swerve f g h x y)+ -- | @since 0.4.1.0 instance Inplus f => Inplus (Reverse f) where-    reject = Reverse . reject+  reject = Reverse . reject+ -- | @since 0.4.1.0-instance Internative f => Internative (Reverse f) where+instance Internative f => Internative (Reverse f)  -- | @since 0.4.1.0 instance Inalt f => Inalt (Backwards f) where-    swerve f g h (Backwards x) (Backwards y) = Backwards (swerve f g h x y)+  swerve f g h (Backwards x) (Backwards y) = Backwards (swerve f g h x y)+ -- | @since 0.4.1.0 instance Inplus f => Inplus (Backwards f) where-    reject = Backwards . reject+  reject = Backwards . reject+ -- | @since 0.4.1.0-instance Internative f => Internative (Backwards f) where+instance Internative f => Internative (Backwards f)  -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.First instance Inalt Semigroup.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Semigroup.Last instance Inalt Semigroup.Last @@ -288,40 +329,61 @@  -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.First instance Inalt Monoid.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.First instance Inplus Monoid.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.First instance Internative Monoid.First+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Last instance Inalt Monoid.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Last instance Inplus Monoid.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor Monoid.Last instance Internative Monoid.Last+ -- | @since 0.4.1.0 deriving via WrappedFunctor NonEmpty instance Inalt NonEmpty+ -- | @since 0.4.1.0 deriving via WrappedFunctor Seq instance Inalt Seq+ -- | @since 0.4.1.0 deriving via WrappedFunctor Seq instance Inplus Seq+ -- | @since 0.4.1.0 deriving via WrappedFunctor Seq instance Internative Seq+ -- | @since 0.4.1.0 deriving via WrappedFunctor NESeq.NESeq instance Inalt NESeq.NESeq+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedArrow a b) instance ArrowPlus a => Inalt (WrappedArrow a b)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedArrow a b) instance ArrowPlus a => Inplus (WrappedArrow a b)+ -- | @since 0.4.1.0-deriving via WrappedFunctor (WrappedArrow a b) instance ArrowPlus a => Internative (WrappedArrow a b)+deriving via+  WrappedFunctor (WrappedArrow a b)+  instance+    ArrowPlus a => Internative (WrappedArrow a b)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (Generics.V1 :: Type -> Type) instance Inalt Generics.V1+ -- | @since 0.4.1.0 deriving via WrappedFunctor IM.IntMap instance Inalt IM.IntMap+ -- | @since 0.4.1.0 deriving via WrappedFunctor NEIM.NEIntMap instance Inalt NEIM.NEIntMap+ -- | @since 0.4.1.0 deriving via WrappedFunctor (M.Map k) instance Ord k => Inalt (M.Map k)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (NEM.NEMap k) instance Ord k => Inalt (NEM.NEMap k) @@ -336,44 +398,58 @@  -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Inalt (WrappedMonad m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Inplus (WrappedMonad m)+ -- | @since 0.4.1.0 deriving via WrappedFunctor (WrappedMonad m) instance MonadPlus m => Internative (WrappedMonad m)  -- | @since 0.4.1.0 deriving via WrappedDivisible SettableStateVar instance Inalt SettableStateVar+ -- | @since 0.4.1.0 deriving via WrappedDivisible SettableStateVar instance Inplus SettableStateVar+ -- | @since 0.4.1.0 deriving via WrappedDivisible SettableStateVar instance Internative SettableStateVar+ -- | @since 0.4.1.0 deriving via WrappedDivisible Predicate instance Inalt Predicate+ -- | @since 0.4.1.0 deriving via WrappedDivisible Predicate instance Inplus Predicate+ -- | @since 0.4.1.0 deriving via WrappedDivisible Predicate instance Internative Predicate+ -- | @since 0.4.1.0 deriving via WrappedDivisible Comparison instance Inalt Comparison+ -- | @since 0.4.1.0 deriving via WrappedDivisible Comparison instance Inplus Comparison+ -- | @since 0.4.1.0 deriving via WrappedDivisible Comparison instance Internative Comparison+ -- | @since 0.4.1.0 deriving via WrappedDivisible Equivalence instance Inalt Equivalence+ -- | @since 0.4.1.0 deriving via WrappedDivisible Equivalence instance Inplus Equivalence+ -- | @since 0.4.1.0 deriving via WrappedDivisible Equivalence instance Internative Equivalence+ -- | @since 0.4.1.0 deriving via WrappedDivisible (Op r) instance Inalt (Op r)+ -- | @since 0.4.1.0 deriving via WrappedDivisible (Op r) instance Inplus (Op r)+ -- | @since 0.4.1.0 deriving via WrappedDivisible (Op r) instance Monoid r => Internative (Op r) -- -- | Convenient wrapper to build up an 'Inplus' instance on by providing -- each branch of it.  This makes it much easier to build up longer chains -- because you would only need to write the splitting/joining functions in@@ -408,13 +484,14 @@ --      otherwise you'd need to manually peel off eithers one-by-one. -- -- @since 0.4.1.0-swervedN-    :: Inplus f-    => NP f as-    -> f (NS I as)+swervedN ::+  Inplus f =>+  NP f as ->+  f (NS I as) swervedN = \case-    Nil     -> reject $ \case {}-    x :* xs -> swerve+  Nil -> reject $ \case {}+  x :* xs ->+    swerve       (Z . I)       S       (\case Z (I y) -> Left y; S ys -> Right ys)@@ -457,25 +534,26 @@ -- See notes on 'swervedNMap' for more details and caveats. -- -- @since 0.4.1.0-swervedNMap-    :: Inplus f-    => (NS I as -> b)-    -> (b -> NS I as)-    -> NP f as-    -> f b+swervedNMap ::+  Inplus f =>+  (NS I as -> b) ->+  (b -> NS I as) ->+  NP f as ->+  f b swervedNMap f g = invmap f g . swervedN  -- | A version of 'swervedN' for non-empty 'NP', but only -- requiring an 'Inalt' instance. -- -- @since 0.4.1.0-swervedN1-    :: Inalt f-    => NP f (a ': as)-    -> f (NS I (a ': as))+swervedN1 ::+  Inalt f =>+  NP f (a ': as) ->+  f (NS I (a ': as)) swervedN1 (x :* xs) = case xs of-    Nil    -> invmap (Z . I) (\case Z (I y) -> y; S ys -> case ys of {}) x-    _ :* _ -> swerve+  Nil -> invmap (Z . I) (\case Z (I y) -> y; S ys -> case ys of {}) x+  _ :* _ ->+    swerve       (Z . I)       S       (\case Z (I y) -> Left y; S ys -> Right ys)@@ -486,11 +564,10 @@ -- requiring an 'Inalt' instance. -- -- @since 0.4.1.0-swervedN1Map-    :: Inalt f-    => (NS I (a ': as) -> b)-    -> (b -> NS I (a ': as))-    -> NP f (a ': as)-    -> f b+swervedN1Map ::+  Inalt f =>+  (NS I (a ': as) -> b) ->+  (b -> NS I (a ': as)) ->+  NP f (a ': as) ->+  f b swervedN1Map f g = invmap f g . swervedN1-

@@ -2,7 +2,7 @@  -- | -- Module      : Data.Functor.Invariant.Internative.Free--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -17,46 +17,46 @@ -- @since 0.4.0.0 module Data.Functor.Invariant.Internative.Free (   -- * Chain-    DecAlt(.., Swerve, Reject)-  , runCoDecAlt-  , runContraDecAlt-  , decAltListF-  , decAltListF_-  , decAltDec-  , foldDecAlt-  , assembleDecAlt-  -- * Nonempty Chain-  , DecAlt1(.., DecAlt1)-  , runCoDecAlt1-  , runContraDecAlt1-  , decAltNonEmptyF-  , decAltNonEmptyF_-  , decAltDec1-  , foldDecAlt1-  , assembleDecAlt1-  ) where+  DecAlt (.., Swerve, Reject),+  runCoDecAlt,+  runContraDecAlt,+  decAltListF,+  decAltListF_,+  decAltDec,+  foldDecAlt,+  assembleDecAlt, -import           Control.Applicative.ListF-import           Control.Natural-import           Data.Coerce-import           Data.Functor.Alt-import           Data.Functor.Contravariant.Conclude-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Divisible.Free-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Internative-import           Data.Functor.Invariant.Night-import           Data.Functor.Plus-import           Data.HBifunctor.Tensor hiding             (elim1, elim2, intro1, intro2)-import           Data.HFunctor-import           Data.HFunctor.Chain-import           Data.HFunctor.Chain.Internal-import           Data.SOP hiding (hmap)-import           Data.Void-import qualified Control.Monad.Trans.Compose               as CT-import qualified Data.Functor.Coyoneda                     as CY-import qualified Data.List.NonEmpty                        as NE+  -- * Nonempty Chain+  DecAlt1 (.., DecAlt1),+  runCoDecAlt1,+  runContraDecAlt1,+  decAltNonEmptyF,+  decAltNonEmptyF_,+  decAltDec1,+  foldDecAlt1,+  assembleDecAlt1,+) where +import Control.Applicative.ListF+import qualified Control.Monad.Trans.Compose as CT+import Control.Natural+import Data.Coerce+import Data.Functor.Alt+import Data.Functor.Contravariant.Conclude+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Divisible.Free+import qualified Data.Functor.Coyoneda as CY+import Data.Functor.Invariant+import Data.Functor.Invariant.Internative+import Data.Functor.Invariant.Night+import Data.Functor.Plus+import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)+import Data.HFunctor+import Data.HFunctor.Chain+import Data.HFunctor.Chain.Internal+import qualified Data.List.NonEmpty as NE+import Data.SOP hiding (hmap)+import Data.Void  -- | In the covariant direction, we can interpret into any 'Alt'. --@@ -65,10 +65,11 @@ -- of 'Inalt'.  However, this can be handy if you are using an instance of -- 'Alt' that has no 'Inalt' instance.  Consider also 'unsafeInaltCo' if -- you are using a specific, concrete type for @g@.-runCoDecAlt1-    :: forall f g. Alt g-    => f ~> g-    -> DecAlt1 f ~> g+runCoDecAlt1 ::+  forall f g.+  Alt g =>+  f ~> g ->+  DecAlt1 f ~> g runCoDecAlt1 f = foldDecAlt1 f (runNightAlt f id)  -- | In the contravariant direction, we can interpret into any 'Decide'.@@ -78,10 +79,11 @@ -- of 'Inalt'.  However, this can be handy if you are using an instance of -- 'Decide' that has no 'Inalt' instance.  Consider also -- 'unsafeInaltContra' if you are using a specific, concrete type for @g@.-runContraDecAlt1-    :: forall f g. Decide g-    => f ~> g-    -> DecAlt1 f ~> g+runContraDecAlt1 ::+  forall f g.+  Decide g =>+  f ~> g ->+  DecAlt1 f ~> g runContraDecAlt1 f = foldDecAlt1 f (runNightDecide f id)  -- | Extract the 'Dec' part out of a 'DecAlt', shedding the@@ -101,10 +103,11 @@ -- of 'Inplus'.  However, this can be handy if you are using an instance of -- 'Plus' that has no 'Inplus' instance.  Consider also 'unsafeInplusCo' if -- you are using a specific, concrete type for @g@.-runCoDecAlt-    :: forall f g. Plus g-    => f ~> g-    -> DecAlt f ~> g+runCoDecAlt ::+  forall f g.+  Plus g =>+  f ~> g ->+  DecAlt f ~> g runCoDecAlt f = foldDecAlt (const zero) (runNightAlt f id)  -- | In the contravariant direction, we can interpret into any 'Decide'.@@ -114,10 +117,11 @@ -- instance of 'Inplus'.  However, this can be handy if you are using an -- instance of 'Conclude' that has no 'Inplus' instance.  Consider also -- 'unsafeInplusContra' if you are using a specific, concrete type for @g@.-runContraDecAlt-    :: forall f g. Conclude g-    => f ~> g-    -> DecAlt f ~> g+runContraDecAlt ::+  forall f g.+  Conclude g =>+  f ~> g ->+  DecAlt f ~> g runContraDecAlt f = foldDecAlt conclude (runNightDecide f id)  -- | Extract the 'ListF' part out of a 'DecAlt', shedding the@@ -137,7 +141,8 @@ -- @since 0.3.2.0 decAltListF_ :: DecAlt f ~> CT.ComposeT ListF CY.Coyoneda f decAltListF_ = foldDecAlt (const (CT.ComposeT (ListF []))) $ \case-    Night x (CT.ComposeT (ListF xs)) f g _ -> CT.ComposeT . ListF $+  Night x (CT.ComposeT (ListF xs)) f g _ ->+    CT.ComposeT . ListF $       CY.Coyoneda f x : (map . fmap) g xs  -- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the@@ -157,7 +162,8 @@ -- @since 0.3.2.0 decAltNonEmptyF_ :: DecAlt1 f ~> CT.ComposeT NonEmptyF CY.Coyoneda f decAltNonEmptyF_ = foldDecAlt1 inject $ \case-    Night x (CT.ComposeT (NonEmptyF xs)) f g _ -> CT.ComposeT . NonEmptyF $+  Night x (CT.ComposeT (NonEmptyF xs)) f g _ ->+    CT.ComposeT . NonEmptyF $       CY.Coyoneda f x NE.<| (fmap . fmap) g xs  -- | General-purpose folder of 'DecAlt'.  Provide a way to handle the@@ -165,20 +171,20 @@ -- ('<!>'/'decide'/'swerve'). -- -- @since 0.3.5.0-foldDecAlt-    :: (forall x. (x -> Void) -> g x)-    -> (Night f g ~> g)-    -> DecAlt f ~> g+foldDecAlt ::+  (forall x. (x -> Void) -> g x) ->+  (Night f g ~> g) ->+  DecAlt f ~> g foldDecAlt f g = foldChain (f . refute) g . unDecAlt  -- | General-purpose folder of 'DecAlt1'.  Provide a way to handle the -- individual leaves and a way to handle a cons ('<!>'/'decide'/'swerve'). -- -- @since 0.3.5.0-foldDecAlt1-    :: (f ~> g)-    -> (Night f g ~> g)-    -> DecAlt1 f ~> g+foldDecAlt1 ::+  (f ~> g) ->+  (Night f g ~> g) ->+  DecAlt1 f ~> g foldDecAlt1 f g = foldChain1 f g . unDecAlt1  -- | Match on a non-empty 'DecAlt'; contains the splitting function,@@ -186,40 +192,42 @@ -- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Choose' -- constructor. pattern Swerve :: (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt f a-pattern Swerve f g h x xs <- (unSwerve_->MaybeF (Just (Night x xs f g h)))+pattern Swerve f g h x xs <- (unSwerve_ -> MaybeF (Just (Night x xs f g h)))   where     Swerve f g h x xs = DecAlt $ More $ Night x (unDecAlt xs) f g h  unSwerve_ :: DecAlt f ~> MaybeF (Night f (DecAlt f)) unSwerve_ = \case   DecAlt (More (Night x xs g f h)) -> MaybeF . Just $ Night x (DecAlt xs) g f h-  DecAlt (Done _                 ) -> MaybeF Nothing-+  DecAlt (Done _) -> MaybeF Nothing  -- | Match on an "empty" 'DecAlt'; contains no @f@s, but only the -- terminal value.  Analogous to the -- 'Data.Functor.Contravariant.Divisible.Free.Lose' constructor. pattern Reject :: (a -> Void) -> DecAlt f a pattern Reject x = DecAlt (Done (Not x))+ {-# COMPLETE Swerve, Reject #-}  instance Inalt (DecAlt f) where-    swerve = coerce (swerve @(Chain Night Not _))+  swerve = coerce (swerve @(Chain Night Not _))  instance Inplus (DecAlt f) where-    reject = coerce (reject @(Chain Night Not _))+  reject = coerce (reject @(Chain Night Not _))  -- | Match on a 'DecAlt1' to get the head and the rest of the items. -- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Dec1' -- constructor.-pattern DecAlt1 :: Invariant f => (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt1 f a-pattern DecAlt1 f g h x xs <- (coerce splitChain1->Night x xs f g h)+pattern DecAlt1 ::+  Invariant f => (b -> a) -> (c -> a) -> (a -> Either b c) -> f b -> DecAlt f c -> DecAlt1 f a+pattern DecAlt1 f g h x xs <- (coerce splitChain1 -> Night x xs f g h)   where     DecAlt1 f g h x xs = unsplitNE $ Night x xs f g h+ {-# COMPLETE DecAlt1 #-}  instance Invariant f => Inalt (DecAlt1 f) where-    swerve = coerce (swerve @(Chain1 Night _))+  swerve = coerce (swerve @(Chain1 Night _))  -- | Convenient wrapper to build up a 'DecAlt' on by providing each -- branch of it.  This makes it much easier to build up longer chains@@ -255,17 +263,20 @@ -- -- If each component is itself a @'DecAlt' f@ (instead of @f@), you can use -- 'concatInplus'.-assembleDecAlt-    :: NP f as-    -> DecAlt f (NS I as)+assembleDecAlt ::+  NP f as ->+  DecAlt f (NS I as) assembleDecAlt = \case-    Nil     -> DecAlt $ Done $ Not (\case {})-    x :* xs -> DecAlt $ More $ Night-      x-      (unDecAlt $ assembleDecAlt xs)-      (Z . I)-      S-      (\case Z (I y) -> Left y; S ys -> Right ys)+  Nil -> DecAlt $ Done $ Not (\case {})+  x :* xs ->+    DecAlt $+      More $+        Night+          x+          (unDecAlt $ assembleDecAlt xs)+          (Z . I)+          S+          (\case Z (I y) -> Left y; S ys -> Right ys)  -- | A version of 'assembleDecAlt' but for 'DecAlt1' instead.  Can -- be useful if you intend on interpreting it into something with only@@ -275,15 +286,17 @@ -- -- If each component is itself a @'DecAlt1' f@ (instead of @f@), you can -- use 'concatInalt'.-assembleDecAlt1-    :: Invariant f-    => NP f (a ': as)-    -> DecAlt1 f (NS I (a ': as))+assembleDecAlt1 ::+  Invariant f =>+  NP f (a ': as) ->+  DecAlt1 f (NS I (a ': as)) assembleDecAlt1 (x :* xs) = DecAlt1_ $ case xs of-    Nil    -> Done1 $ invmap (Z . I) (unI . unZ) x-    _ :* _ -> More1 $ Night-      x-      (unDecAlt1 $ assembleDecAlt1 xs)-      (Z . I)-      S-      (\case Z (I y) -> Left y; S ys -> Right ys)+  Nil -> Done1 $ invmap (Z . I) (unI . unZ) x+  _ :* _ ->+    More1 $+      Night+        x+        (unDecAlt1 $ assembleDecAlt1 xs)+        (Z . I)+        S+        (\case Z (I y) -> Left y; S ys -> Right ys)

@@ -1,7 +1,6 @@- -- | -- Module      : Data.Functor.Invariant.Night--- Copyright   : (c) Justin Le 2019+-- Copyright   : (c) Justin Le 2025 -- License     : BSD3 -- -- Maintainer  : justin@jle.im@@ -12,37 +11,42 @@ -- -- @since 0.3.0.0 module Data.Functor.Invariant.Night (-    Night(..)-  , Not(..), refuted-  , night-  , runNight-  , nerve-  , runNightAlt-  , runNightDecide-  , toCoNight-  , toCoNight_-  , toContraNight-  , assoc, unassoc-  , intro1, intro2-  , elim1, elim2-  , swapped-  , trans1, trans2-  ) where+  Night (..),+  Not (..),+  refuted,+  night,+  runNight,+  nerve,+  runNightAlt,+  runNightDecide,+  toCoNight,+  toCoNight_,+  toContraNight,+  assoc,+  unassoc,+  intro1,+  intro2,+  elim1,+  elim2,+  swapped,+  trans1,+  trans2,+) where -import           Control.Natural-import           Data.Bifunctor-import           Data.Functor.Alt-import           Data.Functor.Contravariant.Decide-import           Data.Functor.Contravariant.Night  (Not(..), refuted)-import           Data.Functor.Invariant-import           Data.Functor.Invariant.Internative-import           Data.Kind-import           Data.Void-import           GHC.Generics-import qualified Data.Bifunctor.Assoc              as B-import qualified Data.Bifunctor.Swap               as B-import qualified Data.Functor.Contravariant.Night  as CN-import qualified Data.Functor.Coyoneda             as CY+import Control.Natural+import Data.Bifunctor+import qualified Data.Bifunctor.Assoc as B+import qualified Data.Bifunctor.Swap as B+import Data.Functor.Alt+import Data.Functor.Contravariant.Decide+import Data.Functor.Contravariant.Night (Not (..), refuted)+import qualified Data.Functor.Contravariant.Night as CN+import qualified Data.Functor.Coyoneda as CY+import Data.Functor.Invariant+import Data.Functor.Invariant.Internative+import Data.Kind+import Data.Void+import GHC.Generics  -- | A pairing of invariant functors to create a new invariant functor that -- represents the "choice" between the two.@@ -64,15 +68,16 @@ -- about in Haskell (which uses @(,)@).  Therefore, it is an alternative to -- the typical 'Data.Functor.Day' convolution --- hence, the name 'Night'. data Night :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) where-    Night :: f b-          -> g c-          -> (b -> a)-          -> (c -> a)-          -> (a -> Either b c)-          -> Night f g a+  Night ::+    f b ->+    g c ->+    (b -> a) ->+    (c -> a) ->+    (a -> Either b c) ->+    Night f g a  instance Invariant (Night f g) where-    invmap f g (Night x y h j k) = Night x y (f . h) (f . j) (k . g)+  invmap f g (Night x y h j k) = Night x y (f . h) (f . j) (k . g)  -- | Pair two invariant actions together into a 'Night'; assigns the first -- one to 'Left' inputs and outputs and the second one to 'Right' inputs@@ -83,21 +88,23 @@ -- | Interpret the covariant part of a 'Night' into a target context @h@, -- as long as the context is an instance of 'Alt'.  The 'Alt' is used to -- combine results back together, chosen by '<!>'.-runNightAlt-    :: forall f g h. Alt h-    => f ~> h-    -> g ~> h-    -> Night f g ~> h+runNightAlt ::+  forall f g h.+  Alt h =>+  f ~> h ->+  g ~> h ->+  Night f g ~> h runNightAlt f g (Night x y h j _) = fmap h (f x) <!> fmap j (g y)  -- | Interpret the contravariant part of a 'Night' into a target context -- @h@, as long as the context is an instance of 'Decide'.  The 'Decide' is -- used to pick which part to feed the input to.-runNightDecide-    :: forall f g h. Decide h-    => f ~> h-    -> g ~> h-    -> Night f g ~> h+runNightDecide ::+  forall f g h.+  Decide h =>+  f ~> h ->+  g ~> h ->+  Night f g ~> h runNightDecide f g (Night x y _ _ k) = decide k (f x) (g y)  -- | Convert an invariant 'Night' into the covariant version, dropping the@@ -120,7 +127,6 @@ toCoNight_ :: Night f g ~> CY.Coyoneda f :*: CY.Coyoneda g toCoNight_ (Night x y f g _) = CY.Coyoneda f x :*: CY.Coyoneda g y - -- | Convert an invariant 'Night' into the contravariant version, dropping -- the covariant part. toContraNight :: Night f g ~> CN.Night f g@@ -130,40 +136,45 @@ -- two interpreting functions. -- -- @since 0.4.0.0-runNight-    :: Inalt h-    => (f ~> h)-    -> (g ~> h)-    -> Night f g ~> h+runNight ::+  Inalt h =>+  (f ~> h) ->+  (g ~> h) ->+  Night f g ~> h runNight f g (Night x y a b c) = swerve a b c (f x) (g y)  -- | Squash the two items in a 'Night' using their natural 'Inalt' -- instances. -- -- @since 0.4.0.0-nerve-    :: Inalt f-    => Night f f ~> f+nerve ::+  Inalt f =>+  Night f f ~> f nerve (Night x y a b c) = swerve a b c x y  -- | 'Night' is associative. assoc :: Night f (Night g h) ~> Night (Night f g) h assoc (Night x (Night y z f g h) j k l) =-    Night (Night x y Left Right id) z-      (either j (k . f))-      (k . g)-      (B.unassoc . second h . l)+  Night+    (Night x y Left Right id)+    z+    (either j (k . f))+    (k . g)+    (B.unassoc . second h . l)  -- | 'Night' is associative. unassoc :: Night (Night f g) h ~> Night f (Night g h) unassoc (Night (Night x y f g h) z j k l) =-    Night x (Night y z Left Right id)-      (j . f)-      (either (j . g) k)-      (B.assoc . first h . l)-      -- (k . g)-      -- (either (k . h) l)+  Night+    x+    (Night y z Left Right id)+    (j . f)+    (either (j . g) k)+    (B.assoc . first h . l) +-- (k . g)+-- (either (k . h) l)+ -- | The left identity of 'Night' is 'Not'; this is one side of that -- isomorphism. intro1 :: g ~> Night Not g@@ -195,4 +206,3 @@ -- | Hoist a function over the right side of a 'Night'. trans2 :: g ~> h -> Night f g ~> Night f h trans2 f (Night x y g h j) = Night x (f y) g h j-