Foldr all the way

List.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module List where

import Data.Bool (Bool)
import Data.Function (const)
import Data.Ord ((<=))
import GHC.Int (Int)
import GHC.Num ((-))

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr _ b [] = b
foldr f b (a : as) = f a (foldr f b as)

take :: Int -> [a] -> [a]
take num as =
  foldr alg (const []) as num
    where
      alg a f n =
        if n <= 0
          then []
          else a : f (n - 1)

-- take 2 [1, 2, 3]
-- foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [1, 2, 3] 2
-- (\a f n -> if n <= 0 then [] else a : f (n - 1)) 1 (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [2, 3]) 2
-- (\f n -> if n <= 0 then [] else 1 : f (n - 1)) (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [2, 3]) 2
-- (\n -> if n <= 0 then [] else 1 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [2, 3] (n - 1)) 2
-- if 2 <= 0 then [] else 1 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [2, 3] (2 - 1)
-- 1 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [2, 3] (2 - 1)
-- 1 : (\a f n -> if n <= 0 then [] else a : f (n - 1)) 2 (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [3]) (2 - 1)
-- 1 : (\f n -> if n <= 0 then [] else 2 : f (n - 1)) (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [3]) (2 - 1)
-- 1 : (\n -> if n <= 0 then [] else 2 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [3] (n - 1)) (2 - 1)
-- 1 : (\n -> if n <= 0 then [] else 2 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [3] (n - 1)) 1
-- 1 : if 1 <= 0 then [] else 2 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [3] (1 - 1)
-- 1 : 2 : (\a f n -> if n <= 0 then [] else a : f (n - 1)) 3 (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) []) (1 - 1)
-- 1 : 2 : (\f n -> if n <= 0 then [] else 3 : f (n - 1)) (foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) []) (1 - 1)
-- 1 : 2 : (\n -> if n <= 0 then [] else 3 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [] (n - 1)) (1 - 1)
-- 1 : 2 : (\n -> if n <= 0 then [] else 3 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [] (n - 1)) 0
-- 1 : 2 : if 0 <= 0 then [] else 3 : foldr (\a f n -> if n <= 0 then [] else a : f (n - 1)) (const []) [] (0 - 1)
-- 1 : 2 : []

drop :: Int -> [a] -> [a]
drop num as =
  foldr alg (const []) as num
    where
      alg a f n =
        if n <= 0
          then a : f n
          else f (n - 1)

zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith z =
  foldr alg (const [])
    where
      alg a f bs =
        case bs of
          [] -> []
          (b : bs') -> z a b : f bs'

-- foldr alg (const []) [1, 2] ['a', 'b']
-- alg 1 (foldr alg (const []) [2] ['a', 'b']
-- alg 1 (alg 2 (foldr alg (const [])) [] ['a', 'b']
-- alg 1 (alg 2 (const [])) ['a', 'b']
-- (\f bs -> case bs of [] -> []; (b : bs') -> z 1 b : f bs') (alg 2 (const [])) ['a', 'b']
-- (\f bs -> case bs of [] -> []; (b : bs') -> z 1 b : f bs') ((\f bs -> case bs of [] -> []; (b : bs') -> z 2 b : f bs') (const [])) ['a', 'b']
-- (\f bs -> case bs of [] -> []; (b : bs') -> z 1 b : f bs') (\bs -> case bs of [] -> []; (b : bs') -> z 2 b : const [] bs') ['a', 'b']
-- (\bs -> case bs of [] -> []; (b : bs') -> z 1 b : (\bs -> case bs of [] -> []; (b : bs') -> z 2 b : const [] bs') bs')  ['a', 'b']
-- z 1 'a' : (\bs -> case bs of [] -> []; (b : bs') -> z 2 b : const [] bs') ['b']
-- z 1 'a' : z 2 'b' : const [] []
-- z 1 'a' : z 2 'b' : []

dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p = foldr (\a as -> if p a then as else a : as) []

takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p = foldr (\a as -> if p a then a : as else []) []