Haskell monad transformer

EceptT_Haskell.hs

{- ExceptT Monad transformer:

-}

import Control.Monad.Trans
import Control.Monad.Identity 
import Text.Read (readMaybe)
import Control.Monad.Trans.Except

-- Turns a maybe value into a Either value
-- that holds an error message 
-- 
:{
maybeToEither :: err -> Maybe value -> Either err value 
maybeToEither e m =
  case m of
    Just v   -> Right v
    Nothing  -> Left  e
:}

:{
parseNumber :: String -> Either String Int
parseNumber text = out 
  where
    num = readMaybe text :: Maybe Int
    out = maybeToEither "Error: Invalid number" num   
:}

> parseNumber "200" 
Right 200
it :: Either String Int
> parseNumber "200asd" 
Left "Error: Invalid number"
it :: Either String Int
>


-- Transforms a function that returns Maybe 
-- into a function that returns Either 
-- 
:{
maybeToEitherFn :: (a -> Maybe b) -> e -> a -> Either e b
maybeToEitherFn fn err a =
  case fn a of
    Nothing  ->  Left err 
    Just x   ->  Right x  
:}  

:{
parseNum :: String -> Either String Int 
parseNum = maybeToEitherFn (\x -> readMaybe x :: Maybe Int) "Error: Invalid number" 
:}


> parseNum "200" 
Right 200
it :: Either String Int
> parseNum "2asdas00" 
Left "Error: Invalid number"
it :: Either String Int
> 
fmap (+10) (parseNum "200")
> Right 210
it :: Either String Int
> 
> 
fmap (+10) (parseNum "20SAD0")
> Left "Error: Invalid number"
it :: Either String Int
> 


:{
readNumber :: String -> IO (Either String Int)
readNumber prompt = do
   putStr prompt 
   line <- getLine
   return $ parseNum line 
:}

> readNumber "Enter a number: " 
Enter a number: 2303
Right 2303
it :: Either String Int
> readNumber "Enter a number: " 
Enter a number: sdf32423
Left "Error: Invalid number"
it :: Either String Int
> 

:{
readSum :: IO (Either String Int)
readSum = do
  num1 <- readNumber "Enter num1: "
  num2 <- readNumber "Enter num2: "
  let sum = do
        n1 <- num1
        n2 <- num2
        return $ n1 + n2 
  return sum 
:}  
  
> readSum
Enter num1: 100
Enter num2: 200
Right 300
it :: Either String Int

> readSum
Enter num1: as432334
Enter num2: 23
Left "Error: Invalid number"
it :: Either String Int

:{
addNumsPrompt :: IO ()
addNumsPrompt = do 
  num1 <- readNumber "Enter num1: "
  num2 <- readNumber "Enter num2: "

  -- maybe monad 
  let sum  = do
        x <- num1
        y <- num2
        return $ x + y

  case sum of
    Right r -> putStrLn $ "The sum is " ++ show(r)
    Left  e -> putStrLn $ e 
:}

> addNumsPrompt 
Enter num1: 100
Enter num2: 200
The sum is 300
it :: ()
> addNumsPrompt 
Enter num1: 23asd
Enter num2: 220
Error: Invalid number
it :: ()
> addNumsPrompt 
Enter num1: asd23
Enter num2: 232
Error: Invalid number
it :: ()
>


{- ======= Using Monad Transformers ======= -}

-- Type constructor 
-- 
> :t ExceptT 
ExceptT :: m (Either e a) -> ExceptT e m a
>

> let v1 = Identity (Right 100) 
> v1 :: Num b => Identity (Either a b)

> let v2 = Identity (Left "Error: Invalid number") 
v2 :: Identity (Either [Char] b)

  
> let e1 = ExceptT v1 
e1 :: Num a => ExceptT e Identity a
> e1 
ExceptT (Identity (Right 100))
it :: Num a => ExceptT e Identity a
>


let e2 = ExceptT v2 
> > e2 :: ExceptT [Char] Identity a
> e2 
ExceptT (Identity (Left "Error: Invalid number"))
it :: ExceptT [Char] Identity a
> 
  
> fmap (+100) e1 
> ExceptT (Identity (Right 200))
it :: Num b => ExceptT e Identity b
>

> fmap (+100) e2 
> ExceptT (Identity (Left "Error: Invalid number"))
it :: Num b => ExceptT [Char] Identity b
>

:t runExceptT 
> > runExceptT :: ExceptT e m a -> m (Either e a)
>

> runExceptT e1 
> Identity (Right 100)
it :: Num a => Identity (Either e a)
> 

runExceptT e2 
> Identity (Left "Error: Invalid number")
it :: Identity (Either [Char] a)
>

-- EitherT turns 'IO (Either String Int)' into 'ExceptT IO String Int'
--
:{
readNumber2 :: String -> ExceptT String IO Int
readNumber2 prompt = ExceptT $ do 
  putStr prompt
  line <- getLine
  return $ parseNum line 
:}  


> readNumber2 "num: "
> > 
<interactive>:1069:1: error:
    • No instance for (Data.Functor.Classes.Show1 IO)
        arising from a use of ‘print’
    • In a stmt of an interactive GHCi command: print it
> 


> runExceptT (readNumber2 "num: ")
 num: 200
Right 200
it :: Either String Int
> 

runExceptT (readNumber2 "num: ")
 num: sad2332
Left "Error: Invalid number"
it :: Either String Int
>

:{
readSum2 :: ExceptT String IO Int 
readSum2 = do 
  num1 <- readNumber2 "Enter num1: "
  num2 <- readNumber2 "Enter num2: "
  return $ num1 + num2 
:}

> runExceptT readSum2 
Enter num1: 100
Enter num2: 200
Right 300
it :: Either String Int
> 
> runExceptT readSum2 
Enter num1: 200asd
Left "Error: Invalid number"
it :: Either String Int
>

> runExceptT readSum2 
Enter num1: 100
Enter num2: 200
Right 300
it :: Either String Int
> 
> runExceptT readSum2 
Enter num1: 200asd
Left "Error: Invalid number"
it :: Either String Int
>

:{
forEither :: Either err val -> (val -> IO ()) -> (err -> IO ()) -> IO () 
forEither m fe fr =
  case m of
    Right r -> fe r
    Left  e -> fr e 
:}
  

> forEither (parseNum "10asd0") (\x -> putStrLn(show x)) (\y -> putStrLn y) 
Error: Invalid number
it :: ()
> 
> forEither (parseNum "100") (\x -> putStrLn(show x)) (\y -> putStrLn y) 
100
it :: ()
> 

:{
addNumsPrompt2 :: IO ()
addNumsPrompt2 = do 
  --- num1 and num2 have type int

  -- ExceptT String IO Int ==>  Either String Int
  -- 
  num1 <- runExceptT $ readNumber2 "Enter num1: "
  num2 <- runExceptT $ readNumber2 "Enter num2: "
 
  let sum  = do
                n1 <- num1
                n2 <- num2
                return $ n1 + n2 

  forEither sum (\s ->  putStrLn ("The sum is " ++ show(s))) putStrLn
:}


> 
> addNumsPrompt2
Enter num1: 100
Enter num2: 200
The sum is 300
it :: ()
> addNumsPrompt2
Enter num1: asdsa
Enter num2: 230
Error: Invalid number
it :: ()
> addNumsPrompt2
Enter num1: 332sad
Enter num2: ddsfas
Error: Invalid number
it :: ()
>

:{
forExceptT :: ExceptT e IO v -> (v -> IO ()) -> (e -> IO ()) -> IO () 
forExceptT m fr fe = do
  val <- runExceptT m
  
  case val of 
    Right r -> fr r
    Left  e -> fe e 
:}



:{
addNumsPrompt3 :: IO () 
addNumsPrompt3 = do 
  --- num1 and num2 have type int

  -- ExceptT String IO Int ==>  Either String Int
  --
  let sum = do 
        num1 <- readNumber2 "Enter num1: "
        num2 <- readNumber2 "Enter num2: "
        return $ num1 + num2
        
  forExceptT sum (\s ->  putStrLn ("The sum is " ++ show s)) putStrLn
:}


> addNumsPrompt3 
Enter num1: 200
Enter num2: 300
The sum is 500
it :: ()
> addNumsPrompt3 
Enter num1: asd
Error: Invalid number
it :: ()
> addNumsPrompt3 
Enter num1: 100
Enter num2: asd
Error: Invalid number
it :: ()
>


:{
addNumsPrompt4 :: IO () 
addNumsPrompt4 = do
  -- sum :: ExceptT String IO Int 
  let sum = do 
        num1 <- readNumber2 "Enter num1: "
        num2 <- readNumber2 "Enter num2: "
        return $ num1 + num2
        
  s <- runExceptT sum
  case s of
    Left   e -> putStrLn e
    Right  r -> putStrLn $ "The sum is " ++ show r
:}

> addNumsPrompt4
Enter num1: 100
Enter num2: 200
The sum is 300
it :: ()
> addNumsPrompt4
Enter num1: 100
Enter num2: asd
Error: Invalid number
it :: ()
> addNumsPrompt4
Enter num1: sadsad
Error: Invalid number
it :: ()
>

EitherMonad_DataValidation.hs

{-  Description: Show how to use Either Monad to perform user's data validation.

-}

import Control.Monad 
import Data.Char 

  
:{
makeValidator :: (val -> Bool) -> err -> val -> Either err val 
makeValidator pred err val =
  if pred val
  then Right val
  else Left err 
:}


:{
validateLength :: String -> Either String String 
validateLength = makeValidator (\p -> length p >= 6) "Error: Password must have at least 6 chars"
:}

:{
validateAtLeastDigit :: String -> Either String String
validateAtLeastDigit = makeValidator (any isDigit) "Error: the password must have at least a digit"
:}


:{
validateAtLeastLetter :: String -> Either String String
validateAtLeastLetter = makeValidator (any isLetter) "Error: the password must only have at least a letter."
:}

:{
validateCharType :: String -> Either String String
validateCharType = makeValidator (all $ \p -> isLetter p || isDigit p) "Error: the password characters must be a digit or char"
:}

:{
validator1 :: String -> Either String String
validator1 s = do 
  a <- validateLength s
  b <- validateAtLeastDigit a
  c <- validateAtLeastLetter b
  d <- validateCharType c
  return d 
:}


> 
> mapM_ print $ map validator1 ["", "assaddfd", "hefgsllo", "32", "10324234", "hxz60kwn5", "hz sadas&*423"] 
Left "Error: Password must have at least 6 chars"
Left "Error: the password must have at least a digit"
Left "Error: the password must have at least a digit"
Left "Error: Password must have at least 6 chars"
Left "Error: the password must only have at least a letter."
Right "hxz60kwn5"
Left "Error: the password characters must be a digit or char"
it :: ()
>

-- Using Kleisly arrows or Monadic function composition 
-- 
:{
validator2 :: String -> Either String String
validator2 = 
  validateLength >=> validateAtLeastDigit >=> validateAtLeastLetter >=> validateCharType 
:}

> mapM_ print $ map validator2 ["", "assaddfd", "hefgsllo", "32", "10324234", "hxz60kwn5", "hz sadas&*423"] 
Left "Error: Password must have at least 6 chars"
Left "Error: the password must have at least a digit"
Left "Error: the password must have at least a digit"
Left "Error: Password must have at least 6 chars"
Left "Error: the password must only have at least a letter."
Right "hxz60kwn5"
Left "Error: the password characters must be a digit or char"
it :: ()
> 


-- Using Kleisly arrows or Monadic function composition 
-- 
:{
validator3 :: String -> Either String String
validator3 = 
  validateLength
  >=> validateAtLeastDigit
  >=> validateAtLeastLetter
  >=> validateCharType 
:}

> mapM_ print $ map validator2 ["", "assaddfd", "hefgsllo", "32", "10324234", "hxz60kwn5", "hz sadas&*423"] 
Left "Error: Password must have at least 6 chars"
Left "Error: the password must have at least a digit"
Left "Error: the password must have at least a digit"
Left "Error: Password must have at least 6 chars"
Left "Error: the password must only have at least a letter."
Right "hxz60kwn5"
Left "Error: the password characters must be a digit or char"
it :: ()
> 

exceptionHandlingInHaskell.hs

{- 
See: 
   - https://hackage.haskell.org/package/base-4.8.0.0/docs/src/GHC-IO-Exception.html
   
   - 
   
   - 
   
   - 
-}

import Control.Exception (catch, SomeException(..))
import Control.Monad ((>=>)) -- Kleisly composition / Monadic function composition.
import System.IO.Error (ioeGetErrorType)
import Data.Typeable (typeOf)

  -- Contains - PermissionDenied, NoSuchThing and so on 
  -- See: 
import GHC.IO.Exception (IOErrorType(..))
 

> 
> :t typeOf 
typeOf
  :: Data.Typeable.Internal.Typeable a =>
     a -> Data.Typeable.Internal.TypeRep
> 

> :t catch 
catch :: GHC.Exception.Exception e => IO a -> (e -> IO a) -> IO a
> 

-- Print the type of Exception 
---
> catch (putStrLn =<< readFile "/etc/dfissue") (\(SomeException e) -> putStrLn $ "caught " ++ show (typeOf e))
caught IOException
it :: ()
> 

> catch (putStrLn =<< readFile "/etc/issue") (\(SomeException e) -> putStrLn $ "caught " ++ show (typeOf e))
Manjaro Linux \r  (\n) (\l)



it :: ()
> 



> catch ( readFile >=> putStrLn $ "/etc/issue") (\(SomeException e) -> putStrLn $ "caught " ++ show (typeOf e))
Manjaro Linux \r  (\n) (\l)



it :: ()

> catch ( readFile >=> putStrLn $ "/etc/isfjhjysue") (\(SomeException e) -> putStrLn $ "caught " ++ show (typeOf e))
caught IOException
it :: ()
> 

> catch ( readFile "/etc/issue" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left "Error: File doesn't exist"))
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either [Char] String
> 
> 
> catch ( readFile "/etc/issuesfdf" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left "Error: File doesn't exist"))
Left "Error: File doesn't exist"
it :: Either [Char] String
> 

> catch ( readFile "/etc/issuesfdf" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left (show e)))
Left "/etc/issuesfdf: openFile: does not exist (No such file or directory)"
it :: Either String String
> 
> catch ( readFile "/etc/issue" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left (show e)))
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either String String
> 


> catch ( readFile "/etc/issueasd" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left (show e ++ " / " ++ show (typeOf e))))
Left "/etc/issueasd: openFile: does not exist (No such file or directory) / IOException"
it :: Either [Char] String
> 
> catch ( readFile "/etc/shadow" >>= \r -> return (Right r)) (\(SomeException e) -> return (Left (show e ++ " / " ++ show (typeOf e))))
Left "/etc/shadow: openFile: permission denied (Permission denied) / IOException"
it :: Either [Char] String
> 

--  Print the type of IOException 
--
------------------------------


> 
> catch ( readFile "/etc/shadow" >>= putStrLn) (\e -> putStrLn $ show $ ioeGetErrorType e)
permission denied
it :: ()
> 
> catch ( readFile "/etc/issue" >>= putStrLn) (\e -> putStrLn $ show $ ioeGetErrorType e)
Manjaro Linux \r  (\n) (\l)



> :info IOError 
type IOError = GHC.IO.Exception.IOException
  	-- Defined in ‘GHC.IO.Exception’
> 


it :: ()
> 
> catch ( readFile "/etc/issuesad" >>= putStrLn) (\e -> putStrLn $ show $ ioeGetErrorType e)
does not exist
it :: ()
> 
> catch ( readFile "/etc/shadow" >>= putStrLn) (\e -> putStrLn $ show $ ioeGetErrorType e)
permission denied
it :: ()
> 


{- Handling Exceptions  -}

:{
testIOException fileName =
  catch ( readFile fileName >>= putStrLn)
        (\e -> do
                 putStrLn $ show $ ioeGetErrorType e

                 case ioeGetErrorType e of
                   PermissionDenied -> putStrLn "We dont' have permission to this file"
                   NoSuchThing      -> putStrLn "The file doesn't exist"
                   EOF              -> putStrLn "End of file exception"
                   _                -> putStrLn "Unknown Exception"

        )


:}


> testIOException "/etc/issue"
Manjaro Linux \r  (\n) (\l)



it :: ()
> testIOException "/etc/issuase"
does not exist
The file doesn't exist
it :: ()

> testIOException "/etc/shadow"
permission denied
We dont' have permission to this file
it :: ()
> 

> testIOException "/"
inappropriate type
Unknown Exception
it :: ()
> testIOException "/tmp"
inappropriate type
Unknown Exception
it :: ()
> 

{- ============================================ -}


:{
catchEither :: IO a -> IO (Either IOErrorType a)
catchEither ioAction =
  catch (ioAction >>= \v -> return $ Right v)
        (\e -> return $ Left $ ioeGetErrorType e)
:}

> :{
- catchEither :: IO a -> IO (Either IOErrorType a)
- catchEither ioAction =
-   catch (ioAction >>= \v -> return $ Right v)
-         (\e -> return $ Left $ ioeGetErrorType e)
- :}
catchEither :: IO a -> IO (Either IOErrorType a)
> 



> catchEither (readFile "/etc/issue")
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOErrorType String
> 
> catchEither (readFile "/etc/issuedsfs")
Left does not exist
it :: Either IOErrorType String
> 
> catchEither (readFile "/etc/shadow")
Left permission denied
it :: Either IOErrorType String
> 
> catchEither (readFile "/etc/")
Left inappropriate type
it :: Either IOErrorType String
> 
> 

{- ============================== -}


:{
tryIOExceptT :: IO a -> ExceptT IOErrorType IO a
tryIOExceptT ioAction =
  ExceptT $ catch (ioAction >>= \v -> return $ Right v)
                  (\e -> return $ Left $ ioeGetErrorType e)
:}



> let action = tryIOExceptT (readFile "/etc/issue")
- 
action :: ExceptT IOErrorType IO String
> 

> runExceptT action 
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOErrorType String
> 

> 
> runExceptT $ tryIOExceptT (readFile "/etc/shadow")
Left permission denied
it :: Either IOErrorType String
> 

{- ===================================== -} 

-- This function turns a monadic IO function (a -> IO b) into a 
-- "ExcepT IOErrorType IO a" function   
--


:{
makeIOExceptT :: (a -> IO b) -> (a -> ExceptT IOErrorType IO b)
makeIOExceptT ioFn a =
  ExceptT $ catch (ioFn a  >>= \v -> return $ Right v)
            (\e -> return $ Left $ ioeGetErrorType e)
:}  

> let safeReadFile = makeIOExceptT readFile 
safeReadFile :: FilePath -> ExceptT IOErrorType IO String
> 

> runExceptT $ safeReadFile "/etc/issue"
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOErrorType String
> runExceptT $ safeReadFile "/etc/issasdue"
Left does not exist
it :: Either IOErrorType String
> runExceptT $ safeReadFile "/etc/shadow"
Left permission denied
it :: Either IOErrorType String
> 

{- =========== --------- =========== -}



:{ 
makeExceptHandler :: IOErrorType -> IO () -> Either IOErrorType b -> IO ()
makeExceptHandler ioError handler value = do 
  case value of
    Left  ioError' -> if ioError == ioError'
                      then handler
                      else return ()
    _             -> return ()
:}


let permissionExceptHandler =
      makeExceptHandler PermissionDenied (putStrLn "Error: You don't have permission to this file")

> let permissionExceptHandler =
-       makeExceptHandler PermissionDenied (putStrLn "Error: You don't have permission to this file")
- 
permissionExceptHandler :: Either IOErrorType b -> IO ()
> 


let fileDontExistHandler =
      makeExceptHandler NoSuchThing (putStrLn "Error: File doesn't exist")

> let fileDontExistHandler =
-       makeExceptHandler NoSuchThing (putStrLn "Error: File doesn't exist")
- 
fileDontExistHandler :: Either IOErrorType b -> IO ()
> 




:{
cat :: String -> IO ()
cat fileName = do
  content <- runExceptT (safeReadFile fileName)

  -- Only prints if the content is Right <string>
  mapM_ putStrLn content
  permissionExceptHandler content
  fileDontExistHandler content 
:}

> cat "/etc/issueSDFS"
Error: File doesn't exist
it :: ()
> 
> cat "/etc/shadow"
Error: You don't have permission to this file
it :: ()
> 
> cat "/etc/issue"
Manjaro Linux \r  (\n) (\l)



it :: ()
> 

hanglingException.hs

import Control.Exception

-- ExceptT, runExceptT ... 
import Control.Monad.Trans.Except 

import Control.Monad (mapM_)

:{
tryIO :: IO a -> IO (Either IOException a)
tryIO ioAction = try ioAction 
:}


> readFile "/etc/issue"
"Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: String
> 
> readFile "/etc/issue" >>= putStrLn 
Manjaro Linux \r  (\n) (\l)



it :: ()
> 

> readFile "/etc/isssdfsd"
  *** Exception: /etc/isssdfsd: openFile: does not exist (No such file or directory)
>

> tryIO $ readFile "/etc/isssdfsd"
Left /etc/isssdfsd: openFile: does not exist (No such file or directory)
it :: Either IOException String
> 

> tryIO $ readFile "/etc/issue"
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOException String
> 

> :t tryIO $ readFile "/etc/issue"
tryIO $ readFile "/etc/issue" :: IO (Either IOException String)
> 

> :t ExceptT
ExceptT :: m (Either e a) -> ExceptT e m a
> 

--  Wraping a monad transformer
--
> :t ExceptT $ tryIO $ readFile "/etc/issue"
ExceptT $ tryIO $ readFile "/etc/issue"
  :: ExceptT IOException IO String
> 

--  
--  Wrap an IO action into an ExceptT monad transformer
:{
tryIOT :: IO a -> ExceptT IOException IO a
tryIOT ioAction = ExceptT $ try ioAction 
:}

> let monadicValue =  tryIOT $ readFile "/etc/issue" 
monadicValue :: ExceptT IOException IO String
> 

> runExceptT monadicValue 
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOException String
> 


> runExceptT monadicValue >>= mapM_ putStrLn 
Manjaro Linux \r  (\n) (\l)



it :: ()
> 

> runExceptT (tryIOT $ readFile "/etc/issue") >>= mapM_ putStrLn 
Manjaro Linux \r  (\n) (\l)



it :: ()
> 

> runExceptT (tryIOT $ readFile "/etc/issfdfsue") >>= mapM_ putStrLn 
it :: ()
> 

--
--  Higher order function to turn a Monadic IO function into a ExceptT IO function 
--
-------------------------------------------------
--------------------------------------------------

:{
io2exceptT :: (inp -> IO out) -> (inp -> ExceptT IOException IO out)  
io2exceptT ioFn = 
  \input -> ExceptT $ try (ioFn input)
:}

> :t readFile 
readFile :: FilePath -> IO String
> 

> :t io2exceptT readFile
io2exceptT readFile :: FilePath -> ExceptT IOException IO String
> 

> let tryReadFile = io2exceptT readFile
tryReadFile :: FilePath -> ExceptT IOException IO String
> 
> 

> runExceptT $ tryReadFile "/etc/issue" 
> > Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either IOException String
> 

> runExceptT $ tryReadFile "/etc/shadow" 
> > Left /etc/shadow: openFile: permission denied (Permission denied)
it :: Either IOException String
> 

> runExceptT $ tryReadFile "/etc/issuasde" 
>  Left /etc/issuasde: openFile: does not exist (No such file or directory)
it :: Either IOException String
> 

runExceptT $ tryReadFile "/etc/" 
> Left /etc/: openFile: inappropriate type (is a directory)
it :: Either IOException String
> 


:{
testExceptT2 = do 
     lift $ putStrLn "Running"
     fileName <- lift $ putStr "Enter file name: " >> getLine 
     content  <- lift $ readFile fileName
     return content 
:}

> :t runExceptT $ testExceptT2
runExceptT $ testExceptT2 :: IO (Either e String)
> 

> runExceptT $ testExceptT2
Running
Enter file name: /etc/issue
Right "Manjaro Linux \\r  (\\n) (\\l)\n\n\n"
it :: Either () String
> 
> runExceptT $ testExceptT2
Running
Enter file name: /etc/shadow
*** Exception: /etc/shadow: openFile: permission denied (Permission denied)
> 
> 

HaskellMonadTransformers.hs

-- Tested in Haskell 8.0.1 
--
--

import Control.Monad.Trans.Maybe
import Control.Monad.Trans

import Control.Monad.Identity 

import Text.Read (readMaybe)

--  Case without moand transformer 
----------------------------------------

-- For the REPL 
:{
readNumber :: String -> IO (Maybe Int)
readNumber prompt = do
   putStr prompt 
   line <- getLine
   let num  = readMaybe line :: Maybe Int
   return num 
:}

> readNumber "num1: "
num1: 1200
Just 1200
it :: Maybe Int
> readNumber "num1: "
num1: asdasd
Nothing
it :: Maybe Int
> 


:{
readSum :: IO (Maybe Int)
readSum = do
  num1 <- readNumber "Enter num1: "
  num2 <- readNumber "Enter num2: "

  let sum = do
        x <- num1
        y <- num2
        return $ x + y
        
  return sum 
:}  

> readSum
Enter num1: 200
Enter num2: 100
Just 300
it :: Maybe Int

> readSum
Enter num1: asd233
Enter num2: 23
Nothing
it :: Maybe Int
> 


:{
addNumsPrompt :: IO ()
addNumsPrompt = do 
  num1 <- readNumber "Enter num1: "
  num2 <- readNumber "Enter num2: "

  -- maybe monad 
  let sum  = do
        x <- num1
        y <- num2
        return $ x + y

  case sum of
    Just m  -> putStrLn $ "The sum is " ++ show(m)
    Nothing -> putStrLn "Error invalid input"
:}


> 
> addNumsPrompt 
Enter num1: 200
Enter num2: 500
The sum is 700
it :: ()
> addNumsPrompt 
Enter num1: asd
Enter num2: 324
Error invalid input
it :: ()
> 

-- Using monad transformers 
--
----------------------------------------------

-- Type constructor 
--
> :t MaybeT 
MaybeT :: m (Maybe a) -> MaybeT m a
> 

-- Runs the monad 
--
> :t runMaybeT  
runMaybeT :: MaybeT m a -> m (Maybe a)
> 

> MaybeT $ Identity(Just 10)
MaybeT (Identity (Just 10))
it :: Num a => MaybeT Identity a
> 
> MaybeT $ Identity Nothing 
MaybeT (Identity Nothing)
it :: MaybeT Identity a
> 

--- --- Testing MaybeT with Identity monad
-- 
--
> let m = MaybeT $ Identity Nothing 
m :: MaybeT Identity a
> let m = MaybeT $ Identity(Just 10)
m :: Num a => MaybeT Identity a
> 
> m
MaybeT (Identity (Just 10))
it :: Num a => MaybeT Identity a
> 
> fmap (\x -> x * 3) m 
MaybeT (Identity (Just 30))
it :: Num b => MaybeT Identity b
> 
> runMaybeT m
Identity (Just 10)
it :: Num a => Identity (Maybe a)
> 

-- readNumber1 can be refactored into 
--
:{
readNumber2 :: String -> MaybeT IO Int
readNumber2 prompt = MaybeT $ do
   putStr prompt 
   line <- getLine
   let num  = readMaybe line :: Maybe Int
   return num 
:}

> readNumber2 "Enter num1: "

<interactive>:89:1: error:
    • No instance for (Data.Functor.Classes.Show1 IO)
        arising from a use of ‘print’
    • In a stmt of an interactive GHCi command: print it
> 
> :t readNumber2 "Enter num1: "
readNumber2 "Enter num1: " :: MaybeT IO Int
> 
> runMaybeT $ readNumber2 "Enter num1: "
Enter num1: 34
Just 34
it :: Maybe Int
> runMaybeT $ readNumber2 "Enter num1: "
Enter num1: dsf234
Nothing
it :: Maybe Int
> 



:{
readSum2 :: MaybeT IO Int 
readSum2 = do 
  num1 <- readNumber2 "Enter num1: "
  num2 <- readNumber2 "Enter num2: "
  return $ num1 + num2 
:}

> readSum2 

<interactive>:104:1: error:
    • No instance for (Data.Functor.Classes.Show1 IO)
        arising from a use of ‘print’
    • In a stmt of an interactive GHCi command: print it
> 
> runMaybeT readSum2 
Enter num1: 100
Enter num2: 200
Just 300
it :: Maybe Int
> 

> runMaybeT readSum2 
Enter num1: 23
Enter num2: asdas
Nothing
it :: Maybe Int
> 


> let readSum3 = MaybeT readSum 
readSum3 :: MaybeT IO Int
> 

> runMaybeT readSum3
Enter num1: 199
Enter num2: 20
Just 219
it :: Maybe Int

> runMaybeT readSum3
Enter num1: 23as
Enter num2: sadad
Nothing
it :: Maybe Int
> 


:{
addNumsPrompt2Aux :: MaybeT IO ()
addNumsPrompt2Aux = do 
  --- num1 and num2 have type int 
  num1 <- readNumber2 "Enter num1: "
  num2 <- readNumber2 "Enter num2: "
  
  let sum  =  num1 + num2 :: Int 
  
  -- Lift turns the (puStrLn msg) :: IO () into "MaybeT IO ()" type 
  lift $ putStrLn ("The sum is " ++ show(sum))   
:}


> runMaybeT addNumsPrompt2Aux 
Enter num1: 200
Enter num2: 100
The sum is 300
Just ()
it :: Maybe ()
> runMaybeT addNumsPrompt2Aux 
Enter num1: asd
Nothing
it :: Maybe ()
> runMaybeT addNumsPrompt2Aux 
Enter num1: 200
Enter num2: asd
Nothing
it :: Maybe ()
> 


:{
runWihtErrorMsg :: String -> MaybeT IO () -> IO ()
runWihtErrorMsg message action = do 
  status <- runMaybeT action
  case status of 
    Nothing -> putStrLn message
    Just _  -> return () 
:}

> let addNumsPrompt = runWihtErrorMsg "Error: Invalid input" addNumsPrompt2Aux 
addNumsPrompt :: IO ()
> 

> addNumsPrompt
Enter num1: 100
Enter num2: 200
The sum is 300
it :: ()
> 
> addNumsPrompt
Enter num1: 200asd
Error: Invalid input
it :: ()
> addNumsPrompt
Enter num1: 100
Enter num2: asdas
Error: Invalid input
it :: ()
> 

readPasswords.hs

--  Using the Either and ExceptT monad to read password
--


import Control.Monad.Except (ExceptT, runExceptT)
--
-- or import Control.Monad.Trans.Except (ExceptT, runExceptT)

:{
simple :: ExceptT String IO Int
simple =
  return 100
:}
  
> runExceptT simple 
Right 100
it :: Either String Int
>

> let x = return 100 :: ExceptT String IO Int 
x :: ExceptT String IO Int
> x 

<interactive>:1711:1: error:
    • No instance for (Data.Functor.Classes.Show1 IO)
        arising from a use of ‘print’
    • In a stmt of an interactive GHCi command: print it
> runExceptT x 
Right 100
it :: Either String Int
>

:{  
readPassword1 :: String -> IO (Either String String)
readPassword1 password =  do
  putStr "Enter your code: "
  passwd <- getLine 
  if passwd == password
  then return $ Right "Ok - opening the safe."
  else return $ Left  "Password failed"
:}

 > readPassword1 "HelloWorld" 
Enter your code: dssdfsdf
Left "Password failed"
it :: Either String String
> readPassword1 "HelloWorld" 
Enter your code: HelloWorld
Right "Ok - opening the safe."
it :: Either String String
> :t it 
it :: Either String String
> :t readPassword1 "HelloWorld" 
readPassword1 "HelloWorld" :: IO (Either String String)
>

  

:{  
readPassword2 :: String -> ExceptT String IO String 
readPassword2 password = ExceptT $ do
  putStr "Enter your code: "
  passwd <- getLine 
  if passwd == password
  then return $ Right "Ok - opening the safe."
  else return $ Left  "Password failed"
:}


> readPassword2 "HelloWorld" 

<interactive>:1829:1: error:
    • No instance for (Data.Functor.Classes.Show1 IO)
        arising from a use of ‘print’
    • In a stmt of an interactive GHCi command: print it
> runExceptT $ readPassword2 "HelloWorld" 
Enter your code: adasd
Left "Password failed"
it :: Either String String
> runExceptT $ readPassword2 "HelloWorld" 
Enter your code: HelloWorld
Right "Ok - opening the safe."
it :: Either String String
>