From 2cf4da8c610d97190aeda99a2cab6d1d552e7c8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABl=20Depreeuw?= Date: Mon, 21 May 2018 01:35:43 +0200 Subject: [PATCH] Fix chapter 22 --- 22-reader/22-reader.md | 66 ++++++++++++++++++++ 22-reader/22.11-chapter-excercises.md | 10 --- 22-reader/22.2-warming-up.md | 2 - 22-reader/22.5-ask.md | 2 - 22-reader/22.6-reading-comprehension.md | 2 - 22-reader/22.7-reader-monad.md | 2 - 22-reader/shawty-prime/app/Main.hs | 81 +++++++++---------------- 22-reader/src/WithReaderT.hs | 64 +++++++++++++++++++ 8 files changed, 160 insertions(+), 69 deletions(-) create mode 100644 22-reader/22-reader.md delete mode 100644 22-reader/22.11-chapter-excercises.md delete mode 100644 22-reader/22.2-warming-up.md delete mode 100644 22-reader/22.5-ask.md delete mode 100644 22-reader/22.6-reading-comprehension.md delete mode 100644 22-reader/22.7-reader-monad.md create mode 100644 22-reader/src/WithReaderT.hs diff --git a/22-reader/22-reader.md b/22-reader/22-reader.md new file mode 100644 index 0000000..663cd67 --- /dev/null +++ b/22-reader/22-reader.md @@ -0,0 +1,66 @@ +# 22 Reader + +## 22.2 Short Exercise: Warming up + +[src/warmingup.hs](./src/warmingup.hs) + +## 22.5 Excercise: Ask + +[src/ask.hs](./src/ask.hs) + +## 22.6 Exercise: Reading Comprehension + +[src/readingcomp.hs](./src/readingcomp.hs) + +## 22.7 Exercise: Reader Monad + +[src/readingcomp.hs](./src/readingcomp.h) + +## 22.9 You can change what comes below, but not above + +Trying to understand the following quote: + +> You can swap in a different type or value of `r` for function that you call, +> but not for functions that call you. + +Perhaps a better way of saying this would be: + +> You can can choose the input for a function you are calling, but cannot +> change the input from within the function. + +The input being the context of a `Reader`. This makes sense, consider: + +`f :: a -> b` + +When we call `f`, we can choose any input value or type to use. However, within +`f`, the value and type are fixed. Immutable. The same applies of course for +`Reader a b` as this is just a `newtype` for `f`. + +```haskell +f :: Reader Integer String +f = do + r <- ask + -- we cannot change r, but we can do operations on them + return $ show (r * r) + +-- However, we can change the input for f when we call it: +g :: Reader Integer String +g = do + r <- ask + -- either via: + -- return $ runReader f (r + 1) + -- or: + withReader (+1) f +``` + +## 22.11 Chapter exercises + +### A warmup stretch + +[src/ReaderPractise.hs](./src/ReaderPractise.hs) + +### Rewriting Shawty + +No idea if this is what was requested, but it works: + +[shawty-prime/app/Main.hs](./shawty-prime/app/Main.hs) \ No newline at end of file diff --git a/22-reader/22.11-chapter-excercises.md b/22-reader/22.11-chapter-excercises.md deleted file mode 100644 index 5ecec18..0000000 --- a/22-reader/22.11-chapter-excercises.md +++ /dev/null @@ -1,10 +0,0 @@ -# Chapter Excercises -## A warmup stretch -see src/ReaderPractise - -## Rewriting Shawty -No idea if this is correct. - -see shawty-prime/app/Main.hs - -I can create a `ReaderT` from `app` and that works, but I can't do the same with `saveURI` and `getURI` and find how to connect it up with `app`. \ No newline at end of file diff --git a/22-reader/22.2-warming-up.md b/22-reader/22.2-warming-up.md deleted file mode 100644 index 91dc363..0000000 --- a/22-reader/22.2-warming-up.md +++ /dev/null @@ -1,2 +0,0 @@ -# Short Exercise: Warming Up -see src/warmingup.hs \ No newline at end of file diff --git a/22-reader/22.5-ask.md b/22-reader/22.5-ask.md deleted file mode 100644 index 1f65d09..0000000 --- a/22-reader/22.5-ask.md +++ /dev/null @@ -1,2 +0,0 @@ -# Excercise: Ask -see src/ask.hs \ No newline at end of file diff --git a/22-reader/22.6-reading-comprehension.md b/22-reader/22.6-reading-comprehension.md deleted file mode 100644 index cd8bd86..0000000 --- a/22-reader/22.6-reading-comprehension.md +++ /dev/null @@ -1,2 +0,0 @@ -# Exercise: Reading Comprehension -see src/readingcomp.hs \ No newline at end of file diff --git a/22-reader/22.7-reader-monad.md b/22-reader/22.7-reader-monad.md deleted file mode 100644 index 4f786c2..0000000 --- a/22-reader/22.7-reader-monad.md +++ /dev/null @@ -1,2 +0,0 @@ -# Exercise: Reader Monad -see src/readingcomp.hs \ No newline at end of file diff --git a/22-reader/shawty-prime/app/Main.hs b/22-reader/shawty-prime/app/Main.hs index 70f92fb..00d4e5b 100644 --- a/22-reader/shawty-prime/app/Main.hs +++ b/22-reader/shawty-prime/app/Main.hs @@ -29,29 +29,20 @@ shortyGen :: IO String shortyGen = replicateM 7 (randomElement alphaNum) -saveURI :: R.Connection - -> BC.ByteString - -> BC.ByteString - -> IO (Either R.Reply R.Status) -saveURI conn shortURI uri = - R.runRedis conn $ R.set shortURI uri - --- No idea how to use this now... -saveURI' :: BC.ByteString - -> BC.ByteString - -> ReaderT R.Connection IO (Either R.Reply R.Status) +saveURI' :: BC.ByteString + -> BC.ByteString + -> ReaderT R.Connection IO (Either R.Reply R.Status) saveURI' shortURI uri = do conn <- ask - liftIO $ R.runRedis conn $ R.set shortURI uri + -- conn :: R.Connection + -- R.set shortURI uri :: R.RedisCtx m f => m (f R.Status) + -- R.runRedis conn $ R.set shortURI uri :: IO (Either R.Reply R.Status) + -- either liftIO or lift should work: + -- liftIO $ R.runRedis conn $ R.set shortURI uri + lift $ R.runRedis conn $ R.set shortURI uri -getURI :: R.Connection - -> BC.ByteString - -> IO (Either R.Reply (Maybe BC.ByteString)) -getURI conn shortURI = R.runRedis conn $ R.get shortURI - --- No idea how to use this now... getURI' :: BC.ByteString - -> ReaderT R.Connection IO (Either R.Reply (Maybe BC.ByteString)) + -> ReaderT R.Connection IO (Either R.Reply (Maybe BC.ByteString)) getURI' shortURI = do conn <- ask liftIO $ R.runRedis conn $ R.get shortURI @@ -97,53 +88,41 @@ myGet respIO = do app :: ReaderT R.Connection ScottyM () app = do + -- get "/" :: ActionM () -> ScottyM () + -- We need this to be a ReaderT R.Connection ScottyM () + -- mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b + -- Just what we need! mapReaderT (get "/") $ do + -- We are in the ReaderT R.Connection ActionM () monad + -- param "uri" :: Parsable a => ActionM a + -- which we lift into the ReaderT R.Connection + -- lift :: m a -> t m a (t here is ReaderT R.Connection) uri <- lift $ param "uri" let parsedUri :: Maybe URI parsedUri = parseURI (TL.unpack uri) case parsedUri of Just _ -> do + -- shortyGen :: IO String + -- needs to be made into ReaderT R.Connection ActionM a + -- liftIO :: MonadIO m => IO a -> m a + -- ReaderT R.Connection ActionM is an MonadIO, so we're good shawty <- liftIO shortyGen let shorty = BC.pack shawty uri' = encodeUtf8 (TL.toStrict uri) + -- mySave shawty :: IO (Either R.reply R.status) -> ActionM () + --we need to map that into the ReaderT using mapReaderT again + -- which gives us a + -- ReaderT R.Connection IO (Either R.Reply R.Status) -> + -- ReaderT R.Connection ActionM () mapReaderT (mySave shawty) $ saveURI' shorty uri' + -- text (shortyAintUri uri) :: ActionM () , so we lift this into + -- ReaderT R.Connection Nothing -> lift $ text (shortyAintUri uri) mapReaderT (get "/:short") $ do short <- lift $ param "short" mapReaderT myGet $ getURI' short --- app :: ReaderT R.Connection ScottyM () --- app = do --- rConn <- ask --- lift $ do --- get "/" $ do --- uri <- param "uri" --- let parsedUri :: Maybe URI --- parsedUri = parseURI (TL.unpack uri) --- case parsedUri of --- Just _ -> do --- shawty <- liftIO shortyGen --- let shorty = BC.pack shawty --- uri' = encodeUtf8 (TL.toStrict uri) --- resp <- liftIO (saveURI rConn shorty uri') --- html (shortyCreated resp shawty) --- Nothing -> text (shortyAintUri uri) --- get "/:short" $ do --- short <- param "short" --- uri <- liftIO (getURI rConn short) --- case uri of --- Left reply -> text (TL.pack (show reply)) --- Right mbBS -> case mbBS of --- Nothing -> text "uri not found" --- Just bs -> html (shortyFound tbs) --- where tbs :: TL.Text --- tbs = TL.fromStrict (decodeUtf8 bs) - main :: IO () main = do rConn <- R.connect R.defaultConnectInfo - scotty 3000 $ runReaderT app rConn --- main = do --- rConn <- R.connect R.defaultConnectInfo --- scotty 3000 (app rConn) - + scotty 3000 $ runReaderT app rConn diff --git a/22-reader/src/WithReaderT.hs b/22-reader/src/WithReaderT.hs new file mode 100644 index 0000000..32b197c --- /dev/null +++ b/22-reader/src/WithReaderT.hs @@ -0,0 +1,64 @@ +module WithReaderT where + +import Control.Monad.Trans.Reader +import Control.Monad.IO.Class +import Control.Monad.State.Class + +ctxi :: Reader Integer String +ctxi = do + i <- ask + return $ show i + +ctxb :: Reader Bool String +ctxb = do + b <- ask + return $ show b + +trans :: Bool -> Integer +trans True = 1 +trans False = 0 + +myWithReader :: (r' -> r) -> Reader r a -> Reader r' a +myWithReader f m = do + r' <- ask + reader $ \r -> runReader m (f r') + +trans' :: Integer -> Bool +trans' 0 = False +trans' _ = True + +foo :: (r -> r') -> Reader r a -> Reader r' a +foo f m = undefined -- impossible? Let's look at (r -> a) + +foo' :: (r -> r') -> (r -> a) -> (r' -> a) +foo' f g = undefined -- impossible... +-- You cannot construct a (r' -> a) from (r -> r') and (r -> a), both functions +-- take an r as input, but we need a function that takes an r' as input. +-- Only way to make this work is by flipping (r -> r'), but then we basically +-- have withReader: +foo'' :: (r' -> r) -> (r -> a) -> (r' -> a) +foo'' f g = g . f + +f :: Reader Integer String +f = do + r <- ask + -- we cannot change r, but we can do operations on them + return $ show (r * r) + +-- However, we can change the input for f when we call it: +g :: Reader Integer String +g = do + r <- ask + -- either via: + -- return $ runReader f (r + 1) + -- or: + withReader (+1) f + +main :: IO () +main = do + putStrLn $ runReader ctxi 100 + putStrLn $ runReader ctxb False + putStrLn $ runReader (myWithReader trans ctxi) True + putStrLn $ runReader (myWithReader trans ctxi) False + putStrLn $ runReader (myWithReader trans' ctxb) 1 + putStrLn $ runReader (myWithReader trans' ctxb) 0 \ No newline at end of file