diff --git a/18-monad/src/EitherMonad.hs b/18-monad/src/EitherMonad.hs index 167a39e..b2c9e92 100644 --- a/18-monad/src/EitherMonad.hs +++ b/18-monad/src/EitherMonad.hs @@ -44,11 +44,11 @@ main = do -- We can't just do -- m >>= (f >>= g) because f is not of type (Monoid m => m b) -- We want to pass an m to an h --- m >>= h +-- m >>= h -- where h is to be determined, we know it is of form (Monoid m => a -> m b) -- and it should be based on f >>= g, this doesn't work, but we could apply -- f to an `a` and provide that to the: -- h x = f x >>= g --- This is can be done via anonymous function: +-- This is can be done via anonymous function: -- m >>= (\x -> f x >>= g) -- join (fmap (\x -> join (fmap g (f x))) m) \ No newline at end of file diff --git a/18-monad/src/bind.hs b/18-monad/src/bind.hs index 603014e..d8089c1 100644 --- a/18-monad/src/bind.hs +++ b/18-monad/src/bind.hs @@ -3,4 +3,4 @@ module Bind where import Control.Monad (join) bind :: Monad m => (a -> m b) -> m a -> m b -bind = join . fmap f \ No newline at end of file +bind f = join . fmap f diff --git a/18-monad/src/examples.hs b/18-monad/src/examples.hs index 94a3079..06c2adb 100644 --- a/18-monad/src/examples.hs +++ b/18-monad/src/examples.hs @@ -1,6 +1,7 @@ module Examples where import Control.Monad (join) +import Control.Applicative (liftA3) twiceWhenEven :: [Integer] -> [Integer] twiceWhenEven xs = do @@ -28,7 +29,7 @@ noEmpty s = Just s noNegative :: Int -> Maybe Int noNegative n | n >= 0 = Just n | otherwise = Nothing - + weightCheck :: Cow -> Maybe Cow weightCheck c = let w = weight c @@ -90,7 +91,7 @@ mkSphericalCow''' name' age' weight' = -- (fmap :: (String -> Maybe Cow) -> Maybe String -> Maybe (Maybe Cow)) -- Using join, reduces this to jsut a Maybe Cow, this gives us the -- Maybe Cow - + -- mkSphericalCow''' :: String -> Int -> Int -> Maybe Cow -- mkSphericalCow''' name' age' weight' = z name' age' weight' -- where z :: String -> Int -> Int -> Maybe Cow @@ -120,5 +121,7 @@ doSomething' n = do pure (a, b, c) doSomething'' :: Integer -> Maybe (Integer, Integer, String) -doSomething'' n = - (pure g) <*> (f n) \ No newline at end of file +doSomething'' n = liftA3 (,,) a b c + where a = f n + b = join $ pure g <*> a -- need join here... + c = join $ pure h <*> b -- need join here... diff --git a/18-monad/src/functions.hs b/18-monad/src/functions.hs index 6e080d9..e5c461f 100644 --- a/18-monad/src/functions.hs +++ b/18-monad/src/functions.hs @@ -10,7 +10,7 @@ l1 :: Monad m => (a -> b) -> m a -> m b l1 f x = do a' <- x return $ f a' -l1 f x = x >>= (return . f) +-- l1 f x = x >>= (return . f) -- with fmap :) -- l1 = fmap @@ -20,7 +20,7 @@ l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c l2 f x y = do a' <- x b <- y - return $ f a' b + return $ f a' b -- l2 f x y = x >>= (\a -> y >>= \b -> return $ f a b) -- with fmap -- l2 f x y = (fmap f x) <*> y diff --git a/18-monad/src/instances.hs b/18-monad/src/instances.hs index 6109968..3f1488b 100644 --- a/18-monad/src/instances.hs +++ b/18-monad/src/instances.hs @@ -4,7 +4,6 @@ import Test.QuickCheck import Test.QuickCheck.Checkers import Test.QuickCheck.Classes --- import Control.Monad (join) import Control.Applicative (liftA2) -- 1 @@ -74,9 +73,7 @@ instance Monoid (List a) where mappend Nil l = l mappend (Cons a l) l' = Cons a (mappend l l') instance Applicative List where - {-# INLINE pure #-} pure = flip Cons Nil - {-# INLINE (<*>) #-} Nil <*> _ = Nil _ <*> Nil = Nil (Cons f fl) <*> as = (fmap f as) `mappend` (fl <*> as) @@ -85,44 +82,22 @@ instance Monad List where Nil >>= _ = Nil (Cons a l) >>= k = (k a) `mappend` (l >>= k) - -- I originally had the above, because I thought that you could not - -- use join, but I found a solution online that uses join. Trying to - -- understand: - -- join is defined as (join x = x >>= id) - -- You might think, wait a minute? id is (a -> a) and thus doesn't fit the - -- bill of (a -> m b), but let's look at things more closely - -- - -- (>>=) :: m a -> (a -> m b) -> m b - -- a here is the type of x :: (m a') - -- b here is the inner type of x :: a', - -- updating gives us: - -- (>>=) :: m (m a') -> (m a' -> m a') -> m a' - -- and we see that we can pass the id function to it - - -- This turns the >>= definition into a recursive one where the second time - -- the function is the id, which will join it all - - -- unfortunately this crashes when testing the monad laws ... Why? - -- because this never ends... You get - -- fmap id (fmap id (... (fmap id (fmap f as)))) - -- as >>= f = join $ fmap f as - --- toList :: [a] -> List a --- toList [] = Nil --- toList (x:xs) = Cons x $ toList xs - +-- The following is needed to get an Arbitrary for the List. I got the idea +-- from looking at how it is done for []. It's not very efficient though. replicateM' :: Applicative m => Int -> m a -> m (List a) replicateM' cnt0 f = loop cnt0 where loop cnt | cnt <= 0 = pure Nil | otherwise = liftA2 Cons f (loop (cnt - 1)) - + listOf' :: Gen a -> Gen (List a) listOf' gen = sized $ \n -> do k <- choose (0,n) replicateM' k gen - +-- toList :: [a] -> List a +-- toList [] = Nil +-- toList (x:xs) = Cons x $ toList xs instance Arbitrary a => Arbitrary (List a) where arbitrary = listOf' arbitrary -- arbitrary = fmap toList (listOf arbitrary)