summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjle <>2020-08-10 07:08:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-08-10 07:08:00 (GMT)
commit848bda3574ac62fbf6ef544f4dc5edd166a847f7 (patch)
tree8aff7ce22ea683c22fee9765451da1f9281a4fe4
parent3055bae625cc22080f37b459b7496c8e39856ef9 (diff)
version 0.3.2.00.3.2.0
-rw-r--r--CHANGELOG.md33
-rw-r--r--functor-combinators.cabal5
-rw-r--r--src/Data/Functor/Combinator.hs4
-rw-r--r--src/Data/Functor/Invariant/Day.hs64
-rw-r--r--src/Data/Functor/Invariant/Night.hs104
-rw-r--r--src/Data/HBifunctor/Associative.hs62
-rw-r--r--src/Data/HFunctor/Internal.hs15
-rw-r--r--src/Data/HFunctor/Interpret.hs113
8 files changed, 316 insertions, 84 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index a1f3c96..0896872 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,39 @@
Changelog
=========
+Version 0.3.2.0
+---------------
+
+*August 9, 2020*
+
+<https://github.com/mstksg/functor-combinators/releases/tag/v0.3.2.0>
+
+* *Data.HFunctor.Interpret*: `icollect`, `icollect1` now are more
+ constrained: they only work on things that have `Interpret` instances for
+ *all* `Monoid m` or `Semigroup m` in `AltConst m`. While this doesn't
+ affect how it works on any types in this library, it does make the type
+ signature a little more clean (hiding the usage of `DList`) and prevents
+ one from making an odd `Interpret` instance that does something weird with
+ the `DList`. This also allows us to drop the direct *dlist >= 1.0* dependency.
+* *Data.HFunctor.Interpret*: `biapply`, `bifanout`, `bifanout1` added as
+ contravariant consumer versions of `iget`, `icollect`, and `icollect1`.
+* *Data.HBifunctor.Associative*: `bicollect` `bicollect1` removed because
+ they really don't make sense for associative tensors, which can only have
+ at most one of each tensor.
+* *Data.HBifunctor.Associative*: `biapply` added as the contravariant
+ consumer version of `biget`.
+* *Data.Functor.Invariant.Day*: Add conversion functions from chains to the
+ covariant/invariant versions, `chainAp`, `chainAp1`, `chainDiv`, and
+ `chainDiv1`.
+* *Data.Functor.Invariant.Night*: Add conversion functions from chains to the
+ covariant/invariant versions, `chainDec`, `chainDec1`, `chainListF`,
+ `chainNonEmptyF`. Also add "undescored" versions to the covariant
+ versions, `toCoNight_`, `chainListF_`, `chainNonEmptyF_`, to more
+ accurately represent the actual contravariant either-based day convolution.
+ Also changed `Share` to `Swerve`.
+* *Data.Functor.Combinator*: `AltConst` re-exported.
+
+
Version 0.3.1.0
---------------
diff --git a/functor-combinators.cabal b/functor-combinators.cabal
index e6d6025..c0ab684 100644
--- a/functor-combinators.cabal
+++ b/functor-combinators.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: 1a0532f73e7e38dc05fe8b07be016e7013f4f32c9daebe758f093a8abd0f4a45
+-- hash: 7c970e85e59e29124e48109889879a7e961d4b9b33326f5a8eaeffcc117f1ced
name: functor-combinators
-version: 0.3.1.0
+version: 0.3.2.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"
@@ -83,7 +83,6 @@ library
, containers
, contravariant
, deriving-compat
- , dlist >=1.0
, free
, invariant
, kan-extensions
diff --git a/src/Data/Functor/Combinator.hs b/src/Data/Functor/Combinator.hs
index 7c00116..acba445 100644
--- a/src/Data/Functor/Combinator.hs
+++ b/src/Data/Functor/Combinator.hs
@@ -44,6 +44,7 @@ module Data.Functor.Combinator (
, Interpret(..)
, forI
, iget, icollect, icollect1
+ , iapply, ifanout, ifanout1
, getI, collectI
, AltConst(..)
-- ** Multi-Functors
@@ -53,7 +54,8 @@ module Data.Functor.Combinator (
-- *** Associative
, Associative(..)
, SemigroupIn(..)
- , biget, bicollect, bicollect1
+ , biget, biapply
+ -- , biget, bicollect, bicollect1
, (!*!)
, (!+!)
, (!$!)
diff --git a/src/Data/Functor/Invariant/Day.hs b/src/Data/Functor/Invariant/Day.hs
index de30fbc..d03dd8e 100644
--- a/src/Data/Functor/Invariant/Day.hs
+++ b/src/Data/Functor/Invariant/Day.hs
@@ -29,6 +29,8 @@ module Data.Functor.Invariant.Day (
, pattern Gather, pattern Knot
, runCoDayChain
, runContraDayChain
+ , chainAp
+ , chainDiv
, assembleDayChain
, assembleDayChainRec
, concatDayChain
@@ -38,37 +40,41 @@ module Data.Functor.Invariant.Day (
, pattern DayChain1
, runCoDayChain1
, runContraDayChain1
+ , chainAp1
+ , chainDiv1
, assembleDayChain1
, assembleDayChain1Rec
, concatDayChain1
, concatDayChain1Rec
) where
+import Control.Applicative
+import Control.Applicative.Free (Ap)
import Control.Natural
import Control.Natural.IsoF
import Data.Bifunctor
import Data.Functor.Apply
-import Data.Functor.Combinator.Unsafe
+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.HBifunctor
-import Data.HBifunctor.Associative hiding (assoc)
-import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)
+import Data.HBifunctor.Associative hiding (assoc)
+import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)
import Data.HFunctor
import Data.HFunctor.Chain
import Data.Kind
-import Data.Proxy
import Data.SOP
import GHC.Generics
-import qualified Data.Bifunctor.Assoc as B
-import qualified Data.Bifunctor.Swap as B
-import qualified Data.Functor.Contravariant.Day as CD
-import qualified Data.Functor.Day as D
-import qualified Data.HBifunctor.Tensor as T
-import qualified Data.Vinyl as V
-import qualified Data.Vinyl.Functor as V
+import qualified Data.Bifunctor.Assoc as B
+import qualified Data.Bifunctor.Swap as B
+import qualified Data.Functor.Contravariant.Day as CD
+import qualified Data.Functor.Day as D
+import qualified Data.HBifunctor.Tensor as T
+import qualified Data.Vinyl as V
+import qualified Data.Vinyl.Functor as V
-- | A pairing of invariant functors to create a new invariant functor that
-- represents the "combination" between the two.
@@ -194,8 +200,8 @@ runCoDayChain
:: forall f g. Applicative g
=> f ~> g
-> DayChain f ~> g
-runCoDayChain f = unsafeApply (Proxy @g) $
- foldChain (pure . runIdentity) (runDayApply f id)
+runCoDayChain f = foldChain (pure . runIdentity) $ \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'.
@@ -203,8 +209,36 @@ runContraDayChain
:: forall f g. Divisible g
=> f ~> g
-> DayChain f ~> g
-runContraDayChain f = unsafeDivise (Proxy @g) $
- foldChain (const conquer) (runDayDivise f id)
+runContraDayChain f = foldChain (const conquer) $ \case
+ Day x y g _ -> divide g (f x) y
+
+-- | 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
-- | Instead of defining yet another separate free monoid like
-- 'Control.Applicative.Free.Ap',
diff --git a/src/Data/Functor/Invariant/Night.hs b/src/Data/Functor/Invariant/Night.hs
index aa31420..c946ec1 100644
--- a/src/Data/Functor/Invariant/Night.hs
+++ b/src/Data/Functor/Invariant/Night.hs
@@ -18,6 +18,7 @@ module Data.Functor.Invariant.Night (
, runNightAlt
, runNightDecide
, toCoNight
+ , toCoNight_
, toContraNight
, assoc, unassoc
, intro1, intro2
@@ -26,9 +27,12 @@ module Data.Functor.Invariant.Night (
, trans1, trans2
-- * Chain
, NightChain
- , pattern Share, pattern Reject
+ , pattern Swerve, pattern Reject
, runCoNightChain
, runContraNightChain
+ , chainListF
+ , chainListF_
+ , chainDec
, assembleNightChain
, concatNightChain
-- * Nonempty Chain
@@ -36,32 +40,40 @@ module Data.Functor.Invariant.Night (
, pattern NightChain1
, runCoNightChain1
, runContraNightChain1
+ , chainNonEmptyF
+ , chainNonEmptyF_
+ , chainDec1
, assembleNightChain1
, concatNightChain1
) where
+import Control.Applicative.ListF
import Control.Natural
import Control.Natural.IsoF
import Data.Bifunctor
import Data.Functor.Alt
import Data.Functor.Contravariant.Conclude
import Data.Functor.Contravariant.Decide
-import Data.Functor.Contravariant.Night (Not(..), refuted)
+import Data.Functor.Contravariant.Divisible.Free
+import Data.Functor.Contravariant.Night (Not(..), refuted)
import Data.Functor.Invariant
import Data.Functor.Plus
import Data.HBifunctor
-import Data.HBifunctor.Associative hiding (assoc)
-import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)
+import Data.HBifunctor.Associative hiding (assoc)
+import Data.HBifunctor.Tensor hiding (elim1, elim2, intro1, intro2)
import Data.HFunctor
import Data.HFunctor.Chain
import Data.Kind
import Data.SOP
import Data.Void
import GHC.Generics
-import qualified Data.Bifunctor.Assoc as B
-import qualified Data.Bifunctor.Swap as B
-import qualified Data.Functor.Contravariant.Night as CN
-import qualified Data.HBifunctor.Tensor as T
+import qualified Control.Monad.Trans.Compose as CT
+import qualified Data.Bifunctor.Assoc as B
+import qualified Data.Bifunctor.Swap as B
+import qualified Data.Functor.Contravariant.Night as CN
+import qualified Data.Functor.Coyoneda as CY
+import qualified Data.HBifunctor.Tensor as T
+import qualified Data.List.NonEmpty as NE
-- | A pairing of invariant functors to create a new invariant functor that
-- represents the "choice" between the two.
@@ -125,6 +137,18 @@ runNightDecide f g (Night x y h _ _) = decide h (f x) (g y)
toCoNight :: (Functor f, Functor g) => Night f g ~> f :*: g
toCoNight (Night x y _ f g) = fmap f x :*: fmap g y
+-- | Convert an invariant 'Night' into the covariant version, dropping the
+-- contravariant part.
+--
+-- This version does not require a 'Functor' constraint because it converts
+-- to the coyoneda-wrapped product, which is more accurately the covariant
+-- 'Night' convolution.
+--
+-- @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
+
+
-- | Convert an invariant 'Night' into the contravariant version, dropping
-- the covariant part.
toContraNight :: Night f g ~> CN.Night f g
@@ -194,6 +218,16 @@ runContraNightChain1
-> NightChain1 f ~> g
runContraNightChain1 f = foldChain1 f (runNightDecide f id)
+-- | 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
@@ -210,6 +244,47 @@ runContraNightChain
-> NightChain f ~> g
runContraNightChain f = foldChain (conclude . refute) (runNightDecide f id)
+-- | 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
+
+-- | 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
+
+
-- | Instead of defining yet another separate free monoid like
-- 'Control.Applicative.Free.Ap',
-- 'Data.Functor.Contravariant.Divisible.Free.Div', or
@@ -236,18 +311,19 @@ type NightChain = Chain Night Not
-- little the Haskell ecosystem uses invariant functors as an abstraction.
type NightChain1 = Chain1 Night
--- | Match on a non-empty 'NightChain'; contains no @f@s, but only the
--- terminal value. Analogous to the
--- 'Data.Functor.Contravariant.Divisible.Free.Choose' constructor.
-pattern Share :: (a -> Either b c) -> (b -> a) -> (c -> a) -> f b -> NightChain f c -> NightChain f a
-pattern Share f g h x xs = More (Night x xs f g h)
+-- | 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 = More (Night x xs f g h)
-- | 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 = Done (Not x)
-{-# COMPLETE Share, Reject #-}
+{-# 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'
diff --git a/src/Data/HBifunctor/Associative.hs b/src/Data/HBifunctor/Associative.hs
index 03887a3..58db6a9 100644
--- a/src/Data/HBifunctor/Associative.hs
+++ b/src/Data/HBifunctor/Associative.hs
@@ -44,8 +44,7 @@ module Data.HBifunctor.Associative (
, interpretNE
-- ** Utility
, biget
- , bicollect
- , bicollect1
+ , biapply
, (!*!)
, (!$!)
, (!+!)
@@ -88,8 +87,6 @@ import Data.Kind
import Data.List.NonEmpty (NonEmpty(..))
import Data.Void
import GHC.Generics
-import qualified Data.DList as DL
-import qualified Data.DList.DNonEmpty as NEDL
import qualified Data.Functor.Contravariant.Day as CD
import qualified Data.Functor.Contravariant.Night as N
import qualified Data.Functor.Day as D
@@ -303,14 +300,15 @@ matchingNE :: (Associative t, FunctorBy t f) => NonEmptyBy t f <~> f :+: t f (No
matchingNE = isoF matchNE (inject !*! consNE)
-- | Useful wrapper over 'binterpret' to allow you to directly extract
--- a value @b@ out of the @t f a@, if you can convert @f x@ into @b@.
+-- a value @b@ out of the @t f g a@, if you can convert an @f x@ and @g x@
+-- into @b@.
--
--- Note that depending on the constraints on @f@ in @'SemigroupIn' t f@,
+-- Note that depending on the constraints on @h@ in @'SemigroupIn' t h@,
-- you may have extra constraints on @b@.
--
--- * If @f@ is unconstrained, there are no constraints on @b@
--- * If @f@ must be 'Apply', 'Alt', 'Divise', or 'Decide', @b@ needs to be an instance of 'Semigroup'
--- * If @f@ is 'Applicative', 'Plus',
+-- * If @h@ is unconstrained, there are no constraints on @b@
+-- * If @h@ must be 'Apply', 'Alt', 'Divise', or 'Decide', @b@ needs to be an instance of 'Semigroup'
+-- * If @h@ is 'Applicative', 'Plus',
-- 'Data.Functor.Contravariant.Divisible.Divisible', or
-- 'Data.Functor.Contravariant.Conclude.Conclude', @b@ needs to be an
-- instance of 'Monoid'
@@ -386,38 +384,28 @@ infixr 5 !*!
R1 y -> g y
infixr 5 !+!
-
--- | Useful wrapper over 'biget' to allow you to collect a @b@ from all
--- instances of @f@ and @g@ inside a @t f g a@.
+-- | Useful wrapper over 'binterpret' to allow you to directly extract
+-- a value @b@ out of the @t f g a@, if you can convert an @f x@ and @g x@
+-- into @b@, given an @x@ input.
--
--- This will work if the constraint on @f@ for @'SemigroupIn' t f@ is
--- 'Apply', 'Applicative', 'Alt', 'Plus', 'Divise',
--- 'Data.Functor.Contravariant.Divisible.Divisible', 'Decide',
--- 'Data.Functor.Contravariant.Conclude.Conclude', or if it is unconstrained.
-bicollect
- :: SemigroupIn t (AltConst (DL.DList b))
- => (forall x. f x -> b)
- -> (forall x. g x -> b)
- -> t f g a
- -> [b]
-bicollect f g = toList . biget (DL.singleton . f) (DL.singleton . g)
-
--- | Useful wrapper over 'biget' to allow you to collect a @b@ from all
--- instances of @f@ and @g@ inside a @t f g a@ into a non-empty collection
--- of @b@s.
+-- Note that depending on the constraints on @h@ in @'SemigroupIn' t h@,
+-- you may have extra constraints on @b@.
--
--- This will work if the constraint on @f@ for @'SemigroupIn' t f@ is
--- 'Apply', 'Alt', 'Divise', 'Decide', or if it is unconstrained.
+-- * If @h@ is unconstrained, there are no constraints on @b@
+-- * If @h@ must be 'Divise', or 'Divisible', @b@ needs to be an instance of 'Semigroup'
+-- * If @h@ must be 'Divivisible', then @b@ needs to be an instance of 'Monoid'.
--
--- @since 0.3.1.0
-bicollect1
- :: SemigroupIn t (AltConst (NEDL.DNonEmpty b))
- => (forall x. f x -> b)
- -> (forall x. g x -> b)
+-- For some constraints (like 'Monad'), this will not be usable.
+--
+-- @since 0.3.2.0
+biapply
+ :: SemigroupIn t (Op b)
+ => (forall x. f x -> x -> b)
+ -> (forall x. g x -> x -> b)
-> t f g a
- -> NonEmpty b
-bicollect1 f g = NEDL.toNonEmpty . biget (NEDL.singleton . f) (NEDL.singleton . g)
-
+ -> a
+ -> b
+biapply f g = getOp . binterpret (Op . f) (Op . g)
instance Associative (:*:) where
type NonEmptyBy (:*:) = NonEmptyF
diff --git a/src/Data/HFunctor/Internal.hs b/src/Data/HFunctor/Internal.hs
index 1534990..f21807a 100644
--- a/src/Data/HFunctor/Internal.hs
+++ b/src/Data/HFunctor/Internal.hs
@@ -6,6 +6,7 @@ module Data.HFunctor.Internal (
, WrappedHBifunctor(..)
, sumSum, prodProd
, generalize, absorb
+ , NDL, ndlSingleton, fromNDL
) where
import Control.Applicative.Backwards
@@ -24,6 +25,7 @@ import Control.Natural.IsoF
import Data.Bifunctor
import Data.Bifunctor.Joker
import Data.Coerce
+import Data.Foldable
import Data.Functor.Bind
import Data.Functor.Contravariant.Night (Night(..))
import Data.Functor.Coyoneda
@@ -35,6 +37,7 @@ import Data.Functor.Sum
import Data.Functor.These
import Data.Functor.Yoneda
import Data.Kind
+import Data.List.NonEmpty (NonEmpty(..))
import Data.Proxy
import Data.Tagged
import Data.Vinyl.CoRec
@@ -188,6 +191,18 @@ generalize (Identity x) = pure x
absorb :: f ~> Proxy
absorb _ = Proxy
+-- | Internal type, used to not require dlist-1.0
+newtype NDL a = NDL ([a] -> NonEmpty a)
+
+ndlSingleton :: a -> NDL a
+ndlSingleton x = NDL (x:|)
+
+fromNDL :: NDL a -> NonEmpty a
+fromNDL (NDL f) = f []
+
+instance Semigroup (NDL a) where
+ NDL x <> NDL y = NDL (x . toList . y)
+
instance HFunctor Coyoneda where
hmap = hoistCoyoneda
diff --git a/src/Data/HFunctor/Interpret.hs b/src/Data/HFunctor/Interpret.hs
index 4c829b5..a3c720d 100644
--- a/src/Data/HFunctor/Interpret.hs
+++ b/src/Data/HFunctor/Interpret.hs
@@ -46,6 +46,9 @@ module Data.HFunctor.Interpret (
, iget
, icollect
, icollect1
+ , iapply
+ , ifanout
+ , ifanout1
, getI, collectI
, AltConst(..)
, AndC
@@ -65,7 +68,6 @@ import Control.Monad.Trans.Identity
import Control.Natural
import Data.Coerce
import Data.Data
-import Data.Foldable
import Data.Functor.Bind
import Data.Functor.Classes
import Data.Functor.Contravariant
@@ -81,17 +83,17 @@ import Data.Functor.Reverse
import Data.Functor.Sum
import Data.Functor.These
import Data.HFunctor
+import Data.HFunctor.Internal
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe
import Data.Pointed
+import Data.Semigroup (Endo(..))
import Data.Semigroup.Foldable
import GHC.Generics
import qualified Control.Alternative.Free as Alt
import qualified Control.Applicative.Free as Ap
import qualified Control.Applicative.Free.Fast as FAF
import qualified Control.Applicative.Free.Final as FA
-import qualified Data.DList as DL
-import qualified Data.DList.DNonEmpty as NEDL
import qualified Data.Functor.Contravariant.Coyoneda as CCY
import qualified Data.Map.NonEmpty as NEM
@@ -169,7 +171,7 @@ forI x f = interpret f x
-- may have extra constraints on @b@.
--
-- * If @f@ is unconstrained, there are no constraints on @b@
--- * If @f@ must be 'Apply', 'Alt', 'Divise', or 'Decide', @b@ needs to be an instance of 'Semigroup'
+-- * If @f@ must be 'Apply', 'Alt', 'Divise', or 'Decide', @b@ needs to be an instance of 'Semigroup'.
-- * If @f@ is 'Applicative', 'Plus', 'Divisible', or 'Conclude', @b@ needs to be an instance of 'Monoid'
--
-- For some constraints (like 'Monad'), this will not be usable.
@@ -198,8 +200,8 @@ getI = iget
-- | Useful wrapper over 'iget' to allow you to collect a @b@ from all
-- instances of @f@ inside a @t f a@.
--
--- Will work if there is an instance of @'Interpret' t ('AltConst'
--- ('DL.DList' b))@, which will be the case if the constraint on the target
+-- Will work if there is an instance of @'Interpret' t ('AltConst' m)@ if @'Monoid'
+-- m@, which will be the case if the constraint on the target
-- functor is 'Functor', 'Apply', 'Applicative', 'Alt', 'Plus',
-- 'Data.Functor.Contravariant.Decide.Decide', 'Divisible', 'Decide',
-- 'Conclude', or unconstrained.
@@ -213,24 +215,24 @@ getI = iget
--
-- @since 0.3.1.0
icollect
- :: Interpret t (AltConst (DL.DList b))
+ :: (forall m. Monoid m => Interpret t (AltConst m))
=> (forall x. f x -> b)
-> t f a
-> [b]
-icollect f = toList . iget (DL.singleton . f)
+icollect f = flip appEndo [] . iget (Endo . (:) . f)
-- | (Deprecated) Old name for 'icollect'; will be removed in a future
-- version.
-collectI :: Interpret t (AltConst (DL.DList b)) => (forall x. f x -> b) -> t f a -> [b]
+collectI :: (forall m. Monoid m => Interpret t (AltConst m)) => (forall x. f x -> b) -> t f a -> [b]
collectI = icollect
{-# DEPRECATED collectI "Use icollect instead" #-}
-- | Useful wrapper over 'iget' to allow you to collect a @b@ from all
-- instances of @f@ inside a @t f a@, into a non-empty collection of @b@s.
--
--- Will work if there is an instance of @'Interpret' t ('AltConst'
--- ('NEDL.DNonEmpty' b))@, which will be the case if the constraint on the
--- target functor is 'Functor', 'Apply', 'Alt', 'Divise', 'Decide', or
+-- Will work if there is an instance of @'Interpret' t ('AltConst' m)@ if
+-- @'Semigroup' m@, which will be the case if the constraint on the target
+-- functor is 'Functor', 'Apply', 'Alt', 'Divise', 'Decide', or
-- unconstrained.
--
-- @
@@ -242,11 +244,94 @@ collectI = icollect
--
-- @since 0.3.1.0
icollect1
- :: Interpret t (AltConst (NEDL.DNonEmpty b))
+ :: (forall m. Semigroup m => Interpret t (AltConst m))
=> (forall x. f x -> b)
-> t f a
-> NonEmpty b
-icollect1 f = NEDL.toNonEmpty . iget (NEDL.singleton . f)
+icollect1 f = fromNDL . iget (ndlSingleton . f)
+
+-- | Useful wrapper over 'interpret' to allow you to directly consume
+-- a value of type @a@ with a @t f a@ to create a @b@. Do this by
+-- supplying the method by which each component @f x@ can consume an @x@.
+-- This works for contravariant functor combinators, where @t f a@ can be
+-- interpreted as a consumer of @a@s.
+--
+-- Note that depending on the constraints on @f@ in @'Interpret' t f@, you
+-- may have extra constraints on @b@.
+--
+-- * If @f@ is unconstrained, 'Decide', or 'Conclude', there are no
+-- constraints on @b@. This will be the case for combinators like
+-- contravariant 'CCY.Coyoneda', 'Dec', 'Dec1'.
+-- * If @f@ must be 'Divise', @b@ needs to be an instance of
+-- 'Semigroup'. This will be the case for combinators like 'Div1'.
+-- * If @f@ is 'Divisible', @b@ needs to be an instance of 'Monoid'.
+-- This will be the case for combinators like 'Div'.
+--
+-- For any 'Functor' or 'Invariant' constraint, this is not usable.
+--
+-- @since 0.3.2.0
+iapply
+ :: Interpret t (Op b)
+ => (forall x. f x -> x -> b)
+ -> t f a
+ -> a
+ -> b
+iapply f = getOp . interpret (Op . f)
+
+-- | Useful wrapper over 'interpret' to allow you to directly consume
+-- a value of type @a@ with a @t f a@ to create a @b@, and create a list of
+-- all the @b@s created by all the @f@s. Do this by supplying the method
+-- by which each component @f x@ can consume an @x@. This works for
+-- contravariant functor combinators, where @t f a@ can be interpreted as
+-- a consumer of @a@s.
+--
+-- Will work if there is an instance of @'Interpret' t ('Op' m)@ if @'Monoid'
+-- m@, which will be the case if the constraint on the target
+-- functor is 'Contravariant', 'Decide', 'Conclude', 'Divise', 'Divisible',
+-- or unconstrained.
+--
+-- Note that this is really only useful outside of 'iapply' for 'Div' and
+-- 'Div1', where a @'Div' f@ which is a collection of many different @f@s
+-- consuming types of different values. You can use this with 'Dec' and
+-- 'Dec1' and the contravarient 'CCY.Coyoneda' as well, but those would
+-- always just give you a singleton list, so you might as well use
+-- 'iapply'. This is really only here for completion alongside 'icollect',
+-- or if you define your own custom functor combinators.
+ifanout
+ :: (forall m. Monoid m => Interpret t (Op m))
+ => (forall x. f x -> x -> b)
+ -> t f a
+ -> a
+ -> [b]
+ifanout f t = flip appEndo [] . iapply (\x y -> Endo (f x y :)) t
+
+-- | Useful wrapper over 'interpret' to allow you to directly consume
+-- a value of type @a@ with a @t f a@ to create a @b@, and create a list of
+-- all the @b@s created by all the @f@s. Do this by supplying the method
+-- by which each component @f x@ can consume an @x@. This works for
+-- contravariant functor combinators, where @t f a@ can be interpreted as
+-- a consumer of @a@s.
+--
+-- Will work if there is an instance of @'Interpret' t ('Op' m)@ if @'Monoid'
+-- m@, which will be the case if the constraint on the target
+-- functor is 'Contravariant', 'Decide', 'Divise', or unconstrained.
+--
+-- Note that this is really only useful outside of 'iapply' and 'ifanout'
+-- for 'Div1', where a @'Div1' f@ which is a collection of many different
+-- @f@s consuming types of different values. You can use this with 'Dec'
+-- and 'Dec1' and the contravarient 'CCY.Coyoneda' as well, but those would
+-- always just give you a singleton list, so you might as well use
+-- 'iapply'. This is really only here for completion alongside
+-- 'icollect1', or if you define your own custom functor combinators.
+ifanout1
+ :: (forall m. Semigroup m => Interpret t (Op m))
+ => (forall x. f x -> x -> b)
+ -> t f a
+ -> a
+ -> NonEmpty b
+ifanout1 f t = fromNDL . iapply (\x -> ndlSingleton . f x) t
+
+
-- | A version of 'Const' that supports 'Alt', 'Plus', 'Decide', and
-- 'Conclude' instances. It does this