Scott Encoding

ScottEncoding

{-# LANGUAGE RankNTypes #-}

module ScottEncoding where

import Data.Monoid

data ListS a = ListS { uncons :: forall r. (a -> ListS a -> r) -> r -> r }

consS :: a -> ListS a -> ListS a
consS x xs = ListS (\f z -> f x xs)

uncons' :: (a -> ListS a -> r) -> r -> ListS a -> r
uncons' f z xs = uncons xs f z 

nilS :: ListS a
nilS = ListS $ const id

toList :: Foldable t => t a -> ListS a
toList = foldMap (`consS` nilS)

instance Functor ListS where
  fmap f = uncons' (\x xs -> consS (f x) (fmap f xs)) nilS

instance Foldable ListS where 
  foldr f z = uncons' (\x xs -> f x (foldr f z xs)) z
 
instance Applicative ListS where
  pure x = consS x nilS
  fs <*> xs = foldr mappend nilS $ fmap (\f -> fmap f xs) fs

instance Monoid (ListS a) where
  mempty  = nilS
  mappend xs ys = foldr consS ys xs 
 
instance Traversable ListS where
  sequenceA = uncons' (\x xs -> consS <$> x <*> sequenceA xs) (pure nilS)
 
fromList :: ListS a -> [a]
fromList = foldMap (:[])