Skip to content

Instantly share code, notes, and snippets.

@petermarks
Created June 14, 2012 22:47
Show Gist options
  • Save petermarks/2933484 to your computer and use it in GitHub Desktop.
Save petermarks/2933484 to your computer and use it in GitHub Desktop.
Folds and unfolds
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment