generalized flip

RotateArgs.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module RotateArgs where

data Z = Z
data S n = S n

class RotateArgs n a where
    type Rotate n a :: *    
    rotate :: n -> a -> Rotate n a

-- rotate Z = ($)
instance RotateArgs Z (a -> b) where
    type Rotate Z (a -> b) = a -> b
    rotate Z f = f

-- rotate (S Z) = flip
instance RotateArgs (S Z) (a -> b -> c) where
    type Rotate (S Z) (a -> b -> c) = b -> a -> c
    rotate (S Z) f = flip f

-- rotate n f = \xn x1 x2 .. -> f x1 x2 ... xn
instance ( RotateArgs (S n) b
         , RotateArgs (S Z) (a -> Rotate (S n) b) 
         ) => RotateArgs (S (S n)) (a -> b) where
    type Rotate (S (S n)) (a -> b) = Rotate (S Z) (a -> Rotate (S n) b)
    rotate (S n) f = rotate (S Z) $ rotate n . f


type One = S Z
one = S Z :: One

type Two = S One
two = S one :: Two

type Three = S Two
three = S two :: Three

type Four = S Three
four = S three :: Four

-- inferred type: foo :: d -> e -> a -> b -> c -> (a, b, c, d, e)
foo = rotate four (rotate four (,,,,))