diff --git a/12-signaling-adversity/src/binarytree.hs b/12-signaling-adversity/src/binarytree.hs new file mode 100644 index 0000000..0c1fef1 --- /dev/null +++ b/12-signaling-adversity/src/binarytree.hs @@ -0,0 +1,17 @@ +module BinaryTree where + + data BinaryTree a = Leaf | Node (BinaryTree a) a (BinaryTree a) + deriving (Eq, Ord, Show) + + unfold :: (a -> Maybe (a,b,a)) -> a -> BinaryTree b + unfold f a = + case (f a) of + Nothing -> Leaf + Just (a',b,a'') -> Node (unfold f a') b (unfold f a'') + + treeBuild :: Integer -> BinaryTree Integer + treeBuild l = unfold f (0 :: Integer) + where f n + | n < 0 = Nothing + | n >= l = Nothing + | otherwise = Just (n+1, n, n+1) \ No newline at end of file diff --git a/12-signaling-adversity/src/itunfold.hs b/12-signaling-adversity/src/itunfold.hs new file mode 100644 index 0000000..d930d88 --- /dev/null +++ b/12-signaling-adversity/src/itunfold.hs @@ -0,0 +1,12 @@ +module ItUnfold where + + myIterate :: (a -> a) -> a -> [a] + myIterate f a = a : myIterate f (f a) + + myUnfoldr :: (b -> Maybe (a,b)) -> b -> [a] + myUnfoldr f b = case (f b) of + Nothing -> [] + Just (a,b') -> a : myUnfoldr f b' + + betterIterate :: (a -> a) -> a -> [a] + betterIterate f a = myUnfoldr (\x -> Just(x, f x)) a \ No newline at end of file diff --git a/12-signaling-adversity/src/libeither.hs b/12-signaling-adversity/src/libeither.hs new file mode 100644 index 0000000..3ab7d1f --- /dev/null +++ b/12-signaling-adversity/src/libeither.hs @@ -0,0 +1,27 @@ +module LibEither where + + lefts' :: [Either a b] -> [a] + lefts' = foldr f [] + where f (Right _) xs = xs + f (Left a) xs = a : xs + + rights' :: [Either a b] -> [b] + rights' = foldr f [] + where f (Left _) xs = xs + f (Right a) xs = a : xs + + partitionEithers' :: [Either a b] -> ([a],[b]) + partitionEithers' = foldr f ([],[]) + where f (Left a) (xs,ys) = (a:xs, ys) + f (Right b) (xs,ys) = (xs, b:ys) + + eitherMaybe' :: (b -> c) -> Either a b -> Maybe c + eitherMaybe' _ (Left _) = Nothing + eitherMaybe' f (Right b) = Just $ f b + + either' :: (a -> c) -> (b -> c) -> Either a b -> c + either' f _ (Left a) = f a + either' _ g (Right b) = g b + + eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c + eitherMaybe'' g = either' (\_ -> Nothing) (Just . g) \ No newline at end of file diff --git a/12-signaling-adversity/src/libmaybe.hs b/12-signaling-adversity/src/libmaybe.hs new file mode 100644 index 0000000..d289612 --- /dev/null +++ b/12-signaling-adversity/src/libmaybe.hs @@ -0,0 +1,36 @@ +module LibMaybe where + + isJust :: Maybe a -> Bool + isJust (Just _) = True + isJust _ = False + + isNothing :: Maybe a -> Bool + isNothing Nothing = True + isNothing _ = False + + mayybee :: b -> (a -> b) -> Maybe a -> b + mayybee b _ Nothing = b + mayybee _ f (Just a) = f a + + fromMaybe :: a -> Maybe a -> a + fromMaybe a Nothing = a + fromMaybe _ (Just a) = a + + listToMaybe :: [a] -> Maybe a + listToMaybe [] = Nothing + listToMaybe (x:_) = Just x + + maybeToList :: Maybe a -> [a] + maybeToList Nothing = [] + maybeToList (Just a) = a:[] + + catMaybes :: [Maybe a] -> [a] + catMaybes [] = [] + catMaybes (Nothing:xs) = catMaybes xs + catMaybes (Just a:xs) = a : catMaybes xs + + flipMaybe :: [Maybe a] -> Maybe [a] + flipMaybe = foldr f (Just []) + where f Nothing _ = Nothing + f _ Nothing = Nothing + f (Just a) (Just xs) = Just $ a : xs \ No newline at end of file diff --git a/12-signaling-adversity/src/naturals.hs b/12-signaling-adversity/src/naturals.hs new file mode 100644 index 0000000..82a71a2 --- /dev/null +++ b/12-signaling-adversity/src/naturals.hs @@ -0,0 +1,13 @@ +module Naturals where + + data Nat = Zero | Succ Nat deriving (Eq, Show) + + natToInteger :: Nat -> Integer + natToInteger Zero = 0 + natToInteger (Succ n) = 1 + natToInteger n + + integerToNat :: Integer -> Maybe Nat + integerToNat n + | n < 0 = Nothing + | n == 0 = Just Zero + | otherwise = fmap Succ $ integerToNat (n-1) \ No newline at end of file diff --git a/12-signaling-adversity/src/stringproc.hs b/12-signaling-adversity/src/stringproc.hs new file mode 100644 index 0000000..2e4d6ac --- /dev/null +++ b/12-signaling-adversity/src/stringproc.hs @@ -0,0 +1,38 @@ +module StringProc where + + -- 1 + notThe :: String -> Maybe String + notThe "the" = Nothing + notThe s = Just s + + replaceThe :: String -> String + replaceThe = unwords . fmap rep . fmap notThe . words + where rep Nothing = "a" + rep (Just t) = t + + -- 2 + startsWithVowel :: String -> Bool + startsWithVowel "" = False + startsWithVowel (c:_) = elem c "aeiou" + + -- Probably better ways of doing this + -- but wanted to see if this was actually + -- possible! + countTheBeforeVowel :: String -> Integer + countTheBeforeVowel = + toInteger . length . f . + (fmap .fmap) startsWithVowel . + fmap notThe . words + where f [] = [] + f (_:[]) = [] + f ((Just _):xs) = f xs + f (Nothing:Nothing:xs) = f (Nothing:xs) + f (Nothing:Just False:xs) = f xs + f (Nothing:Just True:xs) = [True] ++ f xs + + -- 3 + isVowel :: Char -> Bool + isVowel = (flip elem) "aeiou" + + countVowels :: String -> Integer + countVowels = toInteger . length . filter isVowel \ No newline at end of file diff --git a/12-signaling-adversity/src/validateword.hs b/12-signaling-adversity/src/validateword.hs new file mode 100644 index 0000000..c0ce4b3 --- /dev/null +++ b/12-signaling-adversity/src/validateword.hs @@ -0,0 +1,17 @@ +module ValidateWord where + + import Data.List + + newtype Word' = Word' String deriving (Eq, Show) + + vowels :: String + vowels = "aeiou" + + isVowel :: Char -> Bool + isVowel = (flip elem) vowels + + mkWord :: String -> Maybe Word' + mkWord s = check $ partition isVowel s + where check (xs,ys) + | length xs >= length ys = Nothing + | otherwise = Just $ Word' s \ No newline at end of file diff --git a/12.5-chapter-exercises.md b/12.5-chapter-exercises.md new file mode 100644 index 0000000..05ce0b2 --- /dev/null +++ b/12.5-chapter-exercises.md @@ -0,0 +1,25 @@ +# Chapter Exercises +## Determine the kinds +1. `*` +2. `* -> *` + +## String processing +see src/stringproc.hs + +## Validate the words +see src/validateword.hs + +## It's only Natural +see src/naturals.hs + +## Small library for Maybe +see src/libmaybe.hs + +## Small library for Either +see src/libeither.hs + +## Write your own iterate and unfoldr +see src/itunfold.hs + +## Finally something other than a list! +see src/binarytree.hs