liftAN и liftMN по аналогии с http://typesandkinds.wordpress.com/2012/11/26/variable-arity-zipwith/ см http://chatlogs.jabber.ru/[email protected]/2013/02/06.html#01:08:08.379217

Lift.hs

{-# LANGUAGE TypeFamilies, DataKinds, GADTs, NoMonomorphismRestriction #-}

-- http://typesandkinds.wordpress.com/2012/11/26/variable-arity-zipwith/

module Main where

import Prelude hiding (map, zipWith, zipWith3)
import Control.Applicative hiding (liftA, liftA2, liftA3)
import Control.Monad hiding (liftM, liftM2, liftM3)

data Nat = Zero | Succ Nat

-- Map the type constructor f over the types of arguments and return value of
-- a function
type family   Lift (f :: * -> *) (n :: Nat) (arrows :: *) :: *
type instance Lift f (Succ n) (a -> b) = f a -> Lift f n b
type instance Lift f Zero a = f a

-- Evidence that a function has at least a certain number of arguments
data NumArgs :: Nat -> * -> * where
  NAZero :: NumArgs Zero a
  NASucc :: NumArgs n b -> NumArgs (Succ n) (a -> b)

liftAN :: Applicative f => NumArgs n a -> f a -> Lift f n a
liftAN NAZero fs = fs
liftAN (NASucc na) fs = liftAN na . (fs <*>)

liftMN :: Monad f => NumArgs n a -> f a -> Lift f n a
liftMN NAZero fs = fs
liftMN (NASucc na) fs = liftMN na . ap fs

listApply :: NumArgs n a -> [a] -> Lift [] n a
listApply NAZero fs = fs
listApply (NASucc na) fs = listApply na . apply fs where
    apply (f:fs) (x:xs) = f x : apply fs xs
    apply _      _      = []

zipWithN :: NumArgs numArgs f -> f -> Lift [] numArgs f
zipWithN na f = listApply na (repeat f)

oneArg = NASucc NAZero
twoArgs = NASucc oneArg
threeArgs = NASucc twoArgs

liftA  = liftAN oneArg    . pure
liftA2 = liftAN twoArgs   . pure
liftA3 = liftAN threeArgs . pure

liftM  = liftMN oneArg    . return
liftM2 = liftMN twoArgs   . return
liftM3 = liftMN threeArgs . return

map      = zipWithN oneArg
zipWith  = zipWithN twoArgs
zipWith3 = zipWithN threeArgs

example1 = liftA not [False,True]
example2 = liftA2 (+) [1,3] [4,5]
example3 = liftA2 (&&) (Just False) (Just True)
example4 = liftA2 (&&) (Just False) Nothing

splotch :: Int -> Char -> Double -> String
splotch a b c = show a ++ show b ++ show c

example5 = liftA3 splotch [1,2,3] ['a','b','c'] [3.14, 2.1728, 1.01001]

main = do print example1; print example2; print example3; print example4; print example5