Task 4

import Control.Monad.Except
import Control.Monad.IO.Class (liftIO)
import Control.Monad (guard)
import Data.Foldable (msum)
import Data.Char (isNumber, isPunctuation)

----
-- newtype PwdError = PwdError String
-- type PwdErrorIOMonad = ExceptT PwdError IO

-- askPassword :: PwdErrorIOMonad ()
-- askPassword = do
--     liftIO $ putStrLn "Enter your new password:"
--     value <- msum $ repeat getValidPassword
--     liftIO $ putStrLn "Storing in database ..."

-- instance Semigroup PwdError where
--     (PwdError e) <> _ = PwdError e
----

instance Monoid PwdError where
    mempty = PwdError ""
    mappend (PwdError e) _ = PwdError e

getValidPassword :: PwdErrorIOMonad String
getValidPassword = do
    s <- liftIO getLine

    let handleError (PwdError e) = liftIO $ putStrLn e >> return False

    validation <- validatePwd s `catchError` handleError
    guard validation

    return s

validatePwd :: String -> PwdErrorIOMonad Bool
validatePwd s =
    do
        let errorPrefix = "Incorrect input: "
        lengthValid  <-
            validator ((>= 8) . length) (errorPrefix ++ "password is too short!") s
        digitPresent <-
            validator (any isNumber) (errorPrefix ++ "password must contain some digits!") s
        punctPresent <-
            validator (any isPunctuation) (errorPrefix ++ "password must contain some punctuations!") s

        return $ lengthValid && digitPresent && punctPresent
    where
        validator :: (String -> Bool) -> String -> String -> PwdErrorIOMonad Bool
        validator precond errMessage s =
            if   precond s
            then return True
            else throwError $ PwdError errMessage