diff --git a/Data/Profunctor/Product.hs b/Data/Profunctor/Product.hs --- a/Data/Profunctor/Product.hs +++ b/Data/Profunctor/Product.hs @@ -1,20 +1,23 @@ -module Data.Profunctor.Product (module Data.Profunctor.Product.Newtype, +{-# LANGUAGE TemplateHaskell #-} +module Data.Profunctor.Product (module Data.Profunctor.Product.Class, + module Data.Profunctor.Product.Newtype, module Data.Profunctor.Product) where import Prelude hiding (id) import Data.Profunctor (Profunctor, dimap, lmap, WrappedArrow) import qualified Data.Profunctor as Profunctor import Data.Functor.Contravariant (Contravariant, contramap) --- vv TODO: don't want to have to import all those explicitly. What to do? -import Data.Profunctor.Product.Flatten --- vv and these -import Data.Profunctor.Product.Tuples import Control.Category (id) import Control.Arrow (Arrow, (***), (<<<), arr, (&&&)) import Control.Applicative (Applicative, liftA2, pure) import Data.Monoid (Monoid, mempty, (<>)) import Data.Profunctor.Product.Newtype +import Data.Profunctor.Product.Class +import Data.Profunctor.Product.Flatten +import Data.Profunctor.Product.Tuples +import Data.Profunctor.Product.Tuples.TH (pTns, maxTupleSize, pNs) + -- ProductProfunctor and ProductContravariant are potentially -- redundant type classes. It seems to me that these are equivalent -- to Profunctor with Applicative, and Contravariant with Monoid @@ -60,14 +63,6 @@ -- Still, at least we now have default implementations of the class -- methods, which makes things simpler. --- | A 'ProductProfunctor' is a generalization of an 'Applicative'. --- It has an "input", contravariant type parameter on the left as well --- as the usual 'Applicative' "output", covariant parameter on teh --- right. -class Profunctor p => ProductProfunctor p where - empty :: p () () - (***!) :: p a b -> p a' b' -> p (a, a') (b, b') - -- This appears to be just 'Data.Functor.Contravariant.Divisible' class Contravariant f => ProductContravariant f where point :: f () @@ -150,367 +145,6 @@ -- } -pT0 :: ProductProfunctor p => T0 -> p T0 T0 -pT0 = const empty - -pT1 :: ProductProfunctor p => T1 (p a1 b1) -> p (T1 a1) (T1 b1) -pT1 = id - -pT2 :: ProductProfunctor p => T2 (p a1 b1) (p a2 b2) -> p (T2 a1 a2) (T2 b1 b2) -pT2 = uncurry (***!) - -chain :: ProductProfunctor p => (t -> p a2 b2) -> (p a1 b1, t) - -> p (a1, a2) (b1, b2) -chain rest (a, as) = pT2 (a, rest as) - -pT3 :: ProductProfunctor p => T3 (p a1 b1) (p a2 b2) (p a3 b3) - -> p (T3 a1 a2 a3) (T3 b1 b2 b3) -pT3 = chain pT2 - -pT4 :: ProductProfunctor p => T4 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - -> p (T4 a1 a2 a3 a4) (T4 b1 b2 b3 b4) -pT4 = chain pT3 - -pT5 :: ProductProfunctor p => T5 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) - -> p (T5 a1 a2 a3 a4 a5) (T5 b1 b2 b3 b4 b5) -pT5 = chain pT4 - -pT6 :: ProductProfunctor p => T6 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) - -> p (T6 a1 a2 a3 a4 a5 a6) (T6 b1 b2 b3 b4 b5 b6) -pT6 = chain pT5 - -pT7 :: ProductProfunctor p => T7 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) - -> p (T7 a1 a2 a3 a4 a5 a6 a7) (T7 b1 b2 b3 b4 b5 b6 b7) -pT7 = chain pT6 - -pT8 :: ProductProfunctor p => T8 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - -> p (T8 a1 a2 a3 a4 a5 a6 a7 a8) (T8 b1 b2 b3 b4 b5 b6 b7 b8) -pT8 = chain pT7 - -pT9 :: ProductProfunctor p => T9 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) - -> p (T9 a1 a2 a3 a4 a5 a6 a7 a8 a9) - (T9 b1 b2 b3 b4 b5 b6 b7 b8 b9) -pT9 = chain pT8 - -pT10 :: ProductProfunctor p => T10 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) - -> p (T10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) - (T10 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10) -pT10 = chain pT9 - -pT11 :: ProductProfunctor p => T11 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - -> p (T11 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11) - (T11 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11) -pT11 = chain pT10 - -pT12 :: ProductProfunctor p => T12 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) - -> p (T12 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12) - (T12 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12) -pT12 = chain pT11 - -pT13 :: ProductProfunctor p => T13 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) - -> p (T13 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13) - (T13 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13) -pT13 = chain pT12 - -pT14 :: ProductProfunctor p => T14 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - -> p (T14 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) - (T14 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14) -pT14 = chain pT13 - -pT15 :: ProductProfunctor p => T15 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) - -> p (T15 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15) - (T15 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15) -pT15 = chain pT14 - -pT16 :: ProductProfunctor p => T16 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) - -> p (T16 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16) - (T16 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16) -pT16 = chain pT15 - -pT17 :: ProductProfunctor p => T17 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - -> p (T17 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17) - (T17 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17) -pT17 = chain pT16 - -pT18 :: ProductProfunctor p => T18 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) - -> p (T18 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18) - (T18 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18) -pT18 = chain pT17 - -pT19 :: ProductProfunctor p => T19 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) - -> p (T19 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19) - (T19 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19) -pT19 = chain pT18 - -pT20 :: ProductProfunctor p => T20 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) (p a20 b20) - -> p (T20 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20) - (T20 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20) -pT20 = chain pT19 - -pT21 :: ProductProfunctor p => T21 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) (p a20 b20) - (p a21 b21) - -> p (T21 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21) - (T21 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21) -pT21 = chain pT20 - -pT22 :: ProductProfunctor p => T22 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) (p a20 b20) - (p a21 b21) (p a22 b22) - -> p (T22 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22) - (T22 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22) -pT22 = chain pT21 - -pT23 :: ProductProfunctor p => T23 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) (p a20 b20) - (p a21 b21) (p a22 b22) (p a23 b23) - -> p (T23 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23) - (T23 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23) -pT23 = chain pT22 - -pT24 :: ProductProfunctor p => T24 (p a1 b1) (p a2 b2) (p a3 b3) (p a4 b4) - (p a5 b5) (p a6 b6) (p a7 b7) (p a8 b8) - (p a9 b9) (p a10 b10) (p a11 b11) - (p a12 b12) (p a13 b13) (p a14 b14) - (p a15 b15) (p a16 b16) (p a17 b17) - (p a18 b18) (p a19 b19) (p a20 b20) - (p a21 b21) (p a22 b22) (p a23 b23) - (p a24 b24) - -> p (T24 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24) - (T24 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24) -pT24 = chain pT23 - -convert :: Profunctor p => (a2 -> a1) -> (tp -> tTp) -> (b1 -> b2) - -> (tTp -> p a1 b1) - -> tp -> p a2 b2 -convert u u' f c = dimap u f . c . u' - -p0 :: ProductProfunctor p => () -> p () () -p0 = convert unflatten0 unflatten0 flatten0 pT0 - -p1 :: ProductProfunctor p => p a1 b1 -> p a1 b1 -p1 = convert unflatten1 unflatten1 flatten1 pT1 - -p2 :: ProductProfunctor p => (p a1 b1, p a2 b2) -> p (a1, a2) (b1, b2) -p2 = convert unflatten2 unflatten2 flatten2 pT2 - -p3 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3) - -> p (a1, a2, a3) (b1, b2, b3) -p3 = convert unflatten3 unflatten3 flatten3 pT3 - -p4 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4) - -> p (a1, a2, a3, a4) (b1, b2, b3, b4) -p4 = convert unflatten4 unflatten4 flatten4 pT4 - -p5 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5) - -> p (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) -p5 = convert unflatten5 unflatten5 flatten5 pT5 - -p6 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6) - -> p (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6) -p6 = convert unflatten6 unflatten6 flatten6 pT6 - -p7 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7) - -> p (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7) -p7 = convert unflatten7 unflatten7 flatten7 pT7 - -p8 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8) - -> p (a1, a2, a3, a4, a5, a6, a7, a8) (b1, b2, b3, b4, b5, b6, b7, b8) -p8 = convert unflatten8 unflatten8 flatten8 pT8 - -p9 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9) - (b1, b2, b3, b4, b5, b6, b7, b8, b9) -p9 = convert unflatten9 unflatten9 flatten9 pT9 - -p10 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10) -p10 = convert unflatten10 unflatten10 flatten10 pT10 - -p11 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11) -p11 = convert unflatten11 unflatten11 flatten11 pT11 - -p12 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12) -p12 = convert unflatten12 unflatten12 flatten12 pT12 - -p13 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13) -p13 = convert unflatten13 unflatten13 flatten13 pT13 - -p14 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14) -p14 = convert unflatten14 unflatten14 flatten14 pT14 - -p15 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15) -p15 = convert unflatten15 unflatten15 flatten15 pT15 - -p16 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16) -p16 = convert unflatten16 unflatten16 flatten16 pT16 - -p17 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, p a17 b17) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17) -p17 = convert unflatten17 unflatten17 flatten17 pT17 - -p18 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18) -p18 = convert unflatten18 unflatten18 flatten18 pT18 - -p19 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19) -p19 = convert unflatten19 unflatten19 flatten19 pT19 - -p20 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19, p a20 b20) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20) -p20 = convert unflatten20 unflatten20 flatten20 pT20 - -p21 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19, p a20 b20, - p a21 b21) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21) -p21 = convert unflatten21 unflatten21 flatten21 pT21 - -p22 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19, p a20 b20, - p a21 b21, p a22 b22) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22) -p22 = convert unflatten22 unflatten22 flatten22 pT22 - -p23 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19, p a20 b20, - p a21 b21, p a22 b22, p a23 b23) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23) -p23 = convert unflatten23 unflatten23 flatten23 pT23 +pTns [0..maxTupleSize] -p24 :: ProductProfunctor p => (p a1 b1, p a2 b2, p a3 b3, p a4 b4, - p a5 b5, p a6 b6, p a7 b7, p a8 b8, - p a9 b9, p a10 b10, p a11 b11, p a12 b12, - p a13 b13, p a14 b14, p a15 b15, p a16 b16, - p a17 b17, p a18 b18, p a19 b19, p a20 b20, - p a21 b21, p a22 b22, p a23 b23, p a24 b24) - -> p (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) - (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24) -p24 = convert unflatten24 unflatten24 flatten24 pT24 +pNs [0..maxTupleSize] diff --git a/Data/Profunctor/Product/Class.hs b/Data/Profunctor/Product/Class.hs new file mode 100644 --- /dev/null +++ b/Data/Profunctor/Product/Class.hs @@ -0,0 +1,12 @@ +module Data.Profunctor.Product.Class where + +import Data.Profunctor (Profunctor) + +-- | A 'ProductProfunctor' is a generalization of an 'Applicative'. +-- It has an "input", contravariant type parameter on the left as well +-- as the usual 'Applicative' "output", covariant parameter on teh +-- right. +class Profunctor p => ProductProfunctor p where + empty :: p () () + (***!) :: p a b -> p a' b' -> p (a, a') (b, b') + diff --git a/Data/Profunctor/Product/Default.hs b/Data/Profunctor/Product/Default.hs --- a/Data/Profunctor/Product/Default.hs +++ b/Data/Profunctor/Product/Default.hs @@ -1,268 +1,35 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, - FlexibleContexts #-} + FlexibleContexts, PolyKinds, TemplateHaskell #-} -module Data.Profunctor.Product.Default where +module Data.Profunctor.Product.Default + ( module Data.Profunctor.Product.Default + , module Data.Profunctor.Product.Default.Class + ) where +import Control.Applicative (Const (Const)) +import Data.Functor.Identity (Identity (Identity)) +import Data.Profunctor (Profunctor, dimap) -- TODO: vv this imports a lot of names. Should we list them all? import Data.Profunctor.Product +import Data.Tagged (Tagged (Tagged)) -class Default p a b where - -- Would rather call it "default", but that's a keyword - def :: p a b +import Data.Profunctor.Product.Default.Class +import Data.Profunctor.Product.Tuples.TH (mkDefaultNs, maxTupleSize) cdef :: Default (PPOfContravariant u) a a => u a cdef = unPPOfContravariant def -instance ProductProfunctor p => Default p () () where - def = empty - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2) - => Default p (a1, a2) (b1, b2) where - def = p2 (def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3) - => Default p (a1, a2, a3) - (b1, b2, b3) where - def = p3 (def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4) - => Default p (a1, a2, a3, a4) - (b1, b2, b3, b4) where - def = p4 (def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5) - => Default p (a1, a2, a3, a4, a5) - (b1, b2, b3, b4, b5) where - def = p5 (def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6) - => Default p (a1, a2, a3, a4, a5, a6) - (b1, b2, b3, b4, b5, b6) where - def = p6 (def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7) - => Default p (a1, a2, a3, a4, a5, a6, a7) - (b1, b2, b3, b4, b5, b6, b7) where - def = p7 (def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8) - (b1, b2, b3, b4, b5, b6, b7, b8) where - def = p8 (def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, a9) - (b1, b2, b3, b4, b5, b6, b7, b8, b9) where - def = p9 (def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10) where - def = p10 (def, def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11) where - def = p11 (def, def, def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12) where - def = p12 (def, def, def, def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13) where - def = p13 (def, def, def, def, def, def, def, def, def, def, - def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14) where - def = p14 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, Default p a15 b15) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15) where - def = p15 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16) where - def = p16 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17) where - def = p17 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18) where - def = p18 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19) where - def = p19 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19, Default p a20 b20) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20) where - def = p20 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def, def) - -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19, Default p a20 b20, - Default p a21 b21) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21) where - def = p21 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def, def, - def) +instance (Profunctor p, Default p a b) => Default p (Identity a) (Identity b) + where + def = dimap (\(Identity a) -> a) Identity def -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19, Default p a20 b20, - Default p a21 b21, Default p a22 b22) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22) where - def = p22 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def, def, - def, def) +instance (Profunctor p, Default p a b) => Default p (Const a c) (Const b c') + where + def = dimap (\(Const a) -> a) Const def -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19, Default p a20 b20, - Default p a21 b21, Default p a22 b22, Default p a23 b23) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23) where - def = p23 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def, def, - def, def, def) +instance (Profunctor p, Default p a b) => Default p (Tagged s a) (Tagged s' b) + where + def = dimap (\(Tagged a) -> a) Tagged def -instance (ProductProfunctor p, Default p a1 b1, Default p a2 b2, - Default p a3 b3, Default p a4 b4, Default p a5 b5, - Default p a6 b6, Default p a7 b7, Default p a8 b8, - Default p a9 b9, Default p a10 b10, Default p a11 b11, - Default p a12 b12, Default p a13 b13, Default p a14 b14, - Default p a15 b15, Default p a16 b16, Default p a17 b17, - Default p a18 b18, Default p a19 b19, Default p a20 b20, - Default p a21 b21, Default p a22 b22, Default p a23 b23, - Default p a24 b24) - => Default p (a1, a2, a3, a4, a5, a6, a7, a8, - a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) - (b1, b2, b3, b4, b5, b6, b7, b8, - b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24) where - def = p24 (def, def, def, def, def, def, def, def, def, def, - def, def, def, def, def, def, def, def, def, def, - def, def, def, def) +mkDefaultNs (0:[2..maxTupleSize]) diff --git a/Data/Profunctor/Product/Default/Class.hs b/Data/Profunctor/Product/Default/Class.hs new file mode 100644 --- /dev/null +++ b/Data/Profunctor/Product/Default/Class.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Data.Profunctor.Product.Default.Class where + +class Default p a b where + -- Would rather call it "default", but that's a keyword + def :: p a b diff --git a/Data/Profunctor/Product/Flatten.hs b/Data/Profunctor/Product/Flatten.hs --- a/Data/Profunctor/Product/Flatten.hs +++ b/Data/Profunctor/Product/Flatten.hs @@ -1,124 +1,8 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# LANGUAGE TemplateHaskell #-} module Data.Profunctor.Product.Flatten where -flatten0 () = () -unflatten0 () = () - -flatten1 a = a -unflatten1 a = a - -flatten2 (a, b) = (a, b) -unflatten2 (a, b) = (a, b) - -flatten3 (a, (b, c)) = (a, b, c) -unflatten3 (a, b, c) = (a, (b, c)) - -flatten4 (a, (b, (c, a4))) = (a, b, c, a4) -unflatten4 (a, b, c, a4) = (a, (b, (c, a4))) - -flatten5 (a, (b, (c, (a4, a5)))) = (a, b, c, a4, a5) -unflatten5 (a, b, c, a4, a5) = (a, (b, (c, (a4, a5)))) - -flatten6 (a, (b, (c, (a4, (a5, a6))))) = (a, b, c, a4, a5, a6) -unflatten6 (a, b, c, a4, a5, a6) = (a, (b, (c, (a4, (a5, a6))))) - -flatten7 (a, (b, (c, (a4, (a5, (a6, a7)))))) = (a, b, c, a4, a5, a6, a7) -unflatten7 (a, b, c, a4, a5, a6, a7) = (a, (b, (c, (a4, (a5, (a6, a7)))))) - -flatten8 (a, (b, (c, (a4, (a5, (a6, (a7, a8))))))) - = (a, b, c, a4, a5, a6, a7, a8) -unflatten8 (a, b, c, a4, a5, a6, a7, a8) - = (a, (b, (c, (a4, (a5, (a6, (a7, a8))))))) - -flatten9 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, a9)))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9) -unflatten9 (a, b, c, a4, a5, a6, a7, a8, a9) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, a9)))))))) - -flatten10 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, a10))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10) -unflatten10 (a, b, c, a4, a5, a6, a7, a8, a9, a10) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, a10))))))))) - -flatten11 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, a11)))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11) -unflatten11 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, a11)))))))))) - -flatten12 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, a12))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12) -unflatten12 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, a12))))))))))) - -flatten13 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - a13)))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) -unflatten13 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, a13)))))))))))) - -flatten14 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, a14))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) -unflatten14 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, a14))))))))))))) - -flatten15 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, a15)))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) -unflatten15 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, a15)))))))))))))) - -flatten16 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, a16))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) -unflatten16 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, a16))))))))))))))) - -flatten17 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, a17)))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17) -unflatten17 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, a17)))))))))))))))) - -flatten18 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, a18))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) -unflatten18 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, a18))))))))))))))))) - -flatten19 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, a19)))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) -unflatten19 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, a19)))))))))))))))))) - -flatten20 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, (a19, a20))))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) -unflatten20 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, (a19, a20))))))))))))))))))) - -flatten21 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, a21)))))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) -unflatten21 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, a21)))))))))))))))))))) - -flatten22 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, a22))))))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) -unflatten22 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, a22))))))))))))))))))))) - -flatten23 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, (a22, a23)))))))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) -unflatten23 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, (a22, a23)))))))))))))))))))))) +import Data.Profunctor.Product.Tuples.TH (mkFlattenNs, mkUnflattenNs, maxTupleSize) -flatten24 (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, - (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, (a22, (a23, a24))))))))))))))))))))))) - = (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) -unflatten24 (a, b, c, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24) - = (a, (b, (c, (a4, (a5, (a6, (a7, (a8, (a9, (a10, (a11, (a12, (a13, (a14, (a15, (a16, (a17, (a18, (a19, (a20, (a21, (a22, (a23, a24))))))))))))))))))))))) +mkFlattenNs [0..maxTupleSize] +mkUnflattenNs [0..maxTupleSize] diff --git a/Data/Profunctor/Product/Internal/TH.hs b/Data/Profunctor/Product/Internal/TH.hs --- a/Data/Profunctor/Product/Internal/TH.hs +++ b/Data/Profunctor/Product/Internal/TH.hs @@ -1,11 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Data.Profunctor.Product.Internal.TH where import Data.Profunctor (dimap) -import Data.Profunctor.Product (ProductProfunctor, p1, p2, p3, p4, p5, p6, p7, - p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, - p18, p19, p20, p21, p22, p23, p24) +import Data.Profunctor.Product import Data.Profunctor.Product.Default (Default, def) import qualified Data.Profunctor.Product.Newtype as N import Language.Haskell.TH (Dec(DataD, SigD, FunD, InstanceD, NewtypeD), @@ -58,16 +57,27 @@ let body = [ FunD 'N.constructor [simpleClause (NormalB (ConE conName))] , FunD 'N.field [simpleClause (NormalB (LamE [ConP conName [VarP x]] (VarE x)))] ] - +#if __GLASGOW_HASKELL__ >= 800 + return [InstanceD Nothing [] (ConT ''N.Newtype `AppT` ConT tyName) body] +#else return [InstanceD [] (ConT ''N.Newtype `AppT` ConT tyName) body] +#endif dataDecStuffOfInfo :: Info -> Either Error (Name, [Name], Name, [Name]) +#if __GLASGOW_HASKELL__ >= 800 +dataDecStuffOfInfo (TyConI (DataD _cxt tyName tyVars _kind constructors _deriving)) = +#else dataDecStuffOfInfo (TyConI (DataD _cxt tyName tyVars constructors _deriving)) = +#endif do (conName, conTys) <- extractConstructorStuff constructors let tyVars' = map varNameOfBinder tyVars return (tyName, tyVars', conName, conTys) +#if __GLASGOW_HASKELL__ >= 800 +dataDecStuffOfInfo (TyConI (NewtypeD _cxt tyName tyVars _kind constructor _deriving)) = +#else dataDecStuffOfInfo (TyConI (NewtypeD _cxt tyName tyVars constructor _deriving)) = +#endif do (conName, conTys) <- extractConstructorStuff [constructor] let tyVars' = map varNameOfBinder tyVars @@ -103,8 +113,13 @@ instanceDefinition :: Name -> Int -> Int -> Name -> Name -> Q Dec instanceDefinition tyName' numTyVars numConVars adaptorName' conName=instanceDec - where instanceDec = fmap (\i -> InstanceD i instanceType [defDefinition]) - instanceCxt + where instanceDec = fmap +#if __GLASGOW_HASKELL__ >= 800 + (\i -> InstanceD Nothing i instanceType [defDefinition]) +#else + (\i -> InstanceD i instanceType [defDefinition]) +#endif + instanceCxt instanceCxt = mapM (uncurry classP) (pClass:defClasses) pClass :: Monad m => (Name, [m Type]) pClass = (''ProductProfunctor, [return (varTS "p")]) @@ -177,6 +192,17 @@ 22 -> 'p22 23 -> 'p23 24 -> 'p24 + 25 -> 'p25 + 26 -> 'p26 + 27 -> 'p27 + 28 -> 'p28 + 29 -> 'p29 + 30 -> 'p30 + 31 -> 'p31 + 32 -> 'p32 + 33 -> 'p33 + 34 -> 'p34 + 35 -> 'p35 _ -> error errorMsg where errorMsg = "Data.Profunctor.Product.TH: " ++ show n diff --git a/Data/Profunctor/Product/TH.hs b/Data/Profunctor/Product/TH.hs --- a/Data/Profunctor/Product/TH.hs +++ b/Data/Profunctor/Product/TH.hs @@ -18,7 +18,7 @@ -- \"adaptor\" with the following splice: -- -- @ --- $(makeAdaptorAndInstance \"pFoo\" ''Foo) +-- $(makeAdaptorAndInstance \"pFoo\" ''Foo) -- @ -- -- The adaptor for a type @Foo@ is by convention called @pFoo@, but in @@ -26,7 +26,7 @@ -- the name @pFoo@ yourself you can use -- -- @ --- $(makeAdaptorAndInstance' ''Foo) +-- $(makeAdaptorAndInstance' ''Foo) -- @ -- -- and it will be named @pFoo@ automatically. @@ -51,7 +51,7 @@ -- -- @ -- pFooApplicative :: Applicative f => --- Foo (f a) (f b) (f c) -> f (Foo a b c) +-- Foo (f a) (f b) (f c) -> f (Foo a b c) -- @ -- -- The product-profunctor \"adaptor\" (in this case @pFoo@) is a @@ -89,8 +89,8 @@ -- @Applicative@ case. For an @Applicative@ we would write -- -- @ --- pFooApplicative :: Applicative f => --- Foo (f a) (f b) (f c) -> f (Foo a b c) +-- pFooApplicative :: Applicative f +-- => Foo (f a) (f b) (f c) -> f (Foo a b c) -- pFooApplicative f = Foo \<$\> foo f -- \<*\> bar f -- \<*\> baz f @@ -102,8 +102,8 @@ -- import Data.Profunctor (lmap) -- import Data.Profunctor.Product ((***$), (****)) -- --- pFoo :: ProductProfunctor p => --- Foo (p a a') (p b b') (p c c') -> p (Foo a b c) (Foo a' b' c') +-- pFoo :: ProductProfunctor p +-- => Foo (p a a') (p b b') (p c c') -> p (Foo a b c) (Foo a' b' c') -- pFoo f = Foo ***$ lmap foo (foo f) -- **** lmap bar (bar f) -- **** lmap baz (baz f) diff --git a/Data/Profunctor/Product/Tuples.hs b/Data/Profunctor/Product/Tuples.hs --- a/Data/Profunctor/Product/Tuples.hs +++ b/Data/Profunctor/Product/Tuples.hs @@ -1,39 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} module Data.Profunctor.Product.Tuples where -type T0 = () -type T1 a = a -type T2 a b = (a, T1 b) -type T3 a b c = (a, T2 b c) -type T4 a b c d = (a, T3 b c d) -type T5 a b c d e = (a, T4 b c d e) -type T6 a b c d e f = (a, T5 b c d e f) -type T7 a b c d e f g = (a, T6 b c d e f g) -type T8 a b c d e f g h = (a, T7 b c d e f g h) -type T9 a b c d e f g h a9 = (a, T8 b c d e f g h a9) -type T10 a b c d e f g h a9 a10 = (a, T9 b c d e f g h a9 a10) -type T11 a b c d e f g h a9 a10 a11 = (a, T10 b c d e f g h a9 a10 a11) -type T12 a b c d e f g h a9 a10 a11 a12 = (a, T11 b c d e f g h a9 a10 a11 a12) -type T13 a b c d e f g h a9 a10 a11 a12 a13 = - (a, T12 b c d e f g h a9 a10 a11 a12 a13) -type T14 a b c d e f g h a9 a10 a11 a12 a13 a14 = - (a, T13 b c d e f g h a9 a10 a11 a12 a13 a14) -type T15 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 = - (a, T14 b c d e f g h a9 a10 a11 a12 a13 a14 a15) -type T16 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 = - (a, T15 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16) -type T17 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 = - (a, T16 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17) -type T18 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 = - (a, T17 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18) -type T19 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 = - (a, T18 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19) -type T20 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 = - (a, T19 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20) -type T21 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 = - (a, T20 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21) -type T22 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 = - (a, T21 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22) -type T23 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 = - (a, T22 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23) -type T24 a b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 = - (a, T23 b c d e f g h a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24) +import Data.Profunctor.Product.Tuples.TH + +mkTs [0..35] diff --git a/Data/Profunctor/Product/Tuples/TH.hs b/Data/Profunctor/Product/Tuples/TH.hs new file mode 100644 --- /dev/null +++ b/Data/Profunctor/Product/Tuples/TH.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE TemplateHaskell #-} +module Data.Profunctor.Product.Tuples.TH + ( mkTs + , pTns + , mkFlattenNs + , mkUnflattenNs + , pNs + , mkDefaultNs + , maxTupleSize + ) where + +import Language.Haskell.TH + +import Data.Profunctor (Profunctor (dimap)) +import Data.Profunctor.Product.Class (ProductProfunctor, (***!), empty) +import Data.Profunctor.Product.Default.Class (Default (def)) + +mkTs :: [Int] -> Q [Dec] +mkTs = mapM mkT + +mkT :: Int -> Q Dec +mkT n = tySynD (tyName n) tyVars tyDef + where + tyName n' = mkName ('T':show n') + tyVars = map PlainTV . take n $ allNames + tyDef = case n of + 0 -> tupleT 0 + 1 -> varT (head allNames) + _ -> tupleT 2 `appT` varT (head allNames) `appT` applyT (n - 1) + applyT n' = foldl (\t v -> t `appT` varT v) (conT (tyName n')) (take n' (tail allNames)) + allNames = [ mkName $ c:show i | i <- [0::Int ..], c <- ['a'..'z'] ] + +chain :: ProductProfunctor p => (t -> p a2 b2) -> (p a1 b1, t) + -> p (a1, a2) (b1, b2) +chain rest (a, as) = uncurry (***!) (a, rest as) + +pTns :: [Int] -> Q [Dec] +pTns = fmap concat . mapM pTn + +pTn :: Int -> Q [Dec] +pTn n = sequence [sig, fun] + where + p = mkName "p" + sig = sigD (pT n) (forallT (map PlainTV $ p : take n as ++ take n bs) + (pure [ConT ''ProductProfunctor `AppT` VarT p]) + (arrowT `appT` mkLeftTy `appT` mkRightTy) + ) + mkLeftTy = foldl appT (conT tN) + $ zipWith (\a b -> varT p `appT` varT a `appT` varT b) (take n as) (take n bs) + mkRightTy = varT p `appT` foldl appT (conT tN) (map varT . take n $ as) + `appT` foldl appT (conT tN) (map varT . take n $ bs) + fun = funD (pT n) [ clause [] (normalB bdy) [] ] + bdy = case n of + 0 -> [| const empty |] + 1 -> [| id |] + 2 -> [| uncurry (***!) |] + _ -> varE 'chain `appE` varE (pT (n - 1)) + pT n' = mkName ("pT" ++ show n') + tN = mkName ('T':show n) + as = [ mkName $ 'a':show i | i <- [0::Int ..] ] + bs = [ mkName $ 'b':show i | i <- [0::Int ..] ] + +mkFlattenNs :: [Int] -> Q [Dec] +mkFlattenNs = fmap concat . mapM mkFlattenN + +mkFlattenN :: Int -> Q [Dec] +mkFlattenN n = sequence [sig, fun] + where + sig = sigD nm (forallT (map PlainTV names) (pure []) $ arrowT `appT` unflatT names `appT` flatT names) + fun = funD nm [ clause [mkTupPat names] (normalB bdy) [] ] + bdy = mkFlatExp names + unflatT [] = tupleT 0 + unflatT [v] = varT v + unflatT (v:vs) = tupleT 2 `appT` varT v `appT` unflatT vs + flatT [] = tupleT 0 + flatT [v] = varT v + flatT vs = foldl appT (tupleT (length vs)) (map varT vs) + mkTupPat [] = tupP [] + mkTupPat [v] = varP v + mkTupPat (v:vs) = tupP [varP v, mkTupPat vs] + mkFlatExp [] = tupE [] + mkFlatExp [v] = varE v + mkFlatExp vs = tupE (map varE vs) + nm = mkName ("flatten" ++ show n) + names = take n [ mkName $ c:show i | i <- [0::Int ..], c <- ['a'..'z'] ] + +mkUnflattenNs :: [Int] -> Q [Dec] +mkUnflattenNs = fmap concat . mapM mkUnflattenN + +mkUnflattenN :: Int -> Q [Dec] +mkUnflattenN n = sequence [sig, fun] + where + sig = sigD nm (forallT (map PlainTV names) (pure []) $ arrowT `appT` flatT names `appT` unflatT names) + fun = funD nm [ clause [mkTupPat names] (normalB bdy) [] ] + bdy = mkUnflatExp names + unflatT [] = tupleT 0 + unflatT [v] = varT v + unflatT (v:vs) = tupleT 2 `appT` varT v `appT` unflatT vs + flatT [] = tupleT 0 + flatT [v] = varT v + flatT vs = foldl appT (tupleT (length vs)) (map varT vs) + mkTupPat [] = tupP [] + mkTupPat [v] = varP v + mkTupPat vs = tupP (map varP vs) + mkUnflatExp [] = tupE [] + mkUnflatExp [v] = varE v + mkUnflatExp (v:vs) = tupE [varE v, mkUnflatExp vs] + nm = mkName ("unflatten" ++ show n) + names = take n [ mkName $ c:show i | i <- [0::Int ..], c <- ['a'..'z'] ] + +pNs :: [Int] -> Q [Dec] +pNs = fmap concat . mapM pN + +pN :: Int -> Q [Dec] +pN n = sequence [sig, fun] + where + sig = sigD nm (forallT (map PlainTV $ p : as ++ bs) + (pure [ConT ''ProductProfunctor `AppT` VarT p]) + (arrowT `appT` mkLeftTy `appT` mkRightTy) + ) + mkLeftTy = case n of + 1 -> mkPT (head as) (head bs) + _ -> foldl appT (tupleT n) (zipWith mkPT as bs) + mkRightTy = varT p `appT` mkTupT as `appT` mkTupT bs + mkTupT = foldl appT (tupleT n) . map varT + mkPT a b = varT p `appT` varT a `appT` varT b + fun = funD nm [ clause [] (normalB bdy) [] ] + bdy = varE 'convert `appE` unflat `appE` unflat `appE` flat `appE` pT + unflat = varE $ mkName unflatNm + flat = varE $ mkName flatNm + pT = varE $ mkName pTNm + unflatNm = "unflatten" ++ show n + flatNm = "flatten" ++ show n + pTNm = "pT" ++ show n + nm = mkName ('p':show n) + p = mkName "p" + as = take n [ mkName $ 'a':show i | i <- [0::Int ..] ] + bs = take n [ mkName $ 'b':show i | i <- [0::Int ..] ] + +convert :: Profunctor p => (a2 -> a1) -> (tp -> tTp) -> (b1 -> b2) + -> (tTp -> p a1 b1) + -> tp -> p a2 b2 +convert u u' f c = dimap u f . c . u' + +mkDefaultNs :: [Int] -> Q [Dec] +mkDefaultNs = mapM mkDefaultN + +mkDefaultN :: Int -> Q Dec +mkDefaultN n = instanceD (pure (ConT ''ProductProfunctor `AppT` VarT p : mkDefs)) + (conT ''Default `appT` varT p `appT` mkTupT as `appT` mkTupT bs) + [mkFun] + where + mkDefs = zipWith (\a b -> ConT ''Default `AppT` VarT p `AppT` VarT a `AppT` VarT b) as bs + mkTupT = foldl appT (tupleT n) . map varT + mkFun = funD 'def [clause [] bdy []] + bdy = normalB $ case n of + 0 -> varE 'empty + _ -> varE (mkName $ 'p':show n) `appE` tupE (replicate n (varE 'def)) + p = mkName "p" + as = take n [ mkName $ 'a':show i | i <- [0::Int ..] ] + bs = take n [ mkName $ 'b':show i | i <- [0::Int ..] ] + +maxTupleSize :: Int +maxTupleSize = 35 diff --git a/product-profunctors.cabal b/product-profunctors.cabal --- a/product-profunctors.cabal +++ b/product-profunctors.cabal @@ -1,5 +1,5 @@ name: product-profunctors -version: 0.7.0.2 +version: 0.7.1.0 synopsis: product-profunctors description: Product profunctors homepage: https://github.com/tomjaguarpaw/product-profunctors @@ -19,6 +19,7 @@ build-depends: base >= 4.5 && < 5 , profunctors >= 4.0 && < 5.3 , contravariant >= 0.4 && < 1.5 + , tagged >= 0.0 && < 1 , template-haskell exposed-modules: Data.Profunctor.Product, Data.Profunctor.Product.Default, @@ -27,7 +28,13 @@ Data.Profunctor.Product.Newtype, Data.Profunctor.Product.TH, Data.Profunctor.Product.Tuples + Data.Profunctor.Product.Tuples.TH + other-modules: Data.Profunctor.Product.Class, + Data.Profunctor.Product.Default.Class ghc-options: -Wall + + if impl(ghc < 7.10) + build-depends: transformers >= 0.2 && < 0.6 test-suite test type: exitcode-stdio-1.0