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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
module FoldableScratch where
import Data.Function ((&))
--------------------------------------------------------------------------------
sum :: (Foldable t, Num a) => t a -> a
sum xs =
foldr (+) 0 xs
product :: (Foldable t, Num a) => t a -> a
product xs =
foldr (*) 1 xs
elem :: (Foldable t, Eq a) => a -> t a -> Bool
elem y xs =
foldr (\x acc -> if acc then acc else y == x) False xs
minimum :: (Foldable t, Ord a) => t a -> Maybe a
minimum xs =
foldr (\x acc ->
case acc of
Nothing -> Just x
Just curr -> Just (min curr x)) Nothing xs
maximum :: (Foldable t, Ord a) => t a -> Maybe a
maximum xs =
foldr (\x acc ->
case acc of
Nothing -> Nothing
Just curr -> Just (max curr x)) Nothing xs
-- TODO: How could I use QuickCheck to see if Prelude.null and this null return
-- the same results for the same inputs?
null :: (Foldable t) => t a -> Bool
null xs =
foldr (\_ _ -> False) True xs
length :: (Foldable t) => t a -> Int
length xs =
foldr (\_ acc -> acc + 1) 0 xs
toList :: (Foldable t) => t a -> [a]
toList xs =
reverse $ foldr (\x acc -> x : acc) [] xs
fold :: (Foldable t, Monoid m) => t m -> m
fold xs =
foldr mappend mempty xs
foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
foldMap f xs =
foldr (\x acc -> mappend (f x) acc) mempty xs
--------------------------------------------------------------------------------
data List a = Nil | Cons a (List a) deriving (Eq, Show)
instance Foldable List where
foldr f acc (Cons x rest) = foldr f (f x acc) rest
foldr f acc Nil = acc
fromList :: [a] -> List a
fromList [] = Nil
fromList (x:rest) = Cons x (fromList rest)
--------------------------------------------------------------------------------
data Constant a b = Constant b deriving (Eq, Show)
-- TODO: Is this correct?
instance Foldable (Constant a) where
foldr f acc (Constant x) = f x acc
--------------------------------------------------------------------------------
data Two a b = Two a b deriving (Eq, Show)
instance Foldable (Two a) where
foldr f acc (Two x y) = f y acc
--------------------------------------------------------------------------------
data Three a b c = Three a b c deriving (Eq, Show)
instance Foldable (Three a b) where
foldr f acc (Three x y z) = f z acc
--------------------------------------------------------------------------------
data Three' a b = Three' a b b deriving (Eq, Show)
instance Foldable (Three' a) where
foldr f acc (Three' x y z) = acc & f z & f y
--------------------------------------------------------------------------------
data Four' a b = Four' a b b b deriving (Eq, Show)
instance Foldable (Four' a) where
foldr f acc (Four' w x y z) = acc & f z & f y & f x
--------------------------------------------------------------------------------
filterF :: (Applicative f, Foldable t, Monoid (f a)) => (a -> Bool) -> t a -> f a
filterF pred xs =
foldr (\x acc -> if pred x then pure x `mappend` acc else acc) mempty xs
|
