module Data.Fun (Fun(..), apply) where
import Control.Applicative (Applicative(..))
import Control.Arrow hiding (pure)
data Fun t a = K a
| Fun (t -> a)
apply :: Fun t a -> (t -> a)
apply (K a) = const a
apply (Fun f) = f
instance Functor (Fun t) where
fmap f (K a) = K (f a)
fmap f (Fun g) = Fun (f.g)
instance Applicative (Fun t) where
pure = K
K f <*> K x = K (f x)
cf <*> cx = Fun (apply cf <*> apply cx)
instance Monad (Fun t) where
return = pure
K a >>= h = h a
Fun f >>= h = Fun (f >>= apply . h)
instance Arrow Fun where
arr = Fun
_ >>> K b = K b
K a >>> Fun g = K (g a)
Fun g >>> Fun f = Fun (g >>> f)
first = Fun . first . apply
second = Fun . second . apply
K a' *** K b' = K (a',b')
f *** g = first f >>> second g