functor-combinators 0.3.4.2 → 0.3.5.0

raw patch · 10 files changed

+935/−786 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• functor-combinators.cabal +4/−4
• src/Control/Natural/IsoF.hs +2/−0
• src/Data/Functor/Invariant/Day/Chain.hs +0/−397
• src/Data/Functor/Invariant/DecAlt.hs +354/−0
• src/Data/Functor/Invariant/DivAp.hs +422/−0
• src/Data/Functor/Invariant/Night/Chain.hs +0/−327
• src/Data/HBifunctor/Associative.hs +2/−2
• src/Data/HBifunctor/Tensor.hs +4/−4
• src/Data/HFunctor/Chain/Internal.hs +135/−52

@@ -1,6 +1,18 @@ Changelog ========= +Version 0.3.5.0+---------------++*August 15, 2020*++<https://github.com/mstksg/functor-combinators/releases/tag/v0.3.5.0>++*   `DayChain` and `NightChain` renamed to `DivAp` and `DecAlt`, to better+    reflect their abstracted nature ever since *0.3.4.0*.  The modules are+    renamed to *Data.Functor.Invariant.DivAp* and+    *Data.Functor.Invariant.DecAlt*.+ Version 0.3.4.0 --------------- 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 30f4ef1eb5a260098c2bb6ed5f7db568e418a2254181c3d14ad09dea45de2798+-- hash: 29ea615f649da19336efe3cd784f64de049f92e459aea6f853605f1e4a82af91  name:           functor-combinators-version:        0.3.4.2+version:        0.3.5.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,9 +59,9 @@       Data.Functor.Contravariant.Divise       Data.Functor.Contravariant.Divisible.Free       Data.Functor.Contravariant.Night-      Data.Functor.Invariant.Day.Chain+      Data.Functor.Invariant.DecAlt+      Data.Functor.Invariant.DivAp       Data.Functor.Invariant.Night-      Data.Functor.Invariant.Night.Chain       Data.HBifunctor       Data.HBifunctor.Associative       Data.HBifunctor.Tensor

@@ -72,6 +72,8 @@     -> f <~> g isoF = dimap +-- | An isomorphism between two functors that are coercible/have the same+-- internal representation.  Useful for newtype wrappers. coercedF :: (forall x. Coercible (f x) (g x), forall x. Coercible (g x) (f x)) => f <~> g coercedF = isoF coerce coerce 

@@ -1,397 +0,0 @@---- |--- Module      : Data.Functor.Invariant.Day--- Copyright   : (c) Justin Le 2019--- License     : BSD3------ Maintainer  : justin@jle.im--- Stability   : experimental--- Portability : non-portable------ Provides an 'Invariant' version of the typical Haskell Day convolution--- over tuples.------ @since 0.3.0.0-module Data.Functor.Invariant.Day.Chain (-  -- * Chain-    DayChain(.., Gather, Knot)-  , runCoDayChain-  , runContraDayChain-  , chainAp-  , chainDiv-  , gather, gathered-  , assembleDayChain-  , assembleDayChainRec-  , concatDayChain-  , concatDayChainRec-  -- * Nonempty Chain-  , DayChain1(.., DayChain1)-  , runCoDayChain1-  , runContraDayChain1-  , chainAp1-  , chainDiv1-  , gather1, gathered1-  , assembleDayChain1-  , assembleDayChain1Rec-  , concatDayChain1-  , concatDayChain1Rec-  -- * 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'.-runCoDayChain1-    :: forall f g. Apply g-    => f ~> g-    -> DayChain1 f ~> g-runCoDayChain1 f = foldChain1 f (runDayApply f id) . unDayChain1---- | In the contravariant direction, we can interpret out of a 'Chain1' of--- 'Day' into any 'Divise'.-runContraDayChain1-    :: forall f g. Divise g-    => f ~> g-    -> DayChain1 f ~> g-runContraDayChain1 f = foldChain1 f (runDayDivise f id) . unDayChain1---- | In the covariant direction, we can interpret out of a 'Chain' of 'Day'--- into any 'Applicative'.-runCoDayChain-    :: forall f g. Applicative g-    => f ~> g-    -> DayChain f ~> g-runCoDayChain f = foldChain (pure . runIdentity) (\case Day x y h _ -> liftA2 h (f x) y)-                . unDayChain---- | In the contravariant direction, we can interpret out of a 'Chain' of--- 'Day' into any 'Divisible'.-runContraDayChain-    :: forall f g. Divisible g-    => f ~> g-    -> DayChain f ~> g-runContraDayChain f = foldChain (const conquer) (\case Day x y _ g -> divide g (f x) y)-                    . unDayChain---- | Extract the 'Ap' part out of a 'DayChain', shedding the--- contravariant bits.------ @since 0.3.2.0-chainAp :: DayChain f ~> Ap f-chainAp = runCoDayChain inject---- | Extract the 'Ap1' part out of a 'DayChain1', shedding the--- contravariant bits.------ @since 0.3.2.0-chainAp1 :: DayChain1 f ~> Ap1 f-chainAp1 = runCoDayChain1 inject---- | Extract the 'Div' part out of a 'DayChain', shedding the--- covariant bits.------ @since 0.3.2.0-chainDiv :: DayChain f ~> Div f-chainDiv = runContraDayChain inject---- | Extract the 'Div1' part out of a 'DayChain1', shedding the--- covariant bits.------ @since 0.3.2.0-chainDiv1 :: DayChain1 f ~> Div1 f-chainDiv1 = runContraDayChain1 inject---- | Match on a non-empty 'DayChain'; 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 -> DayChain f c -> DayChain f a-pattern Gather f g x xs <- (unGather_->MaybeF (Just (Day x xs g f)))-  where-    Gather f g x xs = DayChain $ More $ Day x (unDayChain xs) g f--unGather_ :: DayChain f ~> MaybeF (Day f (DayChain f))-unGather_ = \case-  DayChain (More (Day x xs g f)) -> MaybeF . Just $ Day x (DayChain xs) g f-  DayChain (Done _             ) -> MaybeF Nothing---- | Match on an "empty" 'DayChain'; contains no @f@s, but only the--- terminal value.  Analogous to 'Control.Applicative.Free.Pure'.-pattern Knot :: a -> DayChain f a-pattern Knot x = DayChain (Done (Identity x))-{-# COMPLETE Gather, Knot #-}---- | Match on a 'DayChain1' to get the head and the rest of the items.--- Analogous to the 'Data.Functor.Apply.Free.Ap1' constructor.-pattern DayChain1 :: Invariant f => (a -> (b, c)) -> (b -> c -> a) -> f b -> DayChain f c -> DayChain1 f a-pattern DayChain1 f g x xs <- (coerce splitChain1->Day x xs g f)-  where-    DayChain1 f g x xs = unsplitNE $ Day x xs g f-{-# COMPLETE DayChain1 #-}---- | Invariantly combine two 'DayChain'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)-    -> DayChain f b-    -> DayChain f c-    -> DayChain 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-    :: DayChain f a-    -> DayChain f b-    -> DayChain f (a, b)-gathered = gather id (,)---- | Invariantly combine two 'DayChain1'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)-    -> DayChain1 f b-    -> DayChain1 f c-    -> DayChain1 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-    => DayChain1 f a-    -> DayChain1 f b-    -> DayChain1 f (a, b)-gathered1 = gather1 id (,)---- | Convenient wrapper to build up a 'DayChain' 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) $---   assembleDayChain $ 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.-assembleDayChain-    :: NP f as-    -> DayChain f (NP I as)-assembleDayChain = \case-    Nil     -> DayChain $ Done $ Identity Nil-    x :* xs -> DayChain $ More $ Day-      x-      (unDayChain (assembleDayChain xs))-      consNPI-      unconsNPI---- | A version of 'assembleDayChain' where each component is itself--- a 'DayChain'.------ @--- assembleDayChain (x :* y :* z :* Nil)---   = concatDayChain (injectChain x :* injectChain y :* injectChain z :* Nil)--- @-concatDayChain-    :: NP (DayChain f) as-    -> DayChain f (NP I as)-concatDayChain = \case-    Nil     -> DayChain $ Done $ Identity Nil-    x :* xs -> coerce appendChain $ Day-      x-      (concatDayChain xs)-      consNPI-      unconsNPI---- | A version of 'assembleDayChain' but for 'DayChain1' instead.  Can be--- useful if you intend on interpreting it into something with only--- a 'Divise' or 'Apply' instance, but no 'Divisible' or 'Applicative'.-assembleDayChain1-    :: Invariant f-    => NP f (a ': as)-    -> DayChain1 f (NP I (a ': as))-assembleDayChain1 = \case-    x :* xs -> DayChain1_ $ case xs of-      Nil    -> Done1 $ invmap ((:* Nil) . I) (unI . hd) x-      _ :* _ -> More1 $ Day-        x-        (unDayChain1 (assembleDayChain1 xs))-        consNPI-        unconsNPI---- | A version of 'concatDayChain' but for 'DayChain1' instead.  Can be--- useful if you intend on interpreting it into something with only--- a 'Divise' or 'Apply' instance, but no 'Divisible' or 'Applicative'.-concatDayChain1-    :: Invariant f-    => NP (DayChain1 f) (a ': as)-    -> DayChain1 f (NP I (a ': as))-concatDayChain1 = \case-    x :* xs -> case xs of-      Nil    -> invmap ((:* Nil) . I) (unI . hd) x-      _ :* _ -> coerce appendChain1 $ Day-        x-        (concatDayChain1 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 'assembleDayChain' 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) $---   assembleDayChainRec $ intPrim---                      :& boolPrim---                      :& stringPrim---                      :& Nil--- @-assembleDayChainRec-    :: V.Rec f as-    -> DayChain f (V.XRec V.Identity as)-assembleDayChainRec = \case-    V.RNil    -> DayChain $ Done $ Identity V.RNil-    x V.:& xs -> DayChain $ More $ Day-      x-      (unDayChain (assembleDayChainRec xs))-      (V.::&)-      unconsRec---- | A version of 'concatDayChain' 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.-concatDayChainRec-    :: V.Rec (DayChain f) as-    -> DayChain f (V.XRec V.Identity as)-concatDayChainRec = \case-    V.RNil    -> DayChain $ Done $ Identity V.RNil-    x V.:& xs -> coerce appendChain $ Day-      x-      (concatDayChainRec xs)-      (V.::&)-      unconsRec---- | A version of 'assembleDayChain1' 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.-assembleDayChain1Rec-    :: Invariant f-    => V.Rec f (a ': as)-    -> DayChain1 f (V.XRec V.Identity (a ': as))-assembleDayChain1Rec = \case-    x V.:& xs -> case xs of-      V.RNil   -> DayChain1_ $ Done1 $ invmap (V.::& V.RNil) (\case z V.::& _ -> z) x-      _ V.:& _ -> DayChain1_ $ More1 $ Day-        x-        (unDayChain1 (assembleDayChain1Rec xs))-        (V.::&)-        unconsRec---- | A version of 'concatDayChain1' 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.-concatDayChain1Rec-    :: Invariant f-    => V.Rec (DayChain1 f) (a ': as)-    -> DayChain1 f (V.XRec V.Identity (a ': as))-concatDayChain1Rec = \case-    x V.:& xs -> case xs of-      V.RNil   -> invmap (V.::& V.RNil) (\case z V.::& _ -> z) x-      _ V.:& _ -> coerce appendChain1 $ Day-        x-        (concatDayChain1Rec 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,354 @@++-- |+-- 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

@@ -0,0 +1,422 @@++-- |+-- 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)

@@ -1,327 +0,0 @@--module Data.Functor.Invariant.Night.Chain (-  -- * Chain-    NightChain-  , pattern Swerve, pattern Reject-  , runCoNightChain-  , runContraNightChain-  , chainListF-  , chainListF_-  , chainDec-  , swerve, swerved-  , assembleNightChain-  , concatNightChain-  -- * Nonempty Chain-  , NightChain1-  , pattern NightChain1-  , runCoNightChain1-  , runContraNightChain1-  , chainNonEmptyF-  , chainNonEmptyF_-  , chainDec1-  , swerve1, swerved1-  , assembleNightChain1-  , concatNightChain1-  ) 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'.-runCoNightChain1-    :: forall f g. Alt g-    => f ~> g-    -> NightChain1 f ~> g-runCoNightChain1 f = foldChain1 f (runNightAlt f id)-                   . unNightChain1---- | In the contravariant direction, we can interpret out of a 'Chain1' of--- 'Night' into any 'Decide'.-runContraNightChain1-    :: forall f g. Decide g-    => f ~> g-    -> NightChain1 f ~> g-runContraNightChain1 f = foldChain1 f (runNightDecide f id)-                       . unNightChain1---- | Extract the 'Dec' part out of a 'NightChain', shedding the--- covariant bits.-chainDec :: NightChain f ~> Dec f-chainDec = runContraNightChain inject---- | Extract the 'Dec1' part out of a 'NightChain1', shedding the--- covariant bits.-chainDec1 :: NightChain1 f ~> Dec1 f-chainDec1 = runContraNightChain1 inject---- | In the covariant direction, we can interpret out of a 'Chain' of 'Night'--- into any 'Plus'.-runCoNightChain-    :: forall f g. Plus g-    => f ~> g-    -> NightChain f ~> g-runCoNightChain f = foldChain (const zero) (runNightAlt f id)-                  . unNightChain---- | In the contravariant direction, we can interpret out of a 'Chain' of--- 'Night' into any 'Conclude'.-runContraNightChain-    :: forall f g. Conclude g-    => f ~> g-    -> NightChain f ~> g-runContraNightChain f = foldChain (conclude . refute) (runNightDecide f id)-                      . unNightChain---- | Extract the 'ListF' part out of a 'NightChain', shedding the--- contravariant bits.------ @since 0.3.2.0-chainListF :: Functor f => NightChain f ~> ListF f-chainListF = runCoNightChain inject---- | Extract the 'ListF' part out of a 'NightChain', 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-chainListF_ :: NightChain f ~> CT.ComposeT ListF CY.Coyoneda f-chainListF_ = foldChain (const (CT.ComposeT (ListF []))) (\case-    Night x (CT.ComposeT (ListF xs)) _ f g -> CT.ComposeT . ListF $-      CY.Coyoneda f x : (map . fmap) g xs-    ) . unNightChain---- | Extract the 'NonEmptyF' part out of a 'NightChain1', shedding the--- contravariant bits.------ @since 0.3.2.0-chainNonEmptyF :: Functor f => NightChain1 f ~> NonEmptyF f-chainNonEmptyF = runCoNightChain1 inject---- | Extract the 'NonEmptyF' part out of a 'NightChain1', 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-chainNonEmptyF_ :: NightChain1 f ~> CT.ComposeT NonEmptyF CY.Coyoneda f-chainNonEmptyF_ = foldChain1 inject (\case-    Night x (CT.ComposeT (NonEmptyF xs)) _ f g -> CT.ComposeT . NonEmptyF $-      CY.Coyoneda f x NE.<| (fmap . fmap) g xs-    ) . unNightChain1----- | Match on a non-empty 'NightChain'; 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 -> NightChain f c -> NightChain 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 = NightChain $ More $ Night x (unNightChain xs) f g h--unSwerve_ :: NightChain f ~> MaybeF (Night f (NightChain f))-unSwerve_ = \case-  NightChain (More (Night x xs g f h)) -> MaybeF . Just $ Night x (NightChain xs) g f h-  NightChain (Done _                 ) -> MaybeF Nothing----- | Match on an "empty" 'NightChain'; contains no @f@s, but only the--- terminal value.  Analogous to the--- 'Data.Functor.Contravariant.Divisible.Free.Lose' constructor.-pattern Reject :: (a -> Void) -> NightChain f a-pattern Reject x = NightChain (Done (Not x))-{-# COMPLETE Swerve, Reject #-}---- | Match on a 'NightChain1' to get the head and the rest of the items.--- Analogous to the 'Data.Functor.Contravariant.Divisible.Free.Dec1'--- constructor.-pattern NightChain1 :: Invariant f => (a -> Either b c) -> (b -> a) -> (c -> a) -> f b -> NightChain f c -> NightChain1 f a-pattern NightChain1 f g h x xs <- (coerce splitChain1->Night x xs f g h)-  where-    NightChain1 f g h x xs = unsplitNE $ Night x xs f g h-{-# COMPLETE NightChain1 #-}---- | Invariantly combine two 'NightChain'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)-    -> NightChain f b-    -> NightChain f c-    -> NightChain 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-    :: NightChain f a-    -> NightChain f b-    -> NightChain f (Either a b)-swerved = swerve id Left Right---- | Invariantly combine two 'NightChain1'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)-    -> NightChain1 f b-    -> NightChain1 f c-    -> NightChain1 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-    => NightChain1 f a-    -> NightChain1 f b-    -> NightChain1 f (Either a b)-swerved1 = swerve1 id Left Right---- | Convenient wrapper to build up a 'NightChain' 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) $---   assembleNightChain $ 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.-assembleNightChain-    :: NP f as-    -> NightChain f (NS I as)-assembleNightChain = \case-    Nil     -> NightChain $ Done $ Not (\case {})-    x :* xs -> NightChain $ More $ Night-      x-      (unNightChain $ assembleNightChain xs)-      unconsNSI-      (Z . I)-      S---- | A version of 'assembleNightChain' where each component is itself--- a 'NightChain'.------ @--- assembleNightChain (x :* y :* z :* Nil)---   = concatNightChain (injectChain x :* injectChain y :* injectChain z :* Nil)--- @-concatNightChain-    :: NP (NightChain f) as-    -> NightChain f (NS I as)-concatNightChain = \case-    Nil     -> NightChain $ Done $ Not (\case {})-    x :* xs -> coerce appendChain $ Night-      x-      (unNightChain $ concatNightChain xs)-      unconsNSI-      (Z . I)-      S---- | A version of 'assembleNightChain' but for 'NightChain1' 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'.-assembleNightChain1-    :: Invariant f-    => NP f (a ': as)-    -> NightChain1 f (NS I (a ': as))-assembleNightChain1 = \case-    x :* xs -> NightChain1_ $ case xs of-      Nil    -> Done1 $ invmap (Z . I) (unI . unZ) x-      _ :* _ -> More1 $ Night-        x-        (unNightChain1 $ assembleNightChain1 xs)-        unconsNSI-        (Z . I)-        S---- | A version of 'concatNightChain' but for 'NightChain1' 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'.-concatNightChain1-    :: Invariant f-    => NP (NightChain1 f) (a ': as)-    -> NightChain1 f (NS I (a ': as))-concatNightChain1 = \case-    x :* xs -> case xs of-      Nil    -> invmap (Z . I) (unI . unZ) x-      _ :* _ -> coerce appendChain1 $ Night-        x-        (unNightChain1 $ concatNightChain1 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

@@ -503,7 +503,7 @@     binterpret f g (CD.Day x y h) = divise h (f x) (g y)  instance Associative ID.Day where-    type NonEmptyBy ID.Day = DayChain1+    type NonEmptyBy ID.Day = DivAp1     type FunctorBy ID.Day = Invariant     associating = isoF assoc disassoc @@ -522,7 +522,7 @@       (B.assoc . first h . f)  instance Associative IN.Night where-    type NonEmptyBy IN.Night = NightChain1+    type NonEmptyBy IN.Night = DecAlt1     type FunctorBy IN.Night = Invariant     associating = isoF IN.assoc IN.unassoc 

@@ -461,7 +461,7 @@     pureT _ = conquer  instance Tensor ID.Day Identity where-    type ListBy ID.Day = DayChain+    type ListBy ID.Day = DivAp      intro1 = ID.intro2     intro2 = ID.intro1@@ -472,7 +472,7 @@     splitNE = coerce splitChain1     splittingLB = coercedF . splittingChain . coercedF -    toListBy = DayChain . More . hright (unDayChain . inject)+    toListBy = DivAp . More . hright (unDivAp . inject)  instance Matchable ID.Day Identity where     unsplitNE = coerce unsplitNEIDay_@@ -489,7 +489,7 @@   More xs -> R1 $ unsplitNEIDay_ xs  instance Tensor IN.Night IN.Not where-    type ListBy IN.Night = NightChain+    type ListBy IN.Night = DecAlt      intro1 = IN.intro2     intro2 = IN.intro1@@ -500,7 +500,7 @@     splitNE = coerce splitChain1     splittingLB = coercedF . splittingChain . coercedF -    toListBy = NightChain . More . hright (unNightChain . inject)+    toListBy = DecAlt . More . hright (unDecAlt . inject)  instance Matchable IN.Night Not where     unsplitNE = coerce unsplitNEINight_

@@ -7,10 +7,10 @@   , Chain(..)   , foldChain, unfoldChain   , splittingChain, unconsChain-  , DayChain1(..)-  , DayChain(..)-  , NightChain(..)-  , NightChain1(..)+  , DivAp1(..)+  , DivAp(..)+  , DecAlt(..)+  , DecAlt1(..)   ) where  import           Control.Natural@@ -342,65 +342,148 @@     Done x  -> L1 x     More xs -> R1 xs --- | Instead of defining yet another separate free semigroup like--- 'Data.Functor.Apply.Free.Ap1',--- 'Data.Functor.Contravariant.Divisible.Free.Div1', or--- 'Data.Functor.Contravariant.Divisible.Free.Dec1', we re-use 'Chain1'.+-- | The invariant version of 'Ap1' and 'Div1': combines the capabilities+-- of both 'Ap1' and 'Div1' together. ----- You can assemble values using the combinators in "Data.HFunctor.Chain",--- and then tear them down/interpret them using 'runCoDayChain1' and--- 'runContraDayChain1'.  There is no general invariant interpreter (and so no--- 'SemigroupIn' instance for 'Day') because the typeclasses used to--- express the target contexts are probably not worth defining given how--- little the Haskell ecosystem uses invariant functors as an abstraction.-newtype DayChain1 f a = DayChain1_ { unDayChain1 :: Chain1 ID.Day f a }+-- Conceptually you can think of @'DivAp1' f a@ as a way of consuming and+-- producing @a@s that contains a (non-empty) collection of @f x@s of+-- different @x@s. 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 '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'.+--+-- *  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)+--+-- You can also extract the 'Ap1' part out using 'divApAp1', and extract the+-- 'Div1' part out using 'divApDiv1'.+--+-- @since 0.3.5.0+newtype DivAp1 f a = DivAp1_ { unDivAp1 :: Chain1 ID.Day f a }   deriving (Invariant, HFunctor, Inject) --- | Instead of defining yet another separate free monoid like--- 'Control.Applicative.Free.Ap',--- 'Data.Functor.Contravariant.Divisible.Free.Div', or--- 'Data.Functor.Contravariant.Divisible.Free.Dec', we re-use 'Chain'.+-- | The invariant version of 'Ap' and 'Div': combines the capabilities of+-- both 'Ap' and 'Div' together. ----- You can assemble values using the combinators in "Data.HFunctor.Chain",--- and then tear them down/interpret them using 'runCoDayChain' and--- 'runContraDayChain'.  There is no general invariant interpreter (and so no--- 'MonoidIn' instance for 'Day') because the typeclasses used to express--- the target contexts are probably not worth defining given how little the--- Haskell ecosystem uses invariant functors as an abstraction.-newtype DayChain f a = DayChain { unDayChain :: Chain ID.Day Identity f a }+-- Conceptually you can think of @'DivAp' f a@ as a way of consuming and+-- producing @a@s that contains a collection of @f x@s of different @x@s.+-- 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'.+--+-- *  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)+--+-- You can also extract the 'Ap' part out using 'divApAp', and extract the+-- 'Div' part out using 'divApDiv'.+--+-- @since 0.3.5.0+newtype DivAp f a = DivAp { unDivAp :: Chain ID.Day Identity f a }   deriving (Invariant, HFunctor) -instance Inject DayChain where-    inject x = DayChain $ More (ID.Day x (Done (Identity ())) const (,()))+instance Inject DivAp where+    inject x = DivAp $ More (ID.Day x (Done (Identity ())) const (,())) --- | Instead of defining yet another separate free semigroup like--- 'Data.Functor.Apply.Free.Ap1',--- 'Data.Functor.Contravariant.Divisible.Free.Div1', or--- 'Data.Functor.Contravariant.Divisible.Free.Dec1', we re-use 'Chain1'.+-- | The invariant version of 'NonEmptyF' and 'Dec1': combines the+-- capabilities of both 'NonEmptyF' and 'Dec1' together. ----- You can assemble values using the combinators in "Data.HFunctor.Chain",--- and then tear them down/interpret them using 'runCoNightChain1' and--- 'runContraNightChain1'.  There is no general invariant interpreter (and so no--- 'SemigroupIn' instance for 'Night') because the typeclasses used to--- express the target contexts are probably not worth defining given how--- little the Haskell ecosystem uses invariant functors as an abstraction.-newtype NightChain1 f a = NightChain1_ { unNightChain1 :: Chain1 IN.Night f a }+-- Conceptually you can think of @'DecAlt1' f a@ as a way of consuming and+-- producing @a@s that contains a (non-empty) collection of @f x@s of+-- different @x@s. When interpreting this, a /specific/ @f@ is chosen to+-- 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'.+--+-- *  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)+--+-- You can also extract the 'NonEmptyF' part out using 'decAltNonEmptyF', and+-- extract the 'Dec1' part out using 'decAltDec1'.+--+-- @since 0.3.5.0+newtype DecAlt1 f a = DecAlt1_ { unDecAlt1 :: Chain1 IN.Night f a }   deriving (Invariant, HFunctor, Inject) --- | Instead of defining yet another separate free monoid like--- 'Control.Applicative.Free.Ap',--- 'Data.Functor.Contravariant.Divisible.Free.Div', or--- 'Data.Functor.Contravariant.Divisible.Free.Dec', we re-use 'Chain'.+-- | The invariant version of 'ListF' and 'Dec': combines the capabilities of+-- both 'ListF' and 'Dec' together. ----- You can assemble values using the combinators in "Data.HFunctor.Chain",--- and then tear them down/interpret them using 'runCoNightChain' and--- 'runContraNightChain'.  There is no general invariant interpreter (and so no--- 'MonoidIn' instance for 'Night') because the typeclasses used to express--- the target contexts are probably not worth defining given how little the--- Haskell ecosystem uses invariant functors as an abstraction.-newtype NightChain f a = NightChain { unNightChain :: Chain IN.Night IN.Not f a }+-- Conceptually you can think of @'DecAlt' f a@ as a way of consuming and+-- producing @a@s that contains a collection of @f x@s of different @x@s.+-- When interpreting this, a /specific/ @f@ is chosen to handle the+-- 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'.+--+-- *  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)+--+-- You can also extract the 'ListF' part out using 'decAltListF', and+-- extract the 'Dec' part out using 'decAltDec'.+--+-- @since 0.3.5.0+newtype DecAlt f a = DecAlt { unDecAlt :: Chain IN.Night IN.Not f a }   deriving (Invariant, HFunctor) -instance Inject NightChain where-    inject x = NightChain $ More (IN.Night x (Done IN.refuted) Left id absurd)+instance Inject DecAlt where+    inject x = DecAlt $ More (IN.Night x (Done IN.refuted) Left id absurd)