Created
July 29, 2016 21:23
-
-
Save jcaxmacher/796e21c0853ea7c85b3aa5d1307c0a4c to your computer and use it in GitHub Desktop.
Debouncing Password Validation in Elm
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Html exposing (Html, Attribute, div, text, input, button) | |
import Html.App as Html | |
import Html.Attributes exposing (..) | |
import Html.Events exposing (onInput, onClick) | |
import String | |
import Regex exposing (regex, contains) | |
import Process | |
import Task | |
import Time | |
import Debug | |
import Dict | |
main = | |
Html.program { init = (model, Cmd.none), view = view, update = update, subscriptions = subscriptions } | |
subscriptions : Model -> Sub Msg | |
subscriptions model = | |
Sub.none | |
type Msg | |
= Name String | |
| Password String | |
| PasswordAgain String | |
| Debounce Time.Time Msg | |
| DebounceAssign Time.Time Msg Time.Time | |
| DebounceFinish Time.Time Msg Time.Time | |
type alias Elapsed b = | |
{ since : Time.Time | |
, data : b | |
} | |
type alias Model = | |
{ name : String | |
, password : String | |
, passwordAgain : String | |
, showMessages : Bool | |
, debounceModel : Dict.Dict String (Elapsed Msg) | |
} | |
model : Model | |
model = | |
Model "" "" "" False Dict.empty | |
update : Msg -> Model -> (Model, Cmd Msg) | |
update msg model = | |
case msg of | |
Name name -> | |
({ model | name = name }, Cmd.none) | |
Password password -> | |
({ model | password = password, showMessages = True }, Cmd.none) | |
PasswordAgain password -> | |
({ model | passwordAgain = password, showMessages = True }, Cmd.none) | |
Debounce delay msg -> | |
let | |
( msgSplit, assignTask ) = | |
( String.split " " (toString msg) | |
, Task.perform | |
Debug.crash (\t -> DebounceAssign delay msg t) Time.now | |
) | |
in | |
( model | |
, case msgSplit of | |
msgName::_ -> | |
case (Dict.get msgName model.debounceModel) of | |
Just elapsed -> assignTask | |
Nothing -> Cmd.batch | |
[ assignTask | |
, Task.perform | |
Debug.crash | |
(\t -> DebounceFinish delay msg t) | |
(Process.sleep delay `Task.andThen` \_ -> Time.now) | |
] | |
[] -> Cmd.none | |
) | |
DebounceAssign delay msg current -> | |
case (String.split " " (toString msg)) of | |
msgName::_ -> | |
({ model | debounceModel | |
= Dict.insert msgName (Elapsed current msg) model.debounceModel | |
} | |
, Cmd.none) | |
[] -> | |
(model, Cmd.none) | |
DebounceFinish delay msg current -> | |
case (String.split " " (toString msg)) of | |
msgName::_ -> | |
case (Dict.get msgName model.debounceModel) of | |
Just elapsed -> | |
if elapsed.since + delay > current then | |
(model, Task.perform Debug.crash (\t -> DebounceFinish delay msg t) | |
(Process.sleep (elapsed.since + delay - current) | |
`Task.andThen` \_ -> Time.now)) | |
else | |
({ model | debounceModel = Dict.remove msgName model.debounceModel} | |
, Task.perform Debug.crash (\_ -> elapsed.data) Time.now | |
) | |
Nothing -> (model, Cmd.none) | |
[] -> (model, Cmd.none) | |
debounceTime : Time.Time | |
debounceTime = 1000 * Time.millisecond | |
view : Model -> Html Msg | |
view model = | |
div [] | |
[ input [ placeholder "Same", onInput Name ] [] | |
, input [ type' "password", placeholder "Password", onInput (Password >> Debounce debounceTime) ] [] | |
, input [ type' "password", placeholder "Re-enter Password", onInput PasswordAgain ] [] | |
, viewValidation model | |
] | |
viewValidation : Model -> Html msg | |
viewValidation model = | |
let | |
(color, messages) = | |
if model.showMessages && List.length (validator model) > 0 then | |
("red", (validator model)) | |
else if model.showMessages then | |
("green", ["OK"]) | |
else | |
("green", []) | |
in | |
div [ style [("color", color)] ] | |
(List.map (\m -> div [] [text m]) messages) | |
type alias Validation = | |
{ predicate : Model -> Bool | |
, message : String | |
} | |
validationBuilder : Validation -> Model -> Maybe String | |
validationBuilder val model = | |
if val.predicate model then Nothing else Just val.message | |
validations : List (Model -> Maybe String) | |
validations = | |
List.map validationBuilder | |
[ { predicate = (\m -> (String.length m.password) >= 8) | |
, message = "Password must be > 8 characters" | |
} | |
, { predicate = (\m -> contains (regex "[0-9]+") m.password) | |
, message = "Password must contain at least 1 number" | |
} | |
, { predicate = (\m -> contains (regex "[a-z]+") m.password) | |
, message = "Password must contain at least 1 lowercase character" | |
} | |
, { predicate = (\m -> contains (regex "[A-Z]+") m.password) | |
, message = "Password must contain at least 1 uppercase character" | |
} | |
, { predicate = (\m -> m.password == m.passwordAgain) | |
, message = "Passwords must match" | |
} | |
] | |
validator : Model -> List String | |
validator model = | |
List.filterMap (\fn -> fn model) validations |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment