Use more ReaderT

22-reader/shawty-prime/app/Main.hs

@@ -12,7 +12,7 @@ import Network.URI (URI, parseURI)
 import qualified System.Random as SR
 import Web.Scotty
 
-import Control.Monad.Reader (ReaderT(..), runReaderT, ask, lift)
+import Control.Monad.Reader (ReaderT(..), runReaderT, ask, lift, mapReaderT)
 
 alphaNum :: String
 alphaNum = ['A'..'Z'] ++ ['0'..'9']
@@ -79,12 +79,26 @@ shortyFound :: TL.Text -> TL.Text
 shortyFound tbs =
   TL.concat ["<a href=\"", tbs, "\">", tbs, "</a>"]
 
+mySave :: String -> IO (Either R.Reply R.Status) -> ActionM ()
+mySave shawty respIO = do
+  resp <- lift respIO
+  html (shortyCreated resp shawty)
+
+myGet :: IO (Either R.Reply (Maybe BC.ByteString)) -> ActionM ()
+myGet respIO = do
+  uri <- lift respIO
+  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)
+
 app :: ReaderT R.Connection ScottyM ()
 app = do
-  rConn <- ask
+    mapReaderT (get "/") $ do
-  lift $ do 
+      uri <- lift $ param "uri"
-    get "/" $ do
-      uri <- param "uri"
       let parsedUri :: Maybe URI
           parsedUri = parseURI (TL.unpack uri)
       case parsedUri of
@@ -92,19 +106,38 @@ app =  do
           shawty <- liftIO shortyGen
           let shorty = BC.pack shawty
               uri' = encodeUtf8 (TL.toStrict uri)
-          resp <- liftIO (saveURI rConn shorty uri')
+          mapReaderT (mySave shawty) $ saveURI' shorty uri'
-          html (shortyCreated resp shawty)
+        Nothing -> lift $ text (shortyAintUri uri)
-        Nothing -> text (shortyAintUri uri)
+    mapReaderT (get "/:short") $ do
-    get "/:short" $ do
+      short <- lift $ param "short"
-      short <- param "short"
+      mapReaderT myGet $ getURI' short
-      uri <- liftIO (getURI rConn short)
+
-      case uri of
+-- app :: ReaderT R.Connection ScottyM ()
-        Left reply -> text (TL.pack (show reply))
+-- app =  do
-        Right mbBS -> case mbBS of
+--   rConn <- ask
-          Nothing -> text "uri not found"
+--   lift $ do
-          Just bs -> html (shortyFound tbs)
+--     get "/" $ do
-            where tbs :: TL.Text
+--       uri <- param "uri"
-                  tbs = TL.fromStrict (decodeUtf8 bs)
+--       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