public
Created

Folds and unfolds

  • Download Gist
folds.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
{-# 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.