functor-combinators 0.3.6.0 → 0.4.0.0

raw patch · 20 files changed

+1320/−898 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +39/−0
• functor-combinators.cabal +6/−4
• src/Data/Functor/Contravariant/Decide.hs +6/−7
• src/Data/Functor/Contravariant/Night.hs +10/−1
• src/Data/Functor/Invariant/DecAlt.hs +0/−354
• src/Data/Functor/Invariant/DivAp.hs +0/−422
• src/Data/Functor/Invariant/Inplicative.hs +224/−0
• src/Data/Functor/Invariant/Inplicative/Free.hs +332/−0
• src/Data/Functor/Invariant/Internative.hs +170/−0
• src/Data/Functor/Invariant/Internative/Free.hs +269/−0
• src/Data/Functor/Invariant/Night.hs +46/−21
• src/Data/HBifunctor/Associative.hs +16/−4
• src/Data/HBifunctor/Tensor.hs +15/−6
• src/Data/HBifunctor/Tensor/Internal.hs +1/−0
• src/Data/HFunctor/Chain.hs +30/−0
• src/Data/HFunctor/Chain/Internal.hs +60/−76
• src/Data/HFunctor/Final.hs +68/−0
• src/Data/HFunctor/HTraversable.hs +14/−2
• src/Data/HFunctor/Internal.hs +2/−1
• src/Data/HFunctor/Route.hs +12/−0

@@ -1,6 +1,45 @@ Changelog ========= +Version 0.4.0.0+---------------++*September 3, 2021*++<https://github.com/mstksg/functor-combinators/releases/tag/v0.4.0.0>++*   Finally add *Data.Functor.Invariant.Inplicative* and+    *Data.Functor.Internative*, with the typlecasses `Inply`, `Inplicative`,+    `Inalt`, `Inplus`, and `Internative`, the invariant versions of+    `Apply`/`Divise`, `Applicative`/`Divisible`, `Alt`/`Decide`,+    `Plus`/`Choose`, and `Alternative`/`Decidable`.+*   Move *Data.Functor.Invariant.DivAp* and *Data.Functor.Invariant.DecAlt* to+    *Data.Functor.Invariant.Inplicative.Free* and+    *Data.Functor.Invariant.Internative.Free*, respectively.++    Their specialized `gather`/`knot`/`swerve`/`reject` are now a part of the+    typeclasses.+*   `concatDivAp` family and `concatDecAlt` family of functions generalized to+    work for all *Inplicative* and *Inplus*, respectively, and moved to the+    modules for their respective typeclasses as `concatInplicative`,+    `concatInply`, `concatInplus`, and `concatInalt`.+*   Changed the order of arguments on `gather` and `swerve` to be consistent+    with the arguments of `invmap`, `Day`, and `Night`.+*   Changed the order of arguments in the `Gather`, and `Swerve` patterns to+    be more consistent with the new order of arguments for `gather`/`swerve`.+*   Changed the order of arguments in the `DivAp1` and `DecAlt1` patterns to+    be more consistent with the order of arguments for `Day` and `Night`.+*   Add `runDay` and `runNight` for invariant `Day` and `Night`, using the+    `Inply` and `Inalt` typeclasses, respectively. `runDay` is found in+    *Data.Functor.Invariant.Inplicative*, even though it should belong in+    *Data.Functor.Invariant.Day*, but that's in a different package.+*   Add `dather`, `necide`, and `nerve` to invariant `Day`, contravariant+    `Night`, invariant `Night`, in parallel to `dap` for covariant `Day`. Uses+    the `Inply`, `Divise`, and `Inalt` typeclasses, respectively. `dather` is+    found in *Data.Functor.Invariant.Inplicative*, even though it should+    belong in *Data.Functor.Invariant.Day*, but that's in a different package.+*   Add `hfor` and `hfor1` to *Data.HFunctor.HTraversable*.+ Version 0.3.6.0 --------------- 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9070db16766f843e9ffef9a8370e247bb1136ef2d5903a49c7411b5cb1227af7+-- hash: 8d3d33fe70d8907a40e1b80e5ac37a52e0bd94fcadf9ff26258211521fb5f22c  name:           functor-combinators-version:        0.3.6.0+version:        0.4.0.0 synopsis:       Tools for functor combinator-based program design description:    Tools for working with /functor combinators/: types that take functors (or                 other indexed types) and returns a new functor that "enhances" or "mixes"@@ -59,8 +59,10 @@       Data.Functor.Contravariant.Divise       Data.Functor.Contravariant.Divisible.Free       Data.Functor.Contravariant.Night-      Data.Functor.Invariant.DecAlt-      Data.Functor.Invariant.DivAp+      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

@@ -27,14 +27,7 @@ import Control.Monad.Trans.Identity import Control.Monad.Trans.List 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.Either import Data.Functor.Apply import Data.Functor.Compose@@ -43,6 +36,12 @@ 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(..))

@@ -15,7 +15,7 @@ module Data.Functor.Contravariant.Night (     Night(..)   , night-  , runNight+  , runNight, necide   , assoc, unassoc   , swapped   , trans1, trans2@@ -81,6 +81,15 @@     -> (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 (Night x y z) = decide z x y  -- | 'Night' is associative. assoc :: Night f (Night g h) ~> Night (Night f g) h

@@ -1,354 +0,0 @@---- |--- Module      : Data.Functor.Invariant.DecAlt--- Copyright   : (c) Justin Le 2019--- License     : BSD3------ Maintainer  : justin@jle.im--- Stability   : experimental--- Portability : non-portable------ Provide an invariant functor combinator choice-collector, like a combination of--- 'ListF' and 'Dec'.------ @since 0.3.5.0-module Data.Functor.Invariant.DecAlt (-  -- * Chain-    DecAlt(.., Swerve, Reject)-  , runCoDecAlt-  , runContraDecAlt-  , decAltListF-  , decAltListF_-  , decAltDec-  , foldDecAlt-  , swerve, swerved-  , assembleDecAlt-  , concatDecAlt-  -- * Nonempty Chain-  , DecAlt1(.., DecAlt1)-  , runCoDecAlt1-  , runContraDecAlt1-  , decAltNonEmptyF-  , decAltNonEmptyF_-  , decAltDec1-  , foldDecAlt1-  , swerve1, swerved1-  , assembleDecAlt1-  , concatDecAlt1-  ) where--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.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-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----- | In the covariant direction, we can interpret out of a 'Chain1' of 'Night'--- into any 'Alt'.-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 out of a 'Chain1' of--- 'Night' into any 'Decide'.-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--- covariant bits.-decAltDec :: DecAlt f ~> Dec f-decAltDec = runContraDecAlt inject---- | Extract the 'Dec1' part out of a 'DecAlt1', shedding the--- covariant bits.-decAltDec1 :: DecAlt1 f ~> Dec1 f-decAltDec1 = runContraDecAlt1 inject---- | In the covariant direction, we can interpret out of a 'Chain' of 'Night'--- into any 'Plus'.-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 out of a 'Chain' of--- 'Night' into any 'Conclude'.-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--- contravariant bits.------ @since 0.3.2.0-decAltListF :: Functor f => DecAlt f ~> ListF f-decAltListF = runCoDecAlt inject---- | Extract the 'ListF' part out of a 'DecAlt', shedding the--- contravariant bits.------ This version does not require a 'Functor' constraint because it converts--- to the coyoneda-wrapped product, which is more accurately the true--- conversion to a covariant chain.------ @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 $-      CY.Coyoneda f x : (map . fmap) g xs---- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the--- contravariant bits.------ @since 0.3.2.0-decAltNonEmptyF :: Functor f => DecAlt1 f ~> NonEmptyF f-decAltNonEmptyF = runCoDecAlt1 inject---- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the--- contravariant bits.------ This version does not require a 'Functor' constraint because it converts--- to the coyoneda-wrapped product, which is more accurately the true--- conversion to a covariant chain.------ @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 $-      CY.Coyoneda f x NE.<| (fmap . fmap) g xs---- | General-purpose folder of 'DecAlt'.  Provide a way to handle the--- identity ('empty'/'conclude'/'Reject') and a way to handle a cons--- ('<!>'/'decide'/'swerve').------ @since 0.3.5.0-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'/'swerve1').------ @since 0.3.5.0-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,--- the two rejoining functions, the first @f@, and the rest of the chain.--- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Choose'--- constructor.-pattern Swerve :: (a -> Either b c) -> (b -> a) -> (c -> a) -> f b -> DecAlt f c -> DecAlt f a-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----- | 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 #-}---- | 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 => (a -> Either b c) -> (b -> a) -> (c -> a) -> 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 #-}---- | Invariantly combine two 'DecAlt's.------ Analogous to '<|>' and 'decide'.  If there was some typeclass that--- represented semigroups on invariant 'Night', this would be the method of that--- typeclass.------ The identity of this is 'Reject'.------ @since 0.3.4.0-swerve-    :: (a -> Either b c)-    -> (b -> a)-    -> (c -> a)-    -> DecAlt f b-    -> DecAlt f c-    -> DecAlt f a-swerve f g h x y = coerce appendChain (Night x y f g h)---- | Convenient wrapper over 'swerve' that simply combines the two options--- in an 'Either'.  Analogous to '<|>' and 'decided'.------ @since 0.3.4.0-swerved-    :: DecAlt f a-    -> DecAlt f b-    -> DecAlt f (Either a b)-swerved = swerve id Left Right---- | Invariantly combine two 'DecAlt1's.------ Analogous to '<|>' and 'decide'.  If there was some typeclass that--- represented semigroups on invariant 'Night', this would be the method of that--- typeclass.------ @since 0.3.4.0-swerve1-    :: Invariant f-    => (a -> Either b c)-    -> (b -> a)-    -> (c -> a)-    -> DecAlt1 f b-    -> DecAlt1 f c-    -> DecAlt1 f a-swerve1 f g h x y = coerce appendChain1 (Night x y f g h)---- | Convenient wrapper over 'swerve1' that simply combines the two options--- in an 'Either'.  Analogous to '<|>' and 'decided'.------ @since 0.3.4.0-swerved1-    :: Invariant f-    => DecAlt1 f a-    -> DecAlt1 f b-    -> DecAlt1 f (Either a b)-swerved1 = swerve1 id Left Right---- | Convenient wrapper to build up a 'DecAlt' on 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 functions in--- one place.------ For example, if you had a data type------ @--- data MyType = MTI Int | MTB Bool | MTS String--- @------ and an invariant functor @Prim@ (representing, say, a bidirectional--- parser, where @Prim Int@ is a bidirectional parser for an 'Int'@),--- then you could assemble a bidirectional parser for a @MyType@ using:------ @--- invmap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))---        (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $---   assembleDecAlt $ intPrim---                     :* boolPrim---                     :* stringPrim---                     :* Nil--- @------ Some notes on usefulness depending on how many components you have:------ *    If you have 0 components, use 'Reject' directly.--- *    If you have 1 component, use 'inject' or 'injectChain' directly.--- *    If you have 2 components, use 'toListBy' or 'toChain'.--- *    If you have 3 or more components, these combinators may be useful;---      otherwise you'd need to manually peel off eithers one-by-one.-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)-      unconsNSI-      (Z . I)-      S---- | A version of 'assembleDecAlt' where each component is itself--- a 'DecAlt'.------ @--- assembleDecAlt (x :* y :* z :* Nil)---   = concatDecAlt (injectChain x :* injectChain y :* injectChain z :* Nil)--- @-concatDecAlt-    :: NP (DecAlt f) as-    -> DecAlt f (NS I as)-concatDecAlt = \case-    Nil     -> DecAlt $ Done $ Not (\case {})-    x :* xs -> coerce appendChain $ Night-      x-      (unDecAlt $ concatDecAlt xs)-      unconsNSI-      (Z . I)-      S---- | A version of 'assembleDecAlt' but for 'DecAlt1' instead.  Can--- be useful if you intend on interpreting it into something with only--- a 'Decide' or 'Alt' instance, but no--- 'Data.Functor.Contravariant.Divisible.Decidable' or 'Plus' or--- 'Control.Applicative.Alternative'.-assembleDecAlt1-    :: Invariant f-    => NP f (a ': as)-    -> DecAlt1 f (NS I (a ': as))-assembleDecAlt1 = \case-    x :* xs -> DecAlt1_ $ case xs of-      Nil    -> Done1 $ invmap (Z . I) (unI . unZ) x-      _ :* _ -> More1 $ Night-        x-        (unDecAlt1 $ assembleDecAlt1 xs)-        unconsNSI-        (Z . I)-        S---- | A version of 'concatDecAlt' but for 'DecAlt1' instead.  Can be--- useful if you intend on interpreting it into something with only--- a 'Decide' or 'Alt' instance, but no--- 'Data.Functor.Contravariant.Divisible.Decidable' or 'Plus' or--- 'Control.Applicative.Alternative'.-concatDecAlt1-    :: Invariant f-    => NP (DecAlt1 f) (a ': as)-    -> DecAlt1 f (NS I (a ': as))-concatDecAlt1 = \case-    x :* xs -> case xs of-      Nil    -> invmap (Z . I) (unI . unZ) x-      _ :* _ -> coerce appendChain1 $ Night-        x-        (unDecAlt1 $ concatDecAlt1 xs)-        unconsNSI-        (Z . I)-        S--unconsNSI :: NS I (a ': as) -> Either a (NS I as)-unconsNSI = \case-  Z (I x) -> Left x-  S xs    -> Right xs

@@ -1,422 +0,0 @@---- |--- Module      : Data.Functor.Invariant.Day--- Copyright   : (c) Justin Le 2019--- License     : BSD3------ Maintainer  : justin@jle.im--- Stability   : experimental--- Portability : non-portable------ Provide an invariant functor combinator sequencer, like a combination of--- 'Ap' and 'Div'.------ @since 0.3.5.0-module Data.Functor.Invariant.DivAp (-  -- * Chain-    DivAp(.., Gather, Knot)-  , runCoDivAp-  , runContraDivAp-  , divApAp-  , divApDiv-  , foldDivAp-  , gather, gathered-  , assembleDivAp-  , assembleDivApRec-  , concatDivAp-  , concatDivApRec-  -- * Nonempty Chain-  , DivAp1(.., DivAp1)-  , runCoDivAp1-  , runContraDivAp1-  , divApAp1-  , divApDiv1-  , foldDivAp1-  , gather1, gathered1-  , assembleDivAp1-  , assembleDivAp1Rec-  , concatDivAp1-  , concatDivAp1Rec-  -- * Day Utility-  , runDayApply-  , runDayDivise-  ) 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.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 qualified Data.Vinyl                                as V-import qualified Data.Vinyl.Functor                        as V---- | Interpret the covariant part of a 'Day' into a target context @h@,--- as long as the context is an instance of 'Apply'.  The 'Apply' is used to--- combine results back together using '<*>'.-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 the contravariant part of a 'Day' into a target context--- @h@, as long as the context is an instance of 'Divise'.  The 'Divise' is--- used to split up the input to pass to each of the actions.-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)---- | In the covariant direction, we can interpret out of a 'Chain1' of 'Day'--- into any 'Apply'.-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 out of a 'Chain1' of--- 'Day' into any 'Divise'.-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 out of a 'Chain' of 'Day'--- into any 'Applicative'.-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 contravariant direction, we can interpret out of a 'Chain' of--- 'Day' into any 'Divisible'.-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--- identity ('pure'/'conquer'/'Knot') and a way to handle a cons--- ('liftA2'/'divide'/'Gather').------ @since 0.3.5.0-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 = foldChain1 f g . unDivAp1-------- | Extract the 'Ap' part out of a 'DivAp', shedding the--- contravariant bits.------ @since 0.3.2.0-divApAp :: DivAp f ~> Ap f-divApAp = runCoDivAp inject---- | Extract the 'Ap1' part out of a 'DivAp1', shedding the--- contravariant bits.------ @since 0.3.2.0-divApAp1 :: DivAp1 f ~> Ap1 f-divApAp1 = runCoDivAp1 inject---- | Extract the 'Div' part out of a 'DivAp', shedding the--- covariant bits.------ @since 0.3.2.0-divApDiv :: DivAp f ~> Div f-divApDiv = runContraDivAp inject---- | Extract the 'Div1' part out of a 'DivAp1', shedding the--- covariant bits.------ @since 0.3.2.0-divApDiv1 :: DivAp1 f ~> Div1 f-divApDiv1 = runContraDivAp1 inject---- | Match on a non-empty 'DivAp'; contains no @f@s, but only the--- terminal value.  Analogous to the 'Control.Applicative.Free.Ap'--- constructor.-pattern Gather :: (a -> (b, c)) -> (b -> c -> a) -> f b -> DivAp f c -> DivAp f a-pattern Gather f g x xs <- (unGather_->MaybeF (Just (Day x xs g f)))-  where-    Gather f g x xs = DivAp $ More $ Day x (unDivAp xs) g f--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---- | 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 #-}---- | Match on a 'DivAp1' to get the head and the rest of the items.--- Analogous to the 'Data.Functor.Apply.Free.Ap1' constructor.-pattern DivAp1 :: Invariant f => (a -> (b, c)) -> (b -> c -> a) -> f b -> DivAp f c -> DivAp1 f a-pattern DivAp1 f g x xs <- (coerce splitChain1->Day x xs g f)-  where-    DivAp1 f g x xs = unsplitNE $ Day x xs g f-{-# COMPLETE DivAp1 #-}---- | Invariantly combine two 'DivAp's.------ Analogous to 'liftA2' and 'divise'.  If there was some typeclass that--- represented semigroups on invariant 'Day', this would be the method of--- that typeclass.------ The identity of this is 'Knot'.------ @since 0.3.4.0-gather-    :: (a -> (b, c))-    -> (b -> c -> a)-    -> DivAp f b-    -> DivAp f c-    -> DivAp f a-gather f g x y = coerce appendChain (Day x y g f)---- | Convenient wrapper over 'gather' that simply combines the two options--- in a tuple.  Analogous to 'divised'.------ @since 0.3.4.0-gathered-    :: DivAp f a-    -> DivAp f b-    -> DivAp f (a, b)-gathered = gather id (,)---- | Invariantly combine two 'DivAp1's.------ Analogous to 'liftA2' and 'divise'.  If there was some typeclass that--- represented semigroups on invariant 'Day', this would be the method of--- that typeclass.------ @since 0.3.4.0-gather1-    :: Invariant f-    => (a -> (b, c))-    -> (b -> c -> a)-    -> DivAp1 f b-    -> DivAp1 f c-    -> DivAp1 f a-gather1 f g x y = coerce appendChain1 (Day x y g f)---- | Convenient wrapper over 'gather1' that simply combines the two options--- in a tuple.  Analogous to 'divised'.------ @since 0.3.4.0-gathered1-    :: Invariant f-    => DivAp1 f a-    -> DivAp1 f b-    -> DivAp1 f (a, b)-gathered1 = gather1 id (,)---- | Convenient wrapper to build up a 'DivAp' 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 functions in--- one place.------ For example, if you had a data type------ @--- data MyType = MT Int Bool String--- @------ and an invariant functor @Prim@ (representing, say, a bidirectional--- parser, where @Prim Int@ is a bidirectional parser for an 'Int'@),--- then you could assemble a bidirectional parser for a @MyType@ using:------ @--- invmap (\(MyType x y z) -> I x :* I y :* I z :* Nil)---        (\(I x :* I y :* I z :* Nil) -> MyType x y z) $---   assembleDivAp $ intPrim---                   :* boolPrim---                   :* stringPrim---                   :* Nil--- @------ Some notes on usefulness depending on how many components you have:------ *    If you have 0 components, use 'Knot' directly.--- *    If you have 1 component, use 'inject' or 'injectChain' directly.--- *    If you have 2 components, use 'toListBy' or 'toChain'.--- *    If you have 3 or more components, these combinators may be useful;---      otherwise you'd need to manually peel off tuples one-by-one.-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))-      consNPI-      unconsNPI---- | A version of 'assembleDivAp' where each component is itself--- a 'DivAp'.------ @--- assembleDivAp (x :* y :* z :* Nil)---   = concatDivAp (injectChain x :* injectChain y :* injectChain z :* Nil)--- @-concatDivAp-    :: NP (DivAp f) as-    -> DivAp f (NP I as)-concatDivAp = \case-    Nil     -> DivAp $ Done $ Identity Nil-    x :* xs -> coerce appendChain $ Day-      x-      (concatDivAp xs)-      consNPI-      unconsNPI---- | A version of 'assembleDivAp' but for 'DivAp1' instead.  Can be--- useful if you intend on interpreting it into something with only--- a 'Divise' or 'Apply' instance, but no 'Divisible' or 'Applicative'.-assembleDivAp1-    :: Invariant f-    => NP f (a ': as)-    -> DivAp1 f (NP I (a ': as))-assembleDivAp1 = \case-    x :* xs -> DivAp1_ $ case xs of-      Nil    -> Done1 $ invmap ((:* Nil) . I) (unI . hd) x-      _ :* _ -> More1 $ Day-        x-        (unDivAp1 (assembleDivAp1 xs))-        consNPI-        unconsNPI---- | A version of 'concatDivAp' but for 'DivAp1' instead.  Can be--- useful if you intend on interpreting it into something with only--- a 'Divise' or 'Apply' instance, but no 'Divisible' or 'Applicative'.-concatDivAp1-    :: Invariant f-    => NP (DivAp1 f) (a ': as)-    -> DivAp1 f (NP I (a ': as))-concatDivAp1 = \case-    x :* xs -> case xs of-      Nil    -> invmap ((:* Nil) . I) (unI . hd) x-      _ :* _ -> coerce appendChain1 $ Day-        x-        (concatDivAp1 xs)-        consNPI-        unconsNPI--unconsNPI :: NP I (a ': as) -> (a, NP I as)-unconsNPI (I y :* ys) = (y, ys)--consNPI :: a -> NP I as -> NP I (a ': as)-consNPI y ys = I 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--- require manual unwrapping/wrapping of components.------ @--- data MyType = MT Int Bool String------ invmap (\(MyType x y z) -> x ::& y ::& z ::& RNil)---        (\(x ::& y ::& z ::& RNil) -> MyType x y z) $---   assembleDivApRec $ intPrim---                      :& boolPrim---                      :& stringPrim---                      :& Nil--- @-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---- | A version of 'concatDivAp' 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.-concatDivApRec-    :: V.Rec (DivAp f) as-    -> DivAp f (V.XRec V.Identity as)-concatDivApRec = \case-    V.RNil    -> DivAp $ Done $ Identity V.RNil-    x V.:& xs -> coerce appendChain $ Day-      x-      (concatDivApRec 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--- require manual unwrapping/wrapping of components.-assembleDivAp1Rec-    :: Invariant f-    => V.Rec f (a ': as)-    -> DivAp1 f (V.XRec V.Identity (a ': as))-assembleDivAp1Rec = \case-    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---- | A version of 'concatDivAp1' 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.-concatDivAp1Rec-    :: Invariant f-    => V.Rec (DivAp1 f) (a ': as)-    -> DivAp1 f (V.XRec V.Identity (a ': as))-concatDivAp1Rec = \case-    x V.:& xs -> case xs of-      V.RNil   -> invmap (V.::& V.RNil) (\case z V.::& _ -> z) x-      _ V.:& _ -> coerce appendChain1 $ Day-        x-        (concatDivAp1Rec xs)-        (V.::&)-        unconsRec--unconsRec :: V.XRec V.Identity (a ': as) -> (a, V.XRec V.Identity as)-unconsRec (y V.::& ys) = (y, ys)

@@ -0,0 +1,224 @@+-- |+-- Module      : Data.Functor.Invariant.Inplicative+-- Copyright   : (c) Justin Le 2021+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Contains the classes 'Inply' and 'Inplicative', the invariant+-- counterparts to 'Apply'/'Divise' and 'Applicative'/'Divisible'.+--+-- @since 0.4.0.0+module Data.Functor.Invariant.Inplicative (+  -- * Typeclass+    Inply(..)+  , Inplicative(..)+  -- * Invariant 'Day'+  , runDay+  , dather+  -- * Assembling Helpers+  , concatInplicative+  , concatInply+  , concatInplicativeRec+  , concatInplyRec+  ) where++import           Control.Natural+import           Data.Functor.Invariant+import           Data.Functor.Invariant.Day+import           Data.SOP hiding            (hmap)+import qualified Data.Vinyl                 as V+import qualified Data.Vinyl.Functor         as V++-- | The invariant counterpart of 'Apply' and 'Divise'.+--+-- Conceptually you can think of 'Apply' as, given a way to "combine" @a@ and+-- @b@ to @c@, lets you merge @f a@ (producer of @a@) and @f b@ (producer+-- of @b@) into a @f c@ (producer of @c@).  'Divise' can be thought of as,+-- given a way to "split" a @c@ into an @a@ and a @b@, lets you merge @f+-- a@ (consumer of @a@) and @f b@ (consumder of @b@) into a @f c@ (consumer+-- of @c@).+--+-- 'Inply', for 'gather', requires both a combining function and+-- a splitting function in order 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@.+--+-- @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 #-}++-- | The invariant counterpart of 'Applicative' and 'Divisible'.+--+-- The main important action is described in 'Inply', but this adds 'knot',+-- which is the counterpart to 'pure' and 'conquer'.  It's the identity to+-- 'gather'; if combine two @f a@s with 'gather', and one of them is+-- 'knot', it will leave the structure unchanged.+--+-- Conceptually, if you think of 'gather' as "splitting and re-combining"+-- along multiple forks, then 'knot' introduces a fork that is never taken.+--+-- @since 0.4.0.0+class Inply f => Inplicative f where+    knot :: a -> f a++-- | Interpret out of a contravariant 'Day' into any instance of 'Inply' by+-- providing two interpreting functions.+--+-- This should go in "Data.Functor.Invariant.Day", but that module is in+-- a different package.+--+-- @since 0.4.0.0+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'+-- instances.+--+-- This should go in "Data.Functor.Invariant.Day", but that module is in+-- a different package.+--+-- @since 0.4.0.0+dather+    :: Inply f+    => Day f f ~> f+dather (Day x y a b) = gather a b x y++-- | 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+-- functions in one place.+--+-- For example, if you had a data type+--+-- @+-- data MyType = MT Int Bool String+-- @+--+-- and an invariant functor and 'Inplicative' instance @Prim@+-- (representing, say, a bidirectional parser, where @Prim Int@ is+-- a bidirectional parser for an 'Int'@), then you could assemble+-- a bidirectional parser for a @MyType@ using:+--+-- @+-- invmap (\(MyType x y z) -> I x :* I y :* I z :* Nil)+--        (\(I x :* I y :* I z :* Nil) -> MyType x y z) $+--   concatInplicative $ intPrim+--                    :* boolPrim+--                    :* stringPrim+--                    :* Nil+-- @+--+-- Some notes on usefulness depending on how many components you have:+--+-- *    If you have 0 components, use 'knot' directly.+-- *    If you have 1 component, use 'inject' directly.+-- *    If you have 2 components, use 'gather' directly.+-- *    If you have 3 or more components, these combinators may be useful;+--      otherwise you'd need to manually peel off tuples one-by-one.+--+-- @since 0.4.0.0+concatInplicative+    :: Inplicative f+    => NP f as+    -> f (NP I as)+concatInplicative = \case+    Nil     -> knot Nil+    x :* xs -> gather+      (\y ys -> I y :* ys)+      (\case I y :* ys -> (y, ys))+      x+      (concatInplicative xs)++-- | A version of 'concatInplicative' for non-empty 'NP', but only+-- requiring an 'Inply' instance.+--+-- @since 0.4.0.0+concatInply+    :: Inply f+    => NP f (a ': as)+    -> f (NP I (a ': as))+concatInply (x :* xs) = case xs of+    Nil    -> invmap ((:* Nil) . I) (\case I y :* _ -> y) x+    _ :* _ -> gather+      (\y ys -> I y :* ys)+      (\case I y :* ys -> (y, ys))+      x+      (concatInply xs)++-- | A version of 'concatInplicative' 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.0.0+concatInplicativeRec+    :: Inplicative f+    => V.Rec f as+    -> f (V.XRec V.Identity as)+concatInplicativeRec = \case+    V.RNil    -> knot V.RNil+    x V.:& xs -> gather+      (V.::&)+      (\case y V.::& ys -> (y, ys))+      x+      (concatInplicativeRec xs)++-- | A version of 'concatInply' 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.0.0+concatInplyRec+    :: Inply f+    => V.Rec f (a ': as)+    -> f (V.XRec V.Identity (a ': as))+concatInplyRec (x V.:& xs) = case xs of+    V.RNil   -> invmap (V.::& V.RNil) (\case z V.::& _ -> z) x+    _ V.:& _ -> gather+      (V.::&)+      (\case y V.::& ys -> (y, ys))+      x+      (concatInplyRec xs)

@@ -0,0 +1,332 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Data.Functor.Invariant.Inplicative.Free+-- Copyright   : (c) Justin Le 2019+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provide an invariant functor combinator sequencer, like a combination of+-- 'Ap' and 'Div'.+--+-- This module was named 'Data.Functor.Invariant.DecAlt' before v0.4.0.0+--+-- @since 0.4.0.0+module Data.Functor.Invariant.Inplicative.Free (+  -- * Chain+    DivAp(.., Gather, Knot)+  , runCoDivAp+  , runContraDivAp+  , divApAp+  , divApDiv+  , foldDivAp+  , assembleDivAp+  , assembleDivApRec+  -- * Nonempty Chain+  , DivAp1(.., DivAp1)+  , runCoDivAp1+  , runContraDivAp1+  , divApAp1+  , divApDiv1+  , foldDivAp1+  , assembleDivAp1+  , assembleDivAp1Rec+  -- * Day Utility+  , runDayApply+  , runDayDivise+  ) 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++-- | Interpret the covariant part of a 'Day' into a target context @h@,+-- as long as the context is an instance of 'Apply'.  The 'Apply' is used to+-- combine results back together using '<*>'.+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 the contravariant part of a 'Day' into a target context+-- @h@, as long as the context is an instance of 'Divise'.  The 'Divise' is+-- used to split up the input to pass to each of the actions.+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)++-- | In the covariant direction, we can interpret out of a 'Chain1' of 'Day'+-- into any 'Apply'.+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 out of a 'Chain1' of+-- 'Day' into any 'Divise'.+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 out of a 'Chain' of 'Day'+-- into any 'Applicative'.+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 contravariant direction, we can interpret out of a 'Chain' of+-- 'Day' into any 'Divisible'.+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+-- identity ('pure'/'conquer'/'Knot') and a way to handle a cons+-- ('liftA2'/'divide'/'Gather').+--+-- @since 0.3.5.0+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 = foldChain1 f g . unDivAp1++++++-- | Extract the 'Ap' part out of a 'DivAp', shedding the+-- contravariant bits.+--+-- @since 0.3.2.0+divApAp :: DivAp f ~> Ap f+divApAp = runCoDivAp inject++-- | Extract the 'Ap1' part out of a 'DivAp1', shedding the+-- contravariant bits.+--+-- @since 0.3.2.0+divApAp1 :: DivAp1 f ~> Ap1 f+divApAp1 = runCoDivAp1 inject++-- | Extract the 'Div' part out of a 'DivAp', shedding the+-- covariant bits.+--+-- @since 0.3.2.0+divApDiv :: DivAp f ~> Div f+divApDiv = runContraDivAp inject++-- | Extract the 'Div1' part out of a 'DivAp1', shedding the+-- covariant bits.+--+-- @since 0.3.2.0+divApDiv1 :: DivAp1 f ~> Div1 f+divApDiv1 = runContraDivAp1 inject++-- | Match on a non-empty 'DivAp'; contains no @f@s, but only the+-- terminal value.  Analogous to the 'Control.Applicative.Free.Ap'+-- constructor.+--+-- 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)))+  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++-- | 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 _))++-- | The free 'Inplicative'+instance Inplicative (DivAp f) where+    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.+--+-- 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)+  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 _))++-- | Convenient wrapper to build up a 'DivAp' 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 functions in+-- one place.+--+-- For example, if you had a data type+--+-- @+-- data MyType = MT Int Bool String+-- @+--+-- and an invariant functor @Prim@ (representing, say, a bidirectional+-- parser, where @Prim Int@ is a bidirectional parser for an 'Int'@),+-- then you could assemble a bidirectional parser for a @MyType@ using:+--+-- @+-- invmap (\(MyType x y z) -> I x :* I y :* I z :* Nil)+--        (\(I x :* I y :* I z :* Nil) -> MyType x y z) $+--   assembleDivAp $ intPrim+--                   :* boolPrim+--                   :* stringPrim+--                   :* Nil+-- @+--+-- Some notes on usefulness depending on how many components you have:+--+-- *    If you have 0 components, use 'Knot' directly.+-- *    If you have 1 component, use 'inject' or 'injectChain' directly.+-- *    If you have 2 components, use 'toListBy' or 'toChain'.+-- *    If you have 3 or more components, these combinators may be useful;+--      otherwise you'd need to manually peel off tuples one-by-one.+--+-- 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 = \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))++-- | A version of 'assembleDivAp' but for 'DivAp1' instead.  Can be+-- useful if you intend on interpreting it into something with only+-- a 'Divise' or 'Apply' instance, but no 'Divisible' or 'Applicative'.+--+-- 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 (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))++-- | A version of 'assembleDivAp' 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.+--+-- @+-- data MyType = MT Int Bool String+--+-- invmap (\(MyType x y z) -> x ::& y ::& z ::& RNil)+--        (\(x ::& y ::& z ::& RNil) -> MyType x y z) $+--   assembleDivApRec $ intPrim+--                      :& boolPrim+--                      :& stringPrim+--                      :& Nil+-- @+--+-- 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 = \case+    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+-- require manual unwrapping/wrapping of components.+--+-- 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 (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++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++-- | A free 'Inplicative'+instance Inplicative f => Interpret DivAp f where+    interpret f (DivAp x) = foldChain (knot . runIdentity) (runDay f id) x

@@ -0,0 +1,170 @@+-- |+-- Module      : Data.Functor.Invariant.Internative+-- Copyright   : (c) Justin Le 2021+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Contains the classes 'Inalt' and 'Inplus', the invariant+-- counterparts to 'Alt'/'Plus' and 'Decide'/'Conclude' and+-- 'Alternative'/'Decidable'.+--+-- @since 0.4.0.0+module Data.Functor.Invariant.Internative (+  -- * Typeclass+    Inalt(..)+  , Inplus(..)+  , Internative+  -- * Assembling Helpers+  , concatInplus+  , concatInalt+  ) where++import           Data.Functor.Invariant+import           Data.Functor.Invariant.Inplicative+import           Data.SOP hiding                    (hmap)+import           Data.Void++-- | The invariant counterpart of 'Alt' and 'Decide'.+--+-- Conceptually you can think of 'Alt' as, given a way to "inject" @a@ and+-- @b@ as @c@, lets you merge @f a@ (producer of @a@) and @f b@ (producer+-- of @b@) into a @f c@ (producer of @c@), in an "either-or" fashion.+-- 'Decide' can be thought of as, given a way to "discriminate" a @c@ as+-- either a @a@ or a @b@, lets you merge @f a@ (consumer of @a@) and @f b@+-- (consumder of @b@) into a @f c@ (consumer of @c@) in an "either-or"+-- forking fashion (split the @c@ into @a@ or @b@, and use the appropriate+-- handler).+--+-- 'Inalt', for 'swerve', requires both an injecting function and+-- a choosing function in order 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@.+--+-- @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 #-}++-- | The invariant counterpart of 'Alt' and 'Conclude'.+--+-- The main important action is described in 'Inalt', but this adds 'reject',+-- which is the counterpart to 'empty' and 'conclude' and 'conquer'.  It's the identity to+-- 'swerve'; if combine two @f a@s with 'swerve', and one of them is+-- 'reject', then that banch will never be taken.+--+-- Conceptually, if you think of 'swerve' as "choosing one path and+-- re-injecting back", then 'reject' introduces a branch that is impossible+-- to take.++-- @since 0.4.0.0+class Inalt f => Inplus f where+    reject :: (a -> Void) -> f a++-- | The invariant counterpart to 'Alternative' and 'Decidable': represents+-- a combination of both 'Applicative' and 'Alt', or 'Divisible' and+-- 'Conclude'.  There are laws?++-- @since 0.4.0.0+class (Inplus f, Inplicative f) => Internative f++-- | 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+-- one place.+--+-- For example, if you had a data type+--+-- @+-- data MyType = MTI Int | MTB Bool | MTS String+-- @+--+-- and an invariant functor and 'Inplus' instance @Prim@ (representing, say,+-- a bidirectional parser, where @Prim Int@ is a bidirectional parser for+-- an 'Int'@), then you could assemble a bidirectional parser for+-- a @MyType@ using:+--+-- @+-- invmap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))+--        (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $+--   concatInplus $ intPrim+--               :* boolPrim+--               :* stringPrim+--               :* Nil+-- @+--+-- Some notes on usefulness depending on how many components you have:+--+-- *    If you have 0 components, use 'reject' directly.+-- *    If you have 1 component, use 'inject' directly.+-- *    If you have 2 components, use 'swerve' directly.+-- *    If you have 3 or more components, these combinators may be useful;+--      otherwise you'd need to manually peel off eithers one-by-one.+concatInplus+    :: Inplus f+    => NP f as+    -> f (NS I as)+concatInplus = \case+    Nil     -> reject $ \case {}+    x :* xs -> swerve+      (Z . I)+      S+      (\case Z (I y) -> Left y; S ys -> Right ys)+      x+      (concatInplus xs)++-- | A version of 'concatInplus' for non-empty 'NP', but only+-- requiring an 'Inalt' instance.+--+-- @since 0.4.0.0+concatInalt+    :: Inalt f+    => NP f (a ': as)+    -> f (NS I (a ': as))+concatInalt (x :* xs) = case xs of+    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)+      x+      (concatInalt xs)

@@ -0,0 +1,269 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Data.Functor.Invariant.Internative.Free+-- Copyright   : (c) Justin Le 2019+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provide an invariant functor combinator choice-collector, like+-- a combination of 'ListF' and 'Dec'.+--+-- This module was named 'Data.Functor.Invariant.DecAlt' before v0.4.0.0+--+-- @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++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+++-- | In the covariant direction, we can interpret out of a 'Chain1' of 'Night'+-- into any 'Alt'.+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 out of a 'Chain1' of+-- 'Night' into any 'Decide'.+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+-- covariant bits.+decAltDec :: DecAlt f ~> Dec f+decAltDec = runContraDecAlt inject++-- | Extract the 'Dec1' part out of a 'DecAlt1', shedding the+-- covariant bits.+decAltDec1 :: DecAlt1 f ~> Dec1 f+decAltDec1 = runContraDecAlt1 inject++-- | In the covariant direction, we can interpret out of a 'Chain' of 'Night'+-- into any 'Plus'.+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 out of a 'Chain' of+-- 'Night' into any 'Conclude'.+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+-- contravariant bits.+--+-- @since 0.3.2.0+decAltListF :: Functor f => DecAlt f ~> ListF f+decAltListF = runCoDecAlt inject++-- | Extract the 'ListF' part out of a 'DecAlt', shedding the+-- contravariant bits.+--+-- This version does not require a 'Functor' constraint because it converts+-- to the coyoneda-wrapped product, which is more accurately the true+-- conversion to a covariant chain.+--+-- @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 $+      CY.Coyoneda f x : (map . fmap) g xs++-- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the+-- contravariant bits.+--+-- @since 0.3.2.0+decAltNonEmptyF :: Functor f => DecAlt1 f ~> NonEmptyF f+decAltNonEmptyF = runCoDecAlt1 inject++-- | Extract the 'NonEmptyF' part out of a 'DecAlt1', shedding the+-- contravariant bits.+--+-- This version does not require a 'Functor' constraint because it converts+-- to the coyoneda-wrapped product, which is more accurately the true+-- conversion to a covariant chain.+--+-- @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 $+      CY.Coyoneda f x NE.<| (fmap . fmap) g xs++-- | General-purpose folder of 'DecAlt'.  Provide a way to handle the+-- identity ('empty'/'conclude'/'Reject') and a way to handle a cons+-- ('<!>'/'decide'/'swerve').+--+-- @since 0.3.5.0+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 = foldChain1 f g . unDecAlt1++-- | Match on a non-empty 'DecAlt'; contains the splitting function,+-- the two rejoining functions, the first @f@, and the rest of the chain.+-- 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)))+  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+++-- | 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 _))++instance Inplus (DecAlt f) where+    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)+  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 _))++-- | Convenient wrapper to build up a 'DecAlt' 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+-- one place.+--+-- For example, if you had a data type+--+-- @+-- data MyType = MTI Int | MTB Bool | MTS String+-- @+--+-- and an invariant functor @Prim@ (representing, say, a bidirectional+-- parser, where @Prim Int@ is a bidirectional parser for an 'Int'@),+-- then you could assemble a bidirectional parser for a @MyType@ using:+--+-- @+-- invmap (\case MTI x -> Z (I x); MTB y -> S (Z (I y)); MTS z -> S (S (Z (I z))))+--        (\case Z (I x) -> MTI x; S (Z (I y)) -> MTB y; S (S (Z (I z))) -> MTS z) $+--   assembleDecAlt $ intPrim+--                     :* boolPrim+--                     :* stringPrim+--                     :* Nil+-- @+--+-- Some notes on usefulness depending on how many components you have:+--+-- *    If you have 0 components, use 'Reject' directly.+-- *    If you have 1 component, use 'inject' or 'injectChain' directly.+-- *    If you have 2 components, use 'toListBy' or 'toChain'.+-- *    If you have 3 or more components, these combinators may be useful;+--      otherwise you'd need to manually peel off eithers one-by-one.+--+-- 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 = \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)++-- | A version of 'assembleDecAlt' but for 'DecAlt1' instead.  Can+-- be useful if you intend on interpreting it into something with only+-- a 'Decide' or 'Alt' instance, but no+-- 'Data.Functor.Contravariant.Divisible.Decidable' or 'Plus' or+-- 'Control.Applicative.Alternative'.+--+-- 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 (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)

@@ -15,6 +15,8 @@     Night(..)   , Not(..), refuted   , night+  , runNight+  , nerve   , runNightAlt   , runNightDecide   , toCoNight@@ -33,6 +35,7 @@ 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@@ -63,19 +66,19 @@ data Night :: (Type -> Type) -> (Type -> Type) -> (Type -> Type) where     Night :: f b           -> g c-          -> (a -> Either b 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 (h . g) (f . j) (f . k)+    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 -- and outputs. night :: f a -> g b -> Night f g (Either a b)-night x y = Night x y id Left Right+night x y = Night x y Left Right id  -- | 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@@ -85,7 +88,7 @@     => f ~> h     -> g ~> h     -> Night f g ~> h-runNightAlt f g (Night x y _ j k) = fmap j (f x) <!> fmap k (g y)+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@@ -95,7 +98,7 @@     => f ~> h     -> g ~> h     -> Night f g ~> h-runNightDecide f g (Night x y h _ _) = decide h (f x) (g y)+runNightDecide f g (Night x y _ _ k) = decide k (f x) (g y)  -- | Convert an invariant 'Night' into the covariant version, dropping the -- contravariant part.@@ -104,7 +107,7 @@ -- library, so we use an equivalent type (if @f@ and @g@ are 'Functor's) @f -- ':*:' g@. toCoNight :: (Functor f, Functor g) => Night f g ~> f :*: g-toCoNight (Night x y _ f g) = fmap f x :*: fmap g y+toCoNight (Night x y f g _) = fmap f x :*: fmap g y  -- | Convert an invariant 'Night' into the covariant version, dropping the -- contravariant part.@@ -115,53 +118,75 @@ -- -- @since 0.3.2.0 toCoNight_ :: Night f g ~> CY.Coyoneda f :*: CY.Coyoneda g-toCoNight_ (Night x y _ f g) = CY.Coyoneda f x :*: CY.Coyoneda g y+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-toContraNight (Night x y f _ _) = CN.Night x y f+toContraNight (Night x y _ _ h) = CN.Night x y h +-- | Interpret out of a 'Night' into any instance of 'Inalt' by providing+-- two interpreting functions.+--+-- @since 0.4.0.0+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 (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 id Left Right) z-      (B.unassoc . second f . j)-      (either k (l . g))-      (l . h)+    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 id Left Right)-      (B.assoc . first f . j)-      (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-intro1 y = Night refuted y Right absurd id+intro1 y = Night refuted y absurd id Right  -- | The right identity of 'Night' is 'Not'; this is one side of that -- isomorphism. intro2 :: f ~> Night f Not-intro2 x = Night x refuted Left id absurd+intro2 x = Night x refuted id absurd Left  -- | The left identity of 'Night' is 'Not'; this is one side of that -- isomorphism. elim1 :: Invariant g => Night Not g ~> g-elim1 (Night x y f _ h) = invmap h (either (absurd . refute x) id . f) y+elim1 (Night x y _ g h) = invmap g (either (absurd . refute x) id . h) y  -- | The right identity of 'Night' is 'Not'; this is one side of that -- isomorphism. elim2 :: Invariant f => Night f Not ~> f-elim2 (Night x y f g _) = invmap g (either id (absurd . refute y) . f) x+elim2 (Night x y f _ h) = invmap f (either id (absurd . refute y) . h) x  -- | The two sides of a 'Night' can be swapped. swapped :: Night f g ~> Night g f-swapped (Night x y f g h) = Night y x (B.swap . f) h g+swapped (Night x y f g h) = Night y x g f (B.swap . h)  -- | Hoist a function over the left side of a 'Night'. trans1 :: f ~> h -> Night f g ~> Night h g

@@ -76,6 +76,8 @@ import           Data.Functor.Day                          (Day(..)) import           Data.Functor.Identity import           Data.Functor.Invariant+import           Data.Functor.Invariant.Inplicative+import           Data.Functor.Invariant.Internative import           Data.Functor.Plus import           Data.Functor.Product import           Data.Functor.Sum@@ -521,6 +523,11 @@       (\a (b, c) -> g (j a b) c)       (B.assoc . first h . f) +-- | @since 0.4.0.0+instance Inply f => SemigroupIn ID.Day f where+    biretract = dather+    binterpret = runDay+ instance Associative IN.Night where     type NonEmptyBy IN.Night = DecAlt1     type FunctorBy IN.Night = Invariant@@ -536,10 +543,15 @@ appendNEINight_ (IN.Night xs ys f g h) = case xs of   Done1 x                     -> More1 (IN.Night x ys f g h)   More1 (IN.Night z zs j k l) -> More1 $-    IN.Night z (appendNEINight_ (IN.Night zs ys id Left Right))-      (B.assoc . first j . f)-      (g . k)-      (either (g . l) h)+    IN.Night z (appendNEINight_ (IN.Night zs ys Left Right id))+      (f . j)+      (either (f . k) g)+      (B.assoc . first l . h)++-- | @since 0.4.0.0+instance Inalt f => SemigroupIn IN.Night f where+    biretract = IN.nerve+    binterpret = IN.runNight  -- | @since 0.3.0.0 instance Associative Night where

@@ -95,6 +95,8 @@ import           Data.Functor.Day                          (Day(..)) import           Data.Functor.Identity import           Data.Functor.Invariant+import           Data.Functor.Invariant.Internative+import           Data.Functor.Invariant.Inplicative import           Data.Functor.Plus import           Data.Functor.Product import           Data.Functor.Sum@@ -497,6 +499,9 @@   Done x  -> L1 x   More xs -> R1 $ unsplitNEIDay_ xs +instance Inplicative f => MonoidIn ID.Day Identity f where+    pureT (Identity x) = knot x+ instance Tensor IN.Night IN.Not where     type ListBy IN.Night = DecAlt @@ -506,13 +511,13 @@     elim2 = IN.elim1      appendLB (IN.Night (DecAlt xs) (DecAlt ys) f g h) = DecAlt $ case xs of-      Done r      -> invmap h (either (absurd . refute r) id . f) ys+      Done r      -> invmap g (either (absurd . refute r) id . h) ys       More (IN.Night z zs j k l) -> More $ IN.Night         z-        (unDecAlt $ appendLB (IN.Night (DecAlt zs) (DecAlt ys) id Left Right))-        (B.assoc . first j . f)-        (g . k)-        (either (g . l) h)+        (unDecAlt $ appendLB (IN.Night (DecAlt zs) (DecAlt ys) Left Right id))+        (f . j)+        (either (f . k) g)+        (B.assoc . first l . h)     splitNE = coerce splitChain1     splittingLB = coercedF . splittingChain . coercedF @@ -524,13 +529,17 @@  unsplitNEINight_ :: Invariant f => IN.Night f (Chain IN.Night Not f) ~> Chain1 IN.Night f unsplitNEINight_ (IN.Night x xs f g h) = case xs of-  Done r  -> Done1 $ invmap g (either id (absurd . refute r) . f) x+  Done r  -> Done1 $ invmap f (either id (absurd . refute r) . h) x   More ys -> More1 $ IN.Night x (unsplitNEINight_ ys) f g h  matchLBINight_ :: Invariant f => Chain IN.Night Not f ~> (Not :+: Chain1 IN.Night f) matchLBINight_ = \case   Done x  -> L1 x   More xs -> R1 $ unsplitNEINight_ xs++-- | @since 0.4.0.0+instance Inplus f => MonoidIn IN.Night IN.Not f where+    pureT (Not x) = reject x  -- | @since 0.3.0.0 instance Tensor Night Not where

@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK hide, not-home #-}  module Data.HBifunctor.Tensor.Internal (     Tensor(..)

@@ -69,6 +69,9 @@ import           Data.Functor.Contravariant.Divisible import           Data.Functor.Day hiding              (intro1, intro2, elim1, elim2) import           Data.Functor.Identity+import           Data.Functor.Invariant+import           Data.Functor.Invariant.Inplicative+import           Data.Functor.Invariant.Internative import           Data.Functor.Plus import           Data.Functor.Product import           Data.HBifunctor@@ -82,6 +85,8 @@ import           GHC.Generics import qualified Data.Functor.Contravariant.Day       as CD import qualified Data.Functor.Contravariant.Night     as N+import qualified Data.Functor.Invariant.Day           as ID+import qualified Data.Functor.Invariant.Night         as IN  instance (HBifunctor t, SemigroupIn t f) => Interpret (Chain1 t) f where     retract = \case@@ -175,9 +180,17 @@ instance Contravariant f => Decide (Chain1 N.Night f) where     decide f x y = appendChain1 $ N.Night x y f +-- | @since 0.4.0.0+instance Invariant f => Inply (Chain1 ID.Day f) where+    gather f g x y = appendChain1 (ID.Day x y f g)+ instance Tensor t i => Inject (Chain t i) where     inject = injectChain +-- | @since 0.4.0.0+instance Invariant f => Inalt (Chain1 IN.Night f) where+    swerve f g h x y = appendChain1 (IN.Night x y f g h)+ -- | We can collapse and interpret an @'Chain' t i@ if we have @'Tensor' t@. instance MonoidIn t i f => Interpret (Chain t i) f where     interpret@@ -287,6 +300,22 @@     divide f x y = appendChain $ CD.Day x y f     conquer = Done Proxy +-- | @since 0.4.0.0+instance Inply (Chain ID.Day Identity f) where+    gather f g x y = appendChain (ID.Day x y f g)++-- | @since 0.4.0.0+instance Inplicative (Chain ID.Day Identity f) where+    knot = Done  . Identity++-- | @since 0.4.0.0+instance Inalt (Chain IN.Night IN.Not f) where+    swerve f g h x y = appendChain (IN.Night x y f g h)++-- | @since 0.4.0.0+instance Inplus (Chain IN.Night IN.Not f) where+    reject = Done . IN.Not+ -- | @since 0.3.0.0 instance Decide (Chain N.Night N.Not f) where     decide f x y = appendChain $ N.Night x y f@@ -332,3 +361,4 @@ -- 'Plus'. instance Functor f => Plus (Chain Product Proxy f) where     zero = Done Proxy+

@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK hide, not-home #-}  module Data.HFunctor.Chain.Internal (     Chain1(..)@@ -23,8 +24,10 @@ import           Data.Functor.Contravariant import           Data.Functor.Identity import           Data.Functor.Invariant+import           Data.Functor.Invariant.Internative import           Data.HBifunctor import           Data.HFunctor+import           Data.HFunctor.Interpret import           Data.HFunctor.HTraversable import           Data.Kind import           Data.Typeable@@ -378,26 +381,20 @@ -- all @f x@s to each interpret, and then re-combined again to produce the -- resulting @a@. ----- You run this in any 'Apply' context if you want to interpret it--- covariantly, treating @'DivAp1' f a@ as a /producer/ of @a@, using--- 'runCoDivAp1'.  You can run this in any 'Divise' context if you you--- want to interpret it contravariantly, treating @'DivAp1' f a@ as--- a /consumer/ of @a@s, using 'runContraDivAp1'.------ Because there is no typeclass that combines both 'Apply' and--- 'Divise', this type is a little bit tricker to construct/use than--- 'Ap1' or 'Div1'.+-- To do this, the main tools to combine 'DivAp1's are its 'Inply'+-- instance, using 'gather' to combine two 'DivAp1's in+-- a parallel-fork-like manner (with the splitting and re-combining+-- function). ----- *  Instead of '<.>' and 'divide' (typeclass methods), use---    'Data.Functor.Invariant.DivAp.gather1' and other variants, which work---    specifically on this type only.--- *  Instead of using 'interpret' (to run in a typeclass), either use---    'runCoDivAp1' (to run in 'Apply'), 'runContraDivAp1' (to run in---    'Divise'), or 'foldDivAp1' (to interpret by manually providing---    handlers)+-- This does have an 'Interpret' function, but the target typeclass+-- ('Inply') doesn't have too many useful instances.  Instead, you are+-- probably going to run it into either 'Apply' instance (to "produce" an+-- @a@ from a @'DivAp1' f a@) with 'runCoDivAp1', or a 'Divise' instance+-- (to "consume" an @a@ from a @'DivAp1' f a@) with 'runContraDivAp1'. ----- You can also extract the 'Ap1' part out using 'divApAp1', and extract the--- 'Div1' part out using 'divApDiv1'.+-- If you think of this type as a combination of 'Ap1' and 'Div1', then+-- you can also extract the 'Ap1' part out using 'divApAp1', and+-- extract the 'Div1' part out using 'divApDiv1'. -- -- Note that this type's utility is similar to that of @'PreT' 'Ap1'@, -- except @'PreT' 'Ap1'@ lets you use 'Apply' typeclass methods to assemble@@ -435,28 +432,22 @@ -- When interpreting this, each @a@ is distributed across all @f x@s to -- each interpret, and then re-combined again to produce the resulting @a@. ----- You run this in any 'Applicative' context if you want to interpret it--- covariantly, treating @'DivAp' f a@ as a /producer/ of @a@, using--- 'runCoDivAp'.  You can run this in any 'Divisible' context if you you--- want to interpret it contravariantly, treating @'DivAp' f a@ as--- a /consumer/ of @a@s, using 'runContraDivAp'.------ Because there is no typeclass that combines both 'Applicative' and--- 'Divisible', this type is a little bit tricker to construct/use than--- 'Ap' or 'Div'.+-- To do this, the main tools to combine 'DivAp's are its 'Inply'+-- instance, using 'gather' to combine two 'DivAp's in a choice-like+-- manner (with the splitting and re-combining function), and its+-- 'Inplicative' instance, using 'knot' to create an "empty" branch that+-- does not contribute to the structure. ----- *  Instead of '<*>' and 'divide' (typeclass methods), use---    'Data.Functor.Invariant.DivAp.gather' and other variants, which work---    specifically on this type only.--- *  Instead of 'pure' and 'conquer' (typeclass methods), use---    'Data.Functor.Invariant.DivAp.Knot'.--- *  Instead of using 'interpret' (to run in a typeclass), either use---    'runCoDivAp' (to run in 'Applicative'), 'runContraDivAp' (to run in---    'Divisible'), or 'foldDivAp' (to interpret by manually providing---    handlers)+-- This does have an 'Interpret' function, but the target typeclass+-- ('Inplicative') doesn't have too many useful instances.  Instead, you+-- are probably going to run it into either 'Applicative' instance (to+-- "produce" an @a@ from a @'DivAp' f a@) with 'runCoDivAp', or+-- a 'Divisible' instance (to "consume" an @a@ from a @'DivAp' f a@) with+-- 'runContraDivAp'. ----- You can also extract the 'Ap' part out using 'divApAp', and extract the--- 'Div' part out using 'divApDiv'.+-- If you think of this type as a combination of 'Ap' and 'Div', then+-- you can also extract the 'Ap' part out using 'divApAp', and+-- extract the 'Div' part out using 'divApDiv'. -- -- Note that this type's utility is similar to that of @'PreT' 'Ap'@, -- except @'PreT' 'Ap'@ lets you use 'Applicative' typeclass methods to@@ -489,26 +480,19 @@ -- handle the interpreting; the @a@ is sent to that @f@, and the single -- result is returned back out. ----- You run this in any 'Alt' context if you want to interpret it--- covariantly, treating @'DecAlt1' f a@ as a /producer/ of @a@, using--- 'runCoDecAlt1'.  You can run this in any 'Decide' context if you you--- want to interpret it contravariantly, treating @'DecAlt1' f a@ as--- a /consumer/ of @a@s, using 'runContraDecAlt1'.------ Because there is no typeclass that combines both 'Alt' and--- 'Decide', this type is a little bit tricker to construct/use than--- 'NonEmptyF' or 'Dec1'.+-- To do this, the main tools to combine 'DecAlt1's are its 'Inalt'+-- instance, using 'swerve' to combine two 'DecAlt1's in a choice-like+-- manner (with the choosing and re-injecting function). ----- *  Instead of '<!>' and 'decide' (typeclass methods), use---    'Data.Functor.Invariant.DecAlt.swerve1' and other variants, which---    work specifically on this type only.--- *  Instead of using 'interpret' (to run in a typeclass), either use---    'runCoDecAlt1' (to run in 'Alt'), 'runContraDecAlt1' (to run in---    'Decide'), or 'foldDecAlt1' (to interpret by manually providing---    handlers)+-- This does have an 'Interpret' function, but the target typeclass+-- ('Inalt') doesn't have too many useful instances.  Instead, you are+-- probably going to run it into either an 'Alt' instance (to "produce" an+-- @a@ from a @'DecAlt1' f a@) with 'runCoDecAlt1', or a 'Decide' instance+-- (to "consume" an @a@ from a @'DecAlt1' f a@) with 'runContraDecAlt1'. ----- You can also extract the 'NonEmptyF' part out using 'decAltNonEmptyF', and--- extract the 'Dec1' part out using 'decAltDec1'.+-- If you think of this type as a combination of 'NonEmptyF' and 'Dec1',+-- then you can also extract the 'NonEmptyF' part out using+-- 'decAltNonEmptyF', and extract the 'Dec1' part out using 'decAltDec1'. -- -- Note that this type's utility is similar to that of @'PostT' 'Dec1'@, -- except @'PostT' 'Dec1'@ lets you use 'Decide' typeclass methods to@@ -538,6 +522,10 @@           )       . unDecAlt1 +-- | A free 'Inalt'+instance Inalt f => Interpret DecAlt1 f where+    interpret f (DecAlt1_ x) = foldChain1 f (IN.runNight f id) x+ -- | The invariant version of 'ListF' and 'Dec': combines the capabilities of -- both 'ListF' and 'Dec' together. --@@ -547,27 +535,20 @@ -- interpreting; the @a@ is sent to that @f@, and the single result is -- returned back out. ----- You run this in any 'Plus' context if you want to interpret it--- covariantly, treating @'DecAlt' f a@ as a /producer/ of @a@, using--- 'runCoDecAlt'.  You can run this in any 'Conclude' context if you you--- want to interpret it contravariantly, treating @'DecAlt' f a@ as--- a /consumer/ of @a@s, using 'runContraDecAlt'.------ Because there is no typeclass that combines both 'Plus' and--- 'Conclude', this type is a little bit tricker to construct/use than--- 'ListF' or 'Dec'.+-- To do this, the main tools to combine 'DecAlt's are its 'Inalt'+-- instance, using 'swerve' to combine two 'DecAlt's in a choice-like+-- manner (with the choosing and re-injecting function), and its 'Inplus'+-- instance, using 'reject' to create an "empty" choice that is never+-- taken. ----- *  Instead of '<!>' and 'decide' (typeclass methods), use---    'Data.Functor.Invariant.DecAlt.swerve' and other variants, which work---    specifically on this type only.--- *  Instead of 'empty' and 'conclude' (typeclass methods), use---    'Data.Functor.Invariant.DecAlt.Reject'.--- *  Instead of using 'interpret' (to run in a typeclass), either use---    'runCoDecAlt' (to run in 'Plus'), 'runContraDecAlt' (to run in---    'Conclude'), or 'foldDecAlt' (to interpret by manually providing---    handlers)+-- This does have an 'Interpret' function, but the target typeclass+-- ('Inplus') doesn't have too many useful instances.  Instead, you are+-- probably going to run it into either 'Plus' instance (to "produce" an+-- @a@ from a @'DecAlt' f a@) with 'runCoDecAlt', or a 'Choose' instance+-- (to "consume" an @a@ from a @'DecAlt' f a@) with 'runContraDecAlt'. ----- You can also extract the 'ListF' part out using 'decAltListF', and+-- If you think of this type as a combination of 'ListF' and 'Dec', then+-- you can also extract the 'ListF' part out using 'decAltListF', and -- extract the 'Dec' part out using 'decAltDec'. -- -- Note that this type's utility is similar to that of @'PostT' 'Dec'@,@@ -579,7 +560,7 @@   deriving (Invariant, HFunctor)  instance Inject DecAlt where-    inject x = DecAlt $ More (IN.Night x (Done IN.refuted) Left id absurd)+    inject x = DecAlt $ More (IN.Night x (Done IN.refuted) id absurd Left)  instance HTraversable DecAlt where     htraverse f =@@ -590,3 +571,6 @@           )       . unDecAlt +-- | A free 'Inplus'+instance Inplus f => Interpret DecAlt f where+    interpret f (DecAlt x) = foldChain (reject . IN.refute) (IN.runNight f id) x

@@ -41,6 +41,10 @@ import           Data.Functor.Contravariant.Divisible.Free import           Data.Functor.Coyoneda import           Data.Functor.Invariant+import           Data.Functor.Invariant.Inplicative+import           Data.Functor.Invariant.Inplicative.Free+import           Data.Functor.Invariant.Internative+import           Data.Functor.Invariant.Internative.Free import           Data.Functor.Plus import           Data.HFunctor import           Data.HFunctor.Interpret@@ -287,6 +291,62 @@ instance Invariant (Final Invariant f) where     invmap f g = liftFinal1 (invmap f g) +-- | @since 0.4.0.0+instance Invariant (Final Inply f) where+    invmap f g = liftFinal1 (invmap f g)+-- | @since 0.4.0.0+instance Inply (Final Inply f) where+    gather f g = liftFinal2 (gather f g)+    gathered = liftFinal2 gathered++-- | @since 0.4.0.0+instance Invariant (Final Inplicative f) where+    invmap f g = liftFinal1 (invmap f g)+-- | @since 0.4.0.0+instance Inply (Final Inplicative f) where+    gather f g = liftFinal2 (gather f g)+    gathered = liftFinal2 gathered+-- | @since 0.4.0.0+instance Inplicative (Final Inplicative f) where+    knot x = liftFinal0 (knot x)++-- | @since 0.4.0.0+instance Invariant (Final Inalt f) where+    invmap f g = liftFinal1 (invmap f g)+-- | @since 0.4.0.0+instance Inalt (Final Inalt f) where+    swerve f g h = liftFinal2 (swerve f g h)+    swerved = liftFinal2 swerved++-- | @since 0.4.0.0+instance Invariant (Final Inplus f) where+    invmap f g = liftFinal1 (invmap f g)+-- | @since 0.4.0.0+instance Inalt (Final Inplus f) where+    swerve f g h = liftFinal2 (swerve f g h)+    swerved = liftFinal2 swerved+-- | @since 0.4.0.0+instance Inplus (Final Inplus f) where+    reject f = liftFinal0 (reject f)++-- | @since 0.4.0.0+instance Invariant (Final Internative f) where+    invmap f g = liftFinal1 (invmap f g)+-- | @since 0.4.0.0+instance Inply (Final Internative f) where+    gather f g = liftFinal2 (gather f g)+    gathered = liftFinal2 gathered+-- | @since 0.4.0.0+instance Inplicative (Final Internative f) where+    knot x = liftFinal0 (knot x)+-- | @since 0.4.0.0+instance Inalt (Final Internative f) where+    swerve f g h = liftFinal2 (swerve f g h)+    swerved = liftFinal2 swerved+-- | @since 0.4.0.0+instance Inplus (Final Internative f) where+    reject f = liftFinal0 (reject f)+ -- | Re-interpret the context under a 'Final'. hoistFinalC     :: (forall g x. (c g => g x) -> (d g => g x))@@ -413,4 +473,12 @@ instance FreeOf Decide        Dec1 -- | @since 0.3.0.0 instance FreeOf Conclude      Dec+-- | @since 0.4.0.0+instance FreeOf Inply         DivAp1    where type FreeFunctorBy DivAp1 = Invariant+-- | @since 0.4.0.0+instance FreeOf Inplicative   DivAp+-- | @since 0.4.0.0+instance FreeOf Inalt         DecAlt1   where type FreeFunctorBy DecAlt1 = Invariant+-- | @since 0.4.0.0+instance FreeOf Inplus        DecAlt instance FreeOf Unconstrained IdentityT

@@ -26,10 +26,10 @@ module Data.HFunctor.HTraversable (   -- * 'HTraversable'     HTraversable(..)-  , hsequence, hfoldMap, htoList, hmapDefault+  , hsequence, hfoldMap, htoList, hmapDefault, hfor   -- * 'HTraversable1'   , HTraversable1(..)-  , hsequence1, hfoldMap1, htoNonEmpty+  , hsequence1, hfoldMap1, htoNonEmpty, hfor1   ) where  import           Control.Applicative@@ -114,6 +114,12 @@ htoNonEmpty :: HTraversable1 t => (forall x. f x -> b) -> t f a -> NonEmpty b htoNonEmpty f = fromNDL . hfoldMap1 (ndlSingleton . f) +-- | A flipped version of 'htraverse1'.+--+-- @since 0.4.0.0+hfor1 :: (HTraversable1 t, Apply h) => t f a -> (forall x. f x -> h (g x)) -> h (t g a)+hfor1 x f = htraverse1 f x+ -- | A higher-kinded version of 'Traversable', in the same way that -- 'HFunctor' is the higher-kinded version of 'Functor'.  Gives you an -- "effectful" 'hmap', in the same way that 'traverse' gives you an@@ -151,6 +157,12 @@ -- @since 0.3.6.0 htoList :: HTraversable t => (forall x. f x -> b) -> t f a -> [b] htoList f = flip appEndo [] . hfoldMap (Endo . (:) . f)++-- | A flipped version of 'htraverse'.+--+-- @since 0.4.0.0+hfor :: (HTraversable t, Applicative h) => t f a -> (forall x. f x -> h (g x)) -> h (t g a)+hfor x f = htraverse f x  -- | An implementation of 'hmap' defined using 'htraverse'. --

@@ -1,4 +1,5 @@-{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DerivingVia           #-}+{-# OPTIONS_HADDOCK hide, not-home #-}  module Data.HFunctor.Internal (     HFunctor(..)

@@ -38,6 +38,8 @@   ) where  import           Control.Natural+import           Data.Functor.Invariant.Inplicative+import           Data.Functor.Invariant.Internative import           Data.Functor.Bind import           Data.Functor.Contravariant import           Data.Functor.Contravariant.Conclude@@ -557,6 +559,16 @@     ProPre x <!> ProPre y = ProPre (x <!> y) -- | @since 0.3.4.1 deriving instance Invariant (t (Pre a f)) => Invariant (ProPre t f a)+-- | @since 0.4.0.0.0+deriving instance Inply (t (Pre a f)) => Inply (ProPre t f a)+-- | @since 0.4.0.0.0+deriving instance Inplicative (t (Pre a f)) => Inplicative (ProPre t f a)+-- | @since 0.4.0.0.0+deriving instance Inalt (t (Pre a f)) => Inalt (ProPre t f a)+-- | @since 0.4.0.0.0+deriving instance Inplus (t (Pre a f)) => Inplus (ProPre t f a)+-- | @since 0.4.0.0.0+deriving instance Internative (t (Pre a f)) => Internative (ProPre t f a) -- | @since 0.3.4.1 deriving instance Semigroup (t (Pre a f) b) => Semigroup (ProPre t f a b) -- | @since 0.3.4.1