Skip to content

Instantly share code, notes, and snippets.

@jcaxmacher
Created July 29, 2016 21:23
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jcaxmacher/796e21c0853ea7c85b3aa5d1307c0a4c to your computer and use it in GitHub Desktop.
Save jcaxmacher/796e21c0853ea7c85b3aa5d1307c0a4c to your computer and use it in GitHub Desktop.
Debouncing Password Validation in Elm
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