Is there any type-safe way to write a function
bi f a b = (f a, f b)
such that it would be possible to use it like this:
x1 :: (Integer, Char)
x1 = bi head [2,3] "45"
x2 :: (Integer, Char)
x2 = bi fst (2,'3') ('4',5)
x3 :: (Integer, Double)
x3 = bi (1+) 2 3.45
?
In rank-n-types examples there are always something much simpler like
g :: (forall a. a -> a) -> a -> a -> (a, a)
g f a b = (f a, f b)
{-# LANGUAGE TemplateHaskell #-}
bi f = [| \a b -> ($f a, $f b)|]
ghci> :set -XTemplateHaskell
ghci> $(bi [|head|]) [2,3] "45"
(2,'4')
;)
Yes, though not in Haskell. But the higher-order polymorphic lambda calculus (aka System F-omega) is more general:
bi : forall m n a b. (forall a. m a -> n a) -> m a -> m b -> (n a, n b)
bi {m} {n} {a} {b} f x y = (f {a} x, f {b} y)
x1 : (Integer, Char)
x1 = bi {\a. List a} {\a. a} {Integer} {Char} head [2,3] "45"
x2 : (Integer, Char)
x2 = bi {\a . exists b. (a, b)} {\a. a} {Integer} {Char} (\{a}. \p. unpack<b,x>=p in fst {a} {b} x) (pack<Char, (2,'3')>) (pack<Integer, ('4',5)>)
x3 : (Integer, Double)
x3 = bi {\a. a} {\a. a} {Integer} {Double} (1+) 2 3.45
Here, I write f {T} for explicit type application and assume a library typed respectively. Something like \a. a is a type-level lambda. The x2 example is more intricate, because it also needs existential types to locally "forget" the other bit of polymorphism in the arguments.
You can actually simulate this in Haskell by defining a newtype or datatype for every different m or n you instantiate with, and pass appropriately wrapped functions f that add and remove constructors accordingly. But obviously, that's no fun at all.
Edit: I should point out that this still isn't a fully general solution. For example, I can't see how you could type
swap (x,y) = (y,x)
x4 = bi swap (3, "hi") (True, 3.1)
even in System F-omega. The problem is that the swap function is more polymorphic than bi allows, and unlike with x2, the other polymorphic dimension is not forgotten in the result, so the existential trick does not work. It seems that you would need kind polymorphism to allow that one (so that the argument to bi can be polymorphic over a varying number of types).
Even with ConstraintKinds, I think the barrier is going to be quantifying over the "type function" from the arguments to the results. What you want is for f to map a -> b and c -> d, and to take a -> b -> (c, d), but I don't think there's any way to quantify over that relationship with full generality.
Some special cases might be doable, though:
(forall x . cxt x => x -> f x) -> a -> b -> (f a, f b)
-- e.g. return
(forall x . cxt x => f x -> x) -> f a -> f b -> (a, b)
-- e.g. snd
(forall x . cxt x => x -> x) -> a -> b -> (a, b)
-- e.g. (+1)
but given that you're trying to quantify over more or less arbitrary type functions, I'm not sure you can make that work.
This is about as close as you're going to get, I think:
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
module Data.Function.Bi (bi, Fn(..))
bi :: (Fn i a a', Fn i b b') => i -> a -> b -> (a', b')
bi i a b = (fn i a, fn i b)
class Fn i x x' | i x -> x' where
fn :: i -> x -> x'
Use it like so:
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, RankNTypes,
FlexibleInstances, UndecidableInstances #-}
import Data.Function.Bi
data Snd = Snd
instance Fn Snd (a, b) b where
fn Snd = snd
myExpr1 :: (Int, String)
myExpr1 = bi Snd (1, 2) ("a", "b")
-- myExpr == (2, "b")
data Plus = Plus (forall a. (Num a) => a)
instance (Num a) => Fn Plus a a where
fn (Plus n) = (+n)
myExpr2 :: (Int, Double)
myExpr2 = bi (Plus 1) (1, 2) (1.3, 5.7)
-- myExpr2 == (3, 6.7)
It's very clunky, but as general as possible.
Related
How do I add the elements of two tuples in Haskell to give me a third tuple. The signature is something like,
Add :: (Int,Int) -> (Int,Int) ->(Int,Int)
Add a b = ....
So far, I am only able to think of this:
Add a b = [(x, y) | a = (x1, y1), b = (x2, y2), x=x1+x2, y =y1+y2n]
I am very new to Haskell however, so is what I am doing even correct?
What you are doing is not correct. List comprehensions are not the right way to do this.
Using pattern matching to extract the elements of the tuples:
add :: (Int, Int) -> (Int, Int) -> (Int, Int)
add (x, y) (u, v) = (x+u, y+v)
Extracting the elements of the tuples using fst and snd:
add2 :: (Int, Int) -> (Int, Int) -> (Int, Int)
add2 x y = (fst x + fst y, snd x + snd y)
Also keep in mind that functions can't start with capital letters in Haskell.
About your attempt, try running it in ghci and you'll see an error. As to why, that syntax you're trying to use is know as list comprehension, and it is documented here; it is syntactic surgar to create lists, such as [1,2,3], so it's not the right tool for you, as the ability to sum to pairs, which have type (·,·), not [·] (where by · I mean "any type").
Below is a non-basic (and probably overkill) way to write the function you want. But setting the target of understand it could be a way to force yourself going deeper in Haskell.
Here it is:
import Data.Bifunctor (bimap)
import Data.Tuple.Extra (both)
sumTwoTuples x y = uncurry bimap (both (+) x) y
How does this work? Let's see
> :t both
both :: (a -> b) -> (a, a) -> (b, b)
So both takes a function and applies it to both elements of a pair; therefore both (+) will apply (+) to both sides of the first pair x; if that's (3,4), you'll get ((3+), (4+)) (yeah, I'd write it as (3+,4+), but that's illegal syntax).
Now we have this pair of functions both (+) x, and we want to apply each of them to one side of the pair y.
Here's bimap:
> :t bimap
bimap :: Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d
So it takes 2 functions and applies it to each side of a Bifunctor (in our case the Bifunctor type p is (,)).
It's almost what we need, but it takes the two functions as two separate arguments, not a pair containing them.
uncurry gives a way to adjust that:
> :t uncurry
uncurry :: (a -> b -> c) -> (a, b) -> c
Indeed, uncurry bimap has this type:
> :t uncurry bimap
uncurry bimap :: Bifunctor p => (a -> b, c -> d) -> p a c -> p b d
so it takes a pair of functions and applies each to the corresponding side of the pair y, which has type p b d with p being (,) in our case.
The type of the finally produced value of your function starts with a ( but a list's type starts with a [. They can't match, so your approach can't be right. But we can mend it.
You are correct in trying to pattern match the values with the tuples of variables, but actually the patterns go to the left and values go to the right of the equal sign. And it must be inside a let:
add1 :: (Int,Int) -> (Int,Int) -> [(Int,Int)] -- NB: added brackets!
add1 a b = [(x, y) | let (x1, y1) = a ; (x2, y2) = b ;
x = x1 + x2 ; y = y1 + y2 ]
and actually we don't need that let inside the list comprehension,
add2 :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
add2 a b = let { (x1, y1) = a ; (x2, y2) = b ;
x = x1 + x2 ; y = y1 + y2 } in
[(x, y)]
and now we can just get rid of those brackets, to get the value and the type which you wanted.
There's another, a bit tricky way to make your original code work without changing anything in it (except fixing the wrong capitalization of add and making it the proper let syntax of course).
We just add one word and enable one extension, and it works:
{-# LANGUAGE MonadComprehensions #-}
import Data.Function.Identity
add :: (Int,Int) -> (Int,Int) -> (Int,Int)
add a b = magicWord
[(x, y) | let { (x1, y1) = a ; (x2, y2) = b ;
x = x1 + x2 ; y = y1 + y2 } ]
The magic word is
magicWord = runIdentity
With that extension, the inferred type for the definition is
add :: (Num t1, Num t, Monad m)
=> (t, t1) -> (t, t1) -> m (t, t1)
and since
runIdentity :: Identity a -> a
using it forces m ~ Identity and it just works: the derived type is
(Num t1, Num t, Monad m)
=> (t, t1) -> (t, t1) -> m (t, t1)
Identity a -> a
--------------------------------------------
m ~ Identity , Monad Identity
(t,t1) ~ a
--------------------------------------------
(Num t1, Num t)
=> (t, t1) -> (t, t1) -> (t, t1)
which matches your given type signature
(Int, Int) -> (Int, Int) -> (Int, Int)
since Int is in Num,
and Identity is indeed a monad, one that does nothing at all,
newtype Identity a = Identity {runIdentity :: a}
fmap f (Identity a) = Identity (f a)
join (Identity (Identity a)) = Identity a
except tagging the values with its tag, which even disappears right away because the type Identity a is defined as newtype, not data.
This problem arose when attempting to fuse away intermediate triemaps in Haskell.
Consider the trie for Peano natural numbers:
data Nat = Zero | Succ Nat
data ExpoNat a = ExpoNat (Maybe a) (ExpoNat a)
| NoExpoNat
We can easily define a fold on ExpoNat (it is essentially a list) and use foldr/build (a.k.a. finally tagless) to fuse away intermediate occurrencess of ExpoNat:
{-# NOINLINE fold #-}
fold :: (Maybe a -> b -> b) -> b -> ExpoNat a -> b
fold f z (ExpoNat x y) = f x (fold f z y)
fold f z NoExpoNat = z
{-# NOINLINE build #-}
build :: (forall b. (Maybe a -> b -> b) -> b -> b) -> ExpoNat a
build f = f ExpoNat NoExpoNat
{-# RULES "fold/build" forall f n (g :: forall b. (Maybe a -> b -> b) -> b -> b). fold f n (build g) = g f n #-}
As an example, we take match and appl from "Is there a way to generalize this TrieMap code?" and compose them such that ExpoNat is fused away. (Note that we must "strengthen the induction hypothesis" in appl.)
{-# INLINE match #-}
match :: Nat -> ExpoNat ()
match n = build $ \f z ->
let go Zero = f (Just ()) z
go (Succ n) = f Nothing (go n)
in go n
{-# INLINE appl #-}
appl :: ExpoNat a -> (Nat -> Maybe a)
appl
= fold (\f z -> \n ->
case n of Zero -> f
Succ n' -> z n')
(\n -> Nothing)
applmatch :: Nat -> Nat -> Maybe ()
applmatch x = appl (match x)
The fusion can be verified by inspecting Core with -ddump-simpl.
Now we would like to do the same for Tree.
data Tree = Leaf | Node Tree Tree
data TreeMap a
= TreeMap {
tm_leaf :: Maybe a,
tm_node :: TreeMap (TreeMap a)
}
| EmptyTreeMap
We are in trouble: TreeMap is a non-regular data type, and so it is not obvious how to write its corresponding fold/build pair.
Haskell Programming with Nested Types: A Principled Approach seems to have the answer (see the Bush type) but 4:30 AM seems to be too late for me to get it working. How is one supposed to write hfmap? Have there been further developments since?
A similar variant of this question has been asked in What's the type of a catamorphism (fold) for non-regular recursive types?
I worked on it some more and I now have working fusion, without using the generic gadgets from the paper.
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
module Tree where
data Tree = Leaf | Node Tree Tree
deriving (Show)
data ExpoTree a = ExpoTree (Maybe a) (ExpoTree (ExpoTree a))
| NoExpoTree
deriving (Show, Functor)
I derived most of the specialized types by taking the generic construction and then inlining type definitions until I bottomed out. I've kept the generic construction in here for ease of comparison.
data HExpoTree f a = HExpoTree (Maybe a) (f (f a))
| HNoExpoTree
type g ~> h = forall a. g a -> h a
class HFunctor f where
ffmap :: Functor g => (a -> b) -> f g a -> f g b
hfmap :: (Functor g, Functor h) => (g ~> h) -> (f g ~> f h)
instance HFunctor HExpoTree where
ffmap f HNoExpoTree = HNoExpoTree
ffmap f (HExpoTree x y) = HExpoTree (fmap f x) (fmap (fmap f) y)
hfmap f HNoExpoTree = HNoExpoTree
hfmap f (HExpoTree x y) = HExpoTree x (f (fmap f y))
type Alg f g = f g ~> g
newtype Mu f a = In { unIn :: f (Mu f) a }
instance HFunctor f => Functor (Mu f) where
fmap f (In r) = In (ffmap f r)
hfold :: (HFunctor f, Functor g) => Alg f g -> (Mu f ~> g)
hfold m (In u) = m (hfmap (hfold m) u)
An Alg ExpoTreeH g can be decomposed into a product of two natural transformations:
type ExpoTreeAlg g = forall a. Maybe a -> g (g a) -> g a
type NoExpoTreeAlg g = forall a. g a
{-# NOINLINE fold #-}
fold :: Functor g => ExpoTreeAlg g -> NoExpoTreeAlg g -> ExpoTree a -> g a
fold f z NoExpoTree = z
fold f z (ExpoTree x y) = f x (fold f z (fmap (fold f z) y))
The natural transformation here c ~> x is very interesting, and turns out to be quite necessary. Here's the build translation:
hbuild :: HFunctor f => (forall x. Alg f x -> (c ~> x)) -> (c ~> Mu f)
hbuild g = g In
newtype I :: (* -> *) where
I :: x -> I x
deriving (Show, Eq, Functor, Foldable, Traversable)
-- Needs to be a newtype, otherwise RULE firer gets bamboozled
newtype ExpoTreeBuilder c = ETP {runETP :: (forall x. Functor x
=> (forall a. Maybe a -> x (x a) -> x a)
-> (forall a. x a)
-> (forall a. c a -> x a)
)}
{-# NOINLINE build #-}
build :: ExpoTreeBuilder c -> forall a. c a -> ExpoTree a
build g = runETP g ExpoTree NoExpoTree
The newtype for the builder function is needed, because GHC 8.0 doesn't know how to fire the RULE without.
Now, the shortcut fusion rule:
{-# RULES "ExpoTree fold/build"
forall (g :: ExpoTreeBuilder c) c (f :: ExpoTreeAlg g) (n :: NoExpoTreeAlg g).
fold f n (build g c) = runETP g f n c #-}
Implementation of 'match' with 'build':
{-# INLINE match #-}
match :: Tree -> ExpoTree ()
match n = build (match_mk n) (I ())
where
match_mk :: Tree -> ExpoTreeBuilder I
match_mk Leaf = ETP $ \ f z (I c) -> f (Just c) z
match_mk (Node x y) = ETP $ \ f z c ->
-- NB: This fmap is bad for performance
f Nothing (fmap (const (runETP (match_mk y) f z c)) (runETP (match_mk x) f z c))
Implementation of 'appl' with 'fold' (we need to define a custom functor to define the return type.)
newtype PFunTree a = PFunTree { runPFunTree :: Tree -> Maybe a }
deriving (Functor)
{-# INLINE appl #-}
appl :: ExpoTree a -> PFunTree a
appl = fold appl_expoTree appl_noExpoTree
where
appl_expoTree :: ExpoTreeAlg PFunTree
appl_expoTree = \z f -> PFunTree $ \n ->
case n of Leaf -> z
Node n1 n2 -> runPFunTree f n1 >>= flip runPFunTree n2
appl_noExpoTree :: NoExpoTreeAlg PFunTree
appl_noExpoTree = PFunTree $ \n -> Nothing
Putting it all together:
applmatch :: Tree -> Tree -> Maybe ()
applmatch x = runPFunTree (appl (match x))
We can once again inspect the core with -ddump-simpl. Unfortunately, while we have successfully fused away the TrieMap data structure, we are left with suboptimal code due to the fmap in match. Eliminating this inefficiency is left to future work.
The paper appears to draw a parallel between ExpoNat a as a recursive Type and Tree as a recursive type constructor (Type -> Type).
newtype Fix f = Fix (f ( Fix f))
newtype HFix h a = HFix (h (HFix h) a)
Fix f represents the least fixed point of the endofunctor on the category of types and functions, f :: Type -> Type; HFix h represents the least fixed point of the endofunctor h on a category of functors and natural transformations, h :: (Type -> Type) -> (Type -> Type).
-- x ~ Fix (ExpoNatF a) ~ ExpoNat
data ExpoNatF a x = ExpoNatF (Maybe a) x | NoExpoNatF
fmap :: (x -> y) -> ExpoNatF a x -> ExpoNatF a y
fmap f (ExpoNatF u v) = ExpoNatF u (f v)
fmap _ NoExpoNatF = NoExpoNatF
-- f ~ HFix TreeMapH ~ TreeMap
data TreeMapH f a = TreeMapH (Maybe a) (f (f a)) | EmptyTreeMapH
hfmap :: (f ~> g) -> (TreeMapH f ~> TreeMapH g)
hfmap f (TreeMapH u v) = TreeMapH u ((fmap . fmap) f v)
hfmap _ EmptyTreeMapH = EmptyTreeMapH
-- (~>) is the type of natural transformations
type f ~> g = forall a. f a -> g a
Endofunctors give rise to algebras.
type Alg f a = f a -> a
type HAlg h f = h f ~> f
fold, or cata maps any algebra to a morphism (function|natural transformation).
cata :: Alg f a -> Fix f -> a
hcata :: HAlg h f -> (HFix h ~> h)
build constructs a value from its Church encoding.
type Church f = forall a. Alg f a -> a
type HChurch h = forall f. HAlg h f ~> f
build :: Church f -> Fix f
hbuild :: HChurch h -> HFix h a
-- The paper actually has a slightly different type for Church encodings, derived from the categorical view, but I'm pretty sure they're equivalent
build/fold fusion is summarized by one equation.
cata alg ( build f) = f alg
hcata alg (hbuild f) = f alg
I am an intermediate schemer, but only a haskell beginner. Here is my problem:
Suppose you have an associative binary operation, says (>>=). Is there a polyvariadic function p such that p (>>=) h g f e = h >>= g >>= f >>= e?
I am asking this question because this question says it is possible if the binary operation takes inputs of the same type. I wonder if this can be generalized.
EDIT-1: I try to modify the code in http://okmij.org/ftp/Haskell/vararg-fn.lhs (the section of Variable number of variably typed arguments) with little progress.
EDIT-2: Simplify the code a bit.
{-# LANGUAGE FunctionalDependencies, FlexibleInstances #-}
module Main where
class Lfold f a b | b -> a where
lfold :: (a -> (f a) -> (f a)) -> (f a) -> a -> b
instance Lfold f a (f a) where
lfold op rid x = op x rid
instance Lfold f a b => Lfold f a (a -> b) where
lfold op rid x y = lfold op (op x rid) y
test :: [String]
test = lfold (:) [] "a" "b" "c"
main :: IO ()
main = putStrLn $ show test
Yes, you can create such a function. It is very ugly however, and you will need to explicitly type every argument you are going to pass to make the compiler find the correct instance.
Starting from the polyvariadic function template you linked, I arrived at
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses #-}
class ImplicitChain m a r where
p :: m a -> r
instance Monad m => ImplicitChain m a (m a) where
p :: m a -> m a
p x = x
instance (Monad m, ImplicitChain m b r) => ImplicitChain m a ((a -> m b) -> r) where
p :: m a -> (a -> m b) -> r
p x f = p (x >>= f)
h :: Int -> [Int]
h = replicate 2
g :: Int -> [Int]
g = (:[])
f :: Int -> [Int]
f = flip enumFromTo 2
test :: [Int]
test = p [1::Int] h g f
But you were asking whether we can do more generic, so that the binary operation is an argument as well. Yes:
{-# LANGUAGE FlexibleInstances, InstanceSigs, MultiParamTypeClasses, UndecidableInstances #-}
class ImplicitVariadic a b r where
p :: (a -> b -> a) -> r
instance ImplicitVariadic a b (a -> a) where
p :: (a -> b -> a) -> a -> a
p _ x = x
instance (ImplicitVariadic a b (a -> r)) => ImplicitVariadic a b (a -> b -> r) where
p :: (a -> b -> a) -> a -> b -> r
p f x y = p f (f x y)
You can't (at least, not easily), because you need to know how many arguments you are getting ahead of time. Because all functions in Haskell are automatically curried, every function takes exactly one argument and returns one value. Even a simple binary operator takes one argument (the first operand) and returns a function that takes one argument (the second operand) and returns a result. That is,
a + b == (+) a b
== ((+) a) b
There is no way for your imaginary function p to know from its first argument how many other arguments are going to be given. That is, what should the type of p be?
p :: (a -> a -> a) -> a -- zero arguments?
p :: (a -> a -> a) -> a -> a -- one argument?
p :: (a -> a -> a) -> a -> a -> a -- two arguments?
p :: (a -> a -> a) -> a -> a -> a -> a -- three arguments?
Instead, the best you can do is use a fold, which takes an operation and a list of operands.
foldr (+) 0 [h, g, f, e] == h + g + f + e + 0 -- explicit first argument of 0
foldr1 (+) [h, g, f, e] == h + g + f + e -- assumes a list of at least one value
To see what I mean by "not easily", look at the implementation of printf in the Text.Printf module. Even that is not a good example, because the first argument carries information (the number of placeholders in the format string) that a binary operation alone does not.
For my work with hxt I implemented the following function:
-- | Construction of a 8 argument arrow from a 8-ary function. Same
-- implementation as in #Control.Arrow.ArrowList.arr4#.
arr8 :: ArrowList a => (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> b8 -> c)
-> a (b1, (b2, (b3, (b4, (b5, (b6, (b7, b8))))))) c
arr8 f = arr ( \ ~(x1, ~(x2, ~(x3, ~(x4, ~(x5, ~(x6, ~(x7, x8)))))))
-> f x1 x2 x3 x4 x5 x6 x7 x8 )
As mentioned in the haddock comment the above function arr8 takes an 8-ary function and returns a 8 argument arrow. I use the function like this: (x1 &&& x2 &&& ... x8) >>> arr8 f whereby x1 to x8 are arrows.
My question: Is there a way to avoid the big tuple definition? Is there a more elegant implementation of arr8?
Info: I used the same code schema as in the function arr4 (see source code of arr4)
This works, though it depends on some quite deep and fragile typeclass magic. It also requires that we change the tuple structure to be a bit more regular. In particular, it should be a type-level linked list preferring (a, (b, (c, ()))) to (a, (b, c)).
{-# LANGUAGE TypeFamilies #-}
import Control.Arrow
-- We need to be able to refer to functions presented as tuples, generically.
-- This is not possible in any straightforward method, so we introduce a type
-- family which recursively computes the desired function type. In particular,
-- we can see that
--
-- Fun (a, (b, ())) r ~ a -> b -> r
type family Fun h r :: *
type instance Fun () r = r
type instance Fun (a, h) r = a -> Fun h r
-- Then, given our newfound function specification syntax we're now in
-- the proper form to give a recursive typeclass definition of what we're
-- after.
class Zup tup where
zup :: Fun tup r -> tup -> r
instance Zup () where
zup r () = r
-- Note that this recursive instance is simple enough to not require
-- UndecidableInstances, but normally techniques like this do. That isn't
-- a terrible thing, but if UI is used it's up to the author of the typeclass
-- and its instances to ensure that typechecking terminates.
instance Zup b => Zup (a, b) where
zup f ~(a, b) = zup (f a) b
arrTup :: (Arrow a, Zup b) => Fun b c -> a b c
arrTup = arr . zup
And now we can do
> zup (+) (1, (2, ()))
3
> :t arrTup (+)
arrTup (+)
:: (Num a1, Arrow a, Zup b n, Fun n b c ~ (a1 -> a1 -> a1)) =>
a b c
> arrTup (+) (1, (2, ()))
3
If you want to define the specific variants, they're all just arrTup.
arr8
:: Arrow arr
=> (a -> b -> c -> d -> e -> f -> g -> h -> r)
-> arr (a, (b, (c, (d, (e, (f, (g, (h, ())))))))) r
arr8 = arrTup
It's finally worth noting that if we define a lazy uncurry
uncurryL :: (a -> b -> c) -> (a, b) -> c
uncurryL f ~(a, b) = f a b
then we can write the recursive branch of Zup in a way that is illustrative to what's going on here
instance Zup b => Zup (a, b) where
zup f = uncurryL (zup . f)
My approach would be writing
arr8 f = arr (uncurry8 f)
I don't know if we can write a generic uncurryN n f function (probably not), but I can offer you a pointfree uncurry_n for each n in a systematic manner like so:
uncurry3 f = uncurry ($) . cross (uncurry . f) id
uncurry4 f = uncurry ($) . cross (uncurry3 . f) id
...
uncurry8 f = uncurry ($) . cross (uncurry7 . f) id
where
cross f g = pair (f . fst) (g . snd)
pair f g x = (f x, g x)
Using a lens library I can apply a modification function to individual targets, like so:
Prelude Control.Lens> (1, 'a', 2) & _1 %~ (*3)
(3,'a',2)
Prelude Control.Lens> (1, 'a', 2) & _3 %~ (*3)
(1,'a',6)
How can I combine those individual lenses (_1 and _3) to be able to perform this update to both of the targets at once? I expect something in the spirit of the following:
Prelude Control.Lens> (1, 'a', 2) & ??? %~ (*3)
(3,'a',6)
Using untainted from the Settable type class in Control.Lens.Internal.Setter, it is possible to combine two setters, but the result will also only be a setter and not a getter.
import Control.Lens.Internal.Setter
-- (&&&) is already taken by Control.Arrow
(~&~) :: (Settable f) => (c -> d -> f a) -> (c -> a -> t) -> c -> d -> t
(~&~) a b f = b f . untainted . a f
You can test this:
>>> import Control.Lens
>>> (1, 'a', 2) & (_1 ~&~ _3) %~ (*3)
(3,'a',6)
EDIT
You don't actually need to use internal functions. You can use the fact that Mutator is a monad:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad
import Control.Applicative
(~&~) = liftA2 (>=>)
-- This works too, and is maybe easier to understand:
(~&~) a b f x = a f x >>= b f
There is a variation on what you are asking for which is more general:
(/\)
:: (Functor f)
=> ((a -> (a, a)) -> (c -> (a, c)))
-- ^ Lens' c a
-> ((b -> (b, b)) -> (c -> (b, c)))
-- ^ Lens' c b
-> (((a, b) -> f (a, b)) -> (c -> f c))
-- ^ Lens' c (a, b)
(lens1 /\ lens2) f c0 =
let (a, _) = lens1 (\a_ -> (a_, a_)) c0
(b, _) = lens2 (\b_ -> (b_, b_)) c0
fab = f (a, b)
in fmap (\(a, b) ->
let (_, c1) = lens1 (\a_ -> (a_, a)) c0
(_, c2) = lens2 (\b_ -> (b_, b)) c1
in c2
) fab
infixl 7 /\
Just focus on the type signature with lens type synonyms:
Lens' c a -> Lens' c b -> Lens' c (a, b)
It takes two lenses and combines them into a lens to a pair of fields. This is slightly more general and works for combining lenses that point to fields of different types. However, then you'd have to mutate the two fields separately.
I just wanted to throw this solution out there in case people were looking for something like this.