Folds and unfolds

folds.hs

{-# LANGUAGE ViewPatterns, GADTs, KindSignatures, ScopedTypeVariables #-}
import Data.List

foldr2 :: (a -> b -> b) -> b -> [a] -> b
foldr2 f b [] = b
foldr2 f b (x:xs) = f x (foldr2 f b xs)

foldr3 :: ((a,b)->b,()->b) -> [a] -> b
foldr3 (f,b) [] = b ()
foldr3 (f,b) (x:xs) = f (x, foldr3 (f,b) xs)

foldr4 :: (Either (a,b) () -> b) -> [a] -> b
foldr4 f       [] = f $ Right ()
foldr4 f (x : xs) = f $ Left (x, foldr4 f xs)

unfoldr2 :: (b -> Either (a,b) ()) -> b -> [a]
unfoldr2 f (f -> Right ()                   ) = []
unfoldr2 f (f -> Left  (x, unfoldr2 f -> xs)) = (x : xs) 

unfoldr3 :: (b -> Either (a,b) ()) -> b -> [a]
unfoldr3 f b = case f b of
	Right ()      -> []
	Left  (x, b') -> case (unfoldr3 f b') of xs -> (x : xs) 

process :: Either (Int,Int) () -> Int
process (Left (x,y)) = x + y
process (Right ()) = 0

pair2either :: (a -> c, b -> c) -> Either a b -> c
pair2either (f, g) (Left a) = f a
pair2either (f, g) (Right b) = g b

stars :: Int -> String
stars n = unfoldr go n
  where
  	go :: Int -> Maybe (Char,Int)
  	go 0 = Nothing
  	go n = Just ('*',n-1)

stars2 :: Int -> String
stars2 n = unfoldr3 go n
  where
  	go :: Int -> Either (Char,Int) () -- Int -> X String Int String
  	go 0 = Right ()        -- X []
  	go n = Left ('!',n-1)  -- X (:) :$ '!' :? (n - 1)

data X :: * -> * -> * -> * where
	X    :: a -> X c s a
	(:$) :: X c s (a -> b) -> a -> X c s b
	(:?) :: X c s (c -> b) -> s -> X c s b

unf :: forall s c . (s -> X c s c) -> s -> c
unf f = go . f
	where
		go :: X c s b -> b
		go (X x)    = x
		go (x :$ v) = go x v
		go (x :? s) = go x (unf f s)

stars3 :: Int -> String
stars3 n = unf go n
  where
  	go :: Int -> X String Int String
  	go 0 = X []
  	go n = X (:) :$ '!' :? (n - 1)

data List a = Nil | Cons a (List a)

data List2 :: * -> * where
	Nil2  :: List2 a
 	Cons2 :: a -> List2 a -> List2 a