-- Code from Section 3.2

module Lists where

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

instance Show a => Show (List a) where
  show xs = show (fromL xs)

toL :: [a] -> List a
toL = unfoldL null head tail

fromL :: List a -> [a]
fromL = foldL (:) []

wrap :: a -> List a
wrap x = Cons x Nil

nil :: List a -> Bool
nil Nil = True
nil (Cons x xs) = False

foldL :: (a->b->b) -> b -> List a -> b
foldL f e Nil = e
foldL f e (Cons x xs) = f x (foldL f e xs)

-- answer to exercise 3.2, needed for the Trees module
mapL :: (a -> b) -> List a -> List b
mapL f = foldL (Cons . f) Nil

appendL :: List a -> List a -> List a
appendL xs ys = foldL Cons ys xs

concatL :: List (List a) -> List a
concatL = foldL appendL Nil

isort :: Ord a => List a -> List a
isort = foldL insert Nil
  where
    insert :: Ord a => a -> List a -> List a
    insert y Nil = wrap y
    insert y (Cons x xs) | y < x = Cons y (Cons x xs)
                         | otherwise = Cons x (insert y xs)

paraL :: (a -> (List a, b) -> b) -> b -> List a -> b
paraL f e Nil = e
paraL f e (Cons x xs) = f x (xs, paraL f e xs)

unfoldL' :: (b -> Maybe (a,b)) -> b -> List a
unfoldL' f u = case f u of
  Nothing -> Nil
  Just (x,v) -> Cons x (unfoldL' f v)

unfoldL :: (b->Bool) -> (b->a) -> (b->b) -> b -> List a
unfoldL p f g b = if p b then Nil else Cons (f b) (unfoldL p f g (g b))

foldL' :: (Maybe (a, b) -> b) -> List a -> b 
foldL' f Nil = f Nothing 
foldL' f (Cons x xs) = f (Just (x, foldL' f xs))

delmin :: Ord a => List a -> Maybe (a, List a)
delmin Nil = Nothing
delmin xs = Just (y, deleteL y xs) where y = minimumL xs

minimumL :: Ord a => List a -> a
minimumL (Cons x xs) = foldL min x xs

deleteL :: Eq a => a -> List a -> List a
deleteL y Nil = Nil
deleteL y (Cons x xs) | y == x = xs
                      | otherwise = Cons x (deleteL y xs)

ssort :: Ord a => List a -> List a
ssort = unfoldL' delmin

bubble :: Ord a => List a -> Maybe (a, List a)
bubble = foldL step Nothing where
  step :: Ord a => a -> Maybe (a, List a) -> Maybe (a, List a)
  step x Nothing = Just (x, Nil)
  step x (Just (y, ys)) 
    | x<y = Just (x, Cons y ys) 
    | otherwise = Just (y, Cons x ys)

bsort :: Ord a => List a -> List a
bsort = unfoldL' bubble

apoL' :: (b -> Maybe (a, Either b (List a))) -> b -> List a
apoL' f u = case f u of
  Nothing -> Nil
  Just (x, Left v) -> Cons x (apoL' f v)
  Just (x, Right xs) -> Cons x xs

fact :: Integer -> Integer
fact = foldL (*) 1 . unfoldL (==0) id pred

hyloL :: (a->c->c) -> c -> (b->Bool) -> (b->a) -> (b->b) -> (b->c)
hyloL f e p g h
-- the specification
  | False = foldL f e . unfoldL p g h
-- the deforested implementation
  | True = \ b -> if p b then e else f (g b) (hyloL f e p g h (h b))