How to implement "first" for ArrowApply?

Question

In "Programming with Arrows", Hughes asserts

First of all, note that both first and left are easy to implement in terms of app (the details are left as an exercise).

From Control.Arrow, left can be implemented as:

leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d)
leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||
                 (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app

How do I implement first with just arr, >>>, and app?

Answer 1

I think I got it, but I would be very interested if there is a simpler solution

firstApp :: ArrowApply cat => cat t t1 -> cat (t, t2) (t1, t2)
firstApp f = arr (\(x, y) -> (arr (\() -> (f, x))) >>>
                             app >>>
                             (arr (\v -> (v, y)))) >>>
             arr (\v -> (v, ())) >>>
             app