Monad transformer stack examples

MonadTransformerExamples1.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Main where

import System.IO (getLine)
import ClassyPrelude
import Control.Monad.Reader
import Control.Monad.Trans.Maybe

main :: IO ()
main = do
  print $ runReader (egReader "reader") (Config "aa" 1)

  r <- runReaderT (egReaderT "readerT") (Config "bb" 1)
  print r

  x <- runReaderT (runMaybeT maybeAndReader) (Config "bb" 1)
  print x

  creds <- runMaybeT $ do
        u <- readUserName
        e <- readEmail
        p <- readPassword
        x <- MaybeT notInT
        print x
        pure (u, e, p)
  print creds

-------------------------------------------------------
notInT :: IO (Maybe String)
notInT = pure $ Just "123"

maybeAndReader :: MaybeT (ReaderT Config IO) String
maybeAndReader = MaybeT $ do
  cfg <- ask
  liftIO $ print (cfgName cfg)
  str <- liftIO getLine
  guard $ length str > 5
  pure $ Just str
  
readUserName3 :: MaybeT IO String
readUserName3 = do
  str <- lift getLine
  if length str < 5
  then pure str
  else pure mzero --empty

readUserName2 :: MaybeT IO String
readUserName2 = do
  str <- lift getLine
  guard $ length str > 5
  pure str

readUserName :: MaybeT IO String
readUserName = MaybeT $ do
  str <- getLine
  if length str > 5
    then pure $ Just str
    else pure Nothing

readEmail :: MaybeT IO String
readEmail = MaybeT $ do
  pure $ Just "email"

readPassword :: MaybeT IO String
readPassword = MaybeT $ do
  pure $ Just "pwd"

login :: String -> String -> String -> IO ()
login u e p = do
  putStrLn "ok"

-------------------------------------------------------
data Config = Config { cfgName :: String
                     , cfgValue :: Int
                     } deriving (Show)

egReader :: String -> Reader Config Int
egReader s =
  --Notice not passing the config on
  egReaderCalled (s <> "!")

egReaderCalled :: String -> Reader Config Int
egReaderCalled s = do
  v <- ask
  pure $ cfgValue v

egReaderT :: String -> ReaderT Config IO Int
egReaderT s =
  egReaderTCalled (s <> "!")

egReaderTCalled :: String -> ReaderT Config IO Int
egReaderTCalled s = do
  print s
  v <- ask
  pure $ cfgValue v
-------------------------------------------------------