module Control.Category.Schoenfinkel
(
Schoenfinkel(..),
WrappedSchoenfinkel(..),
Schönfinkel,
WrappedSchönfinkel,
schön,
unschön,
hässlich
)
where
import Control.Applicative
import Control.Category
import Control.Arrow
import Prelude hiding ((.), id)
class (Category cat) => Schoenfinkel cat where
schoen :: cat (a, b) c -> cat a (cat b c)
unschoen :: cat a (cat b c) -> cat (a, b) c
instance Schoenfinkel (->) where
schoen = curry
unschoen = uncurry
instance (Monad m) => Schoenfinkel (Kleisli m) where
schoen (Kleisli f) =
Kleisli $ \x ->
return (Kleisli $ \y -> f (x, y))
unschoen (Kleisli f) =
Kleisli $ \(x, y) ->
f x >>= ($ y) . runKleisli
newtype WrappedSchoenfinkel cat a b =
WrappedSchoenfinkel {
unwrapSchoenfinkel :: cat a b
}
deriving (Alternative, Applicative, Arrow, ArrowApply,
ArrowChoice, ArrowLoop, ArrowPlus, ArrowZero,
Category, Functor)
instance (ArrowApply cat) => Schoenfinkel (WrappedSchoenfinkel cat) where
schoen (WrappedSchoenfinkel c) =
WrappedSchoenfinkel $
arr (\x -> WrappedSchoenfinkel $ c . arr ((,) x))
unschoen (WrappedSchoenfinkel c) =
WrappedSchoenfinkel $
app . arr (first unwrapSchoenfinkel) . first c
type Schönfinkel = Schoenfinkel
type WrappedSchönfinkel = WrappedSchoenfinkel
hässlich :: (Schoenfinkel cat) => cat a (cat b c) -> cat (a, b) c
hässlich = unschoen
schön :: (Schoenfinkel cat) => cat (a, b) c -> cat a (cat b c)
schön = schoen
unschön :: (Schoenfinkel cat) => cat a (cat b c) -> cat (a, b) c
unschön = unschoen