Scott encoding for lists

Scott.hs

{-# LANGUAGE RankNTypes #-}

import Prelude hiding ((++), length)
import Control.Applicative
import Data.Foldable

newtype List a = List {
        uncons :: forall r . (a -> List a -> r) -> r -> r
    }


instance Functor List where
    fmap f xs = uncons xs (\ x xs -> cons (f x) (fmap f xs)) nil

instance Applicative List where
    pure = flip cons nil
    fs <*> xs = uncons fs builder nil
        where builder g gs = (fmap g xs) ++ (gs <*> xs)

instance Alternative List where
    empty = nil
    (<|>) = (++)

instance Foldable List where
    foldMap f xs = uncons xs (mapper f) mempty
        where mapper f y ys = (f y) `mappend` (foldMap f ys)


instance Monad List where
    xs >>= f = asum (fmap f xs)


nil :: List a
nil = List (\ consop nilop -> nilop)

cons :: a -> List a -> List a
cons x xs = List (\ consop nilop -> consop x xs)

(++) :: List a -> List a -> List a
xs ++ ys = uncons xs (\ z zs -> cons z (zs ++ ys)) ys