Parse email address string using `elm/parser`

Main.elm

module Main exposing (main)

import Browser
import Html exposing (Html, button, div, input, label, text)
import Html.Attributes exposing (required, type_, value)
import Html.Events exposing (onBlur, onInput)
import Parser exposing (..)



{-

   This attempts to validate email address string using new [elm/parser](https://package.elm-lang.org/packages/elm/parser/latest/) package.
   The valid email address is somethin like `local@domain.domain.domain` with the following restrictions,

   - local and mulplie domains part is separated by `@` and it appears only once.
   - local part only contains alphabets, numbers, dots, dashes and underscores. Successive dots are not allowed. The total length must be less than or equal to 64 characters.
   - domain part only contains alphabets, numbers, dashes and underscores.
   - Each domain is separated by a dot, there must be at least one sub-domain under the top level domain (tld).
       - an email address like `user@localhost` is not allowed.
   - The total length of an email address must be less than or equal to 254 characters.

   link to ellie app https://ellie-app.com/3dTBmxmDCmza1
-}

{-
    parse local part
-}    
localParser : Parser String
localParser =
    succeed identity
        |. chompIf Char.isAlpha
        |. chompWhile (\c -> Char.isAlphaNum c || c == '.' || c == '-' || c == '_')
        |> getChompedString
        |> andThen
            (\s ->
                if String.length s <= 64 then
                    succeed s

                else
                    problem "local part must be less than or equal to 64"
            )

{-
    parse domain part string
-}    
hostParser : Parser String
hostParser =
    succeed identity
        |. chompWhile (\c -> Char.isAlphaNum c || c == '-' || c == '_')
        |> getChompedString
        |> andThen
            (\s ->
                if String.length s > 0 then
                    succeed s

                else
                    problem "empty host name is not allowd"
            )
{-
    parse list of domain
-}    

domainsParser : Parser (List String)
domainsParser =
    loop [] domainHelper
        |> andThen
            (\listOfString ->
                case List.reverse listOfString of
                    [] ->
                        problem "domain must conatin at least one subdomain"

                    hd :: _ ->
                        if tldCheck hd then
                            succeed listOfString

                        else
                            problem "tld must be in alphabet"
            )

{-
   parse `.domain-string`
-}   
domainHelper : List String -> Parser (Step (List String) (List String))
domainHelper revStrings =
    oneOf
        [ succeed (\string -> Loop (string :: revStrings))
            |. symbol "."
            |= hostParser
        , succeed ()
            |> map (\_ -> Done (List.reverse revStrings))
        ]

{- 
    check the tld contains only alphabets
 -}
tldCheck : String -> Bool
tldCheck s =
    s
        |> String.toList
        |> List.filter (not << Char.isAlpha)
        |> List.length
        |> (==) 0

{-
    copmose all subparsers as emailParser
-}    
emailParser : Parser String
emailParser =
    succeed (\local host hosts -> ( local, host, hosts ))
        |= localParser
        |. symbol "@"
        |= hostParser
        |= domainsParser
        |. end
        |> andThen
            (\( local, host, hosts ) ->
                if List.length hosts > 0 then
                    let
                        domain =
                            host ++ "." ++ String.join "." hosts

                        email =
                            local ++ "@" ++ domain
                    in
                    if String.length domain <= 253 && String.length email <= 254 then
                        succeed email

                    else
                        problem "the total length must be less than 254 characters"

                else
                    problem "domain name must be followed by a top level domain"
            )


type alias Model =
    { inputString : String
    , errorText : String
    }


initialModel : Model
initialModel =
    { inputString = "", errorText = "" }


type Msg
    = HandleInput String
    | HandleBlur


update : Msg -> Model -> Model
update msg model =
    case msg of
        HandleInput str ->
            { model | inputString = str, errorText = "" }

        HandleBlur ->
            case Parser.run emailParser model.inputString of
                Ok str ->
                    { model | errorText = "VALID" }

                Err e ->
                    { model | errorText = Debug.toString e }


view : Model -> Html Msg
view model =
    div []
        [ div []
            [ label []
                [ text "Input email address : "
                , input [ type_ "text", onInput HandleInput, onBlur HandleBlur, value model.inputString ] []
                ]
            ]
        , div [] [ text model.errorText ]
        , button [] [ text "DUMMY" ]
        ]


main : Program () Model Msg
main =
    Browser.sandbox
        { init = initialModel
        , view = view
        , update = update
        }