Schoenfinkel.hs

-- |
-- Module:     Control.Category.Schoenfinkel
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- This library generalizes 'curry' and 'uncurry' and also gives them
-- more appropriate names.
--
-- > import Control.Category.Schoenfinkel
-- >
-- > main :: IO ()
-- > main = print (unschoen atan2 (2, 3))
--
-- For your convenience there are also Unicode variants of both the
-- 'Schoenfinkel' class and its two functions.

module Control.Category.Schoenfinkel
    ( -- * Schoenfinkelization
      Schoenfinkel(..),

      -- * ArrowApply-based
      WrappedSchoenfinkel(..),

      -- * Unicode variants
      Schönfinkel,
      WrappedSchönfinkel,
      schön,
      unschön
    )
    where

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


-- | Categories that support Schönfinkelization.

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


-- | Every 'ArrowApply' gives rise to a 'Schoenfinkel'.

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


-- | Unicode version of 'Schoenfinkel' if you prefer.

type Schönfinkel = Schoenfinkel


-- | Unicode version of 'WrappedSchoenfinkel' if you prefer.

type WrappedSchönfinkel = WrappedSchoenfinkel


-- | Unicode version of 'schoen' if you prefer.

schön :: (Schoenfinkel cat) => cat (a, b) c -> cat a (cat b c)
schön = schoen


-- | Unicode version of 'unschoen' if you prefer.

unschön :: (Schoenfinkel cat) => cat a (cat b c) -> cat (a, b) c
unschön = unschoen