A login form state machine that separates common context from state-specific context

Home   »   A login form state machine that separates common context from state-specific context

data LoginStatus = Pristine
    | Editing
    | Submitting
    | Error String
    | LoggedIn String 
    deriving Show

data LoginData = LoginData { _username :: String, _password :: String } deriving Show

type LoginState = (LoginStatus, LoginData)

data LoginEvent = WriteUsername String | WritePassword String | Submit | SuccessResponse String | ErrorResponse String | LogOut deriving Show

pristine :: LoginState -> LoginEvent -> LoginState
pristine (_, loginData) event = case event of
    WriteUsername name -> (Editing, loginData{_username = name})
    WritePassword pass -> (Editing, loginData{_password = pass})
    _ -> (Pristine, loginData)

editing (_, loginData) event = case event of
    WriteUsername name -> (Editing, loginData{_username = name})
    WritePassword pass -> (Editing, loginData{_password = pass})
    Submit -> (Submitting, loginData)
    _ -> (Editing, loginData)

submitting (_, loginData) event = case event of
    SuccessResponse token -> (LoggedIn token, loginData)
    ErrorResponse reason -> (Error reason, loginData)
    _ -> (Submitting, loginData)

errorReducer :: LoginState -> LoginEvent -> LoginState
errorReducer (state, loginData) event = case event of
    WriteUsername name -> (state, loginData{_username = name})
    WritePassword pass -> (state, loginData{_password = pass})
    Submit -> (Submitting, loginData)
    _ -> (state, loginData)

loggedIn login LogOut = (Pristine, LoginData {_username = "", _password = ""})
loggedIn login _ = login

loginMachine :: LoginState -> LoginEvent -> LoginState
loginMachine login = let
    status = fst login
    reducer = case status of
        Pristine -> pristine
        Editing -> editing
        Submitting -> submitting
        Error _ -> errorReducer
        LoggedIn _ -> loggedIn
        _ -> const
    in reducer login

Leave a Reply

Your email address will not be published. Required fields are marked *