diff options
Diffstat (limited to 'scratch')
-rw-r--r-- | scratch/haskell-programming-from-first-principles/foldable.hs | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/scratch/haskell-programming-from-first-principles/foldable.hs b/scratch/haskell-programming-from-first-principles/foldable.hs new file mode 100644 index 000000000000..5b59d9e9ba50 --- /dev/null +++ b/scratch/haskell-programming-from-first-principles/foldable.hs @@ -0,0 +1,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 |