gistfile1.hs

import Control.Arrow
import Control.Applicative
import Control.Category
import Prelude hiding ((.), id)

-- * Arrow from an applicative

newtype AppArrow f a b = AppArrow (f (a -> b))

instance (Applicative f) => Category (AppArrow f) where
    id = arr id
    AppArrow f . AppArrow g = AppArrow ((.) <$> f <*> g)
instance (Applicative f) => Arrow (AppArrow f) where
    arr = AppArrow . pure
    first (AppArrow f) = AppArrow (fmap first f)

-- * Applicative from an arrow

newtype ArrowApp a b c = ArrowApp (a b c)

instance (Arrow a) => Functor (ArrowApp a b) where
    fmap f (ArrowApp a) = ArrowApp $ f ^<< a
instance (Arrow a) => Applicative (ArrowApp a b) where
    pure = ArrowApp . arr . const
    ArrowApp f <*> ArrowApp g = ArrowApp $ arr (uncurry ($)) . (f &&& g)