DanielDv99

Task 4

Nov 29th, 2020 (edited)
627
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. import Control.Monad.Except
  2. import Control.Monad.IO.Class (liftIO)
  3. import Control.Monad (guard)
  4. import Data.Foldable (msum)
  5. import Data.Char (isNumber, isPunctuation)
  6.  
  7. ----
  8. -- newtype PwdError = PwdError String
  9. -- type PwdErrorIOMonad = ExceptT PwdError IO
  10.  
  11. -- askPassword :: PwdErrorIOMonad ()
  12. -- askPassword = do
  13. --     liftIO $ putStrLn "Enter your new password:"
  14. --     value <- msum $ repeat getValidPassword
  15. --     liftIO $ putStrLn "Storing in database ..."
  16.  
  17. -- instance Semigroup PwdError where
  18. --     (PwdError e) <> _ = PwdError e
  19. ----
  20.  
  21. instance Monoid PwdError where
  22.     mempty = PwdError ""
  23.     mappend (PwdError e) _ = PwdError e
  24.  
  25. getValidPassword :: PwdErrorIOMonad String
  26. getValidPassword = do
  27.     s <- liftIO getLine    
  28.  
  29.     let handleError (PwdError e) = liftIO $ putStrLn e >> return False
  30.  
  31.     validation <- validatePwd s `catchError` handleError
  32.     guard validation
  33.  
  34.     return s
  35.  
  36. validatePwd :: String -> PwdErrorIOMonad Bool
  37. validatePwd s =
  38.     do
  39.         let errorPrefix = "Incorrect input: "
  40.         lengthValid  <-
  41.             validator ((>= 8) . length) (errorPrefix ++ "password is too short!") s
  42.         digitPresent <-
  43.             validator (any isNumber) (errorPrefix ++ "password must contain some digits!") s
  44.         punctPresent <-
  45.             validator (any isPunctuation) (errorPrefix ++ "password must contain some punctuations!") s
  46.  
  47.         return $ lengthValid && digitPresent && punctPresent
  48.     where
  49.         validator :: (String -> Bool) -> String -> String -> PwdErrorIOMonad Bool
  50.         validator precond errMessage s =
  51.             if   precond s
  52.             then return True
  53.             else throwError $ PwdError errMessage
  54.        
  55.  
RAW Paste Data