initial commit

.gitignore

+# elm-package generated files
+elm-stuff/
+# elm-repl generated files
+repl-temp-*
+
+elm.js
+
+#mac
+# General
+.DS_Store
+.AppleDouble
+.LSOverride
+
+# Icon must end with two \r
+Icon
+
+# Thumbnails
+._*
+
+# Files that might appear in the root of a volume
+.DocumentRevisions-V100
+.fseventsd
+.Spotlight-V100
+.TemporaryItems
+.Trashes
+.VolumeIcon.icns
+.com.apple.timemachine.donotpresent
+
+# Directories potentially created on remote AFP share
+.AppleDB
+.AppleDesktop
+Network Trash Folder
+Temporary Items
+.apdisk
\ No newline at end of file

elm.json

+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/browser": "1.0.2",
+            "elm/core": "1.0.2",
+            "elm/html": "1.0.0",
+            "elm/url": "1.0.0"
+        },
+        "indirect": {
+            "elm/json": "1.1.3",
+            "elm/time": "1.0.0",
+            "elm/virtual-dom": "1.0.2"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}

src/Login.elm

+module Login exposing (..)
+
+import Browser exposing (..)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Route exposing (..)
+
+
+init : ( Model, Cmd Msg )
+init =
+    ( Model [] (Form "" ""), Cmd.none )
+
+
+
+-- MODEL
+
+
+{-| Model of the state of the view. It has form and some problems
+-}
+type alias Model =
+    { problems : List Problem
+    , form : Form
+    }
+
+
+{-| Text fields
+-}
+type alias Form =
+    { email : String
+    , password : String
+    }
+
+
+type Problem
+    = InvalidEntry String
+    | ServerError String
+
+
+
+-- UPDATE
+
+
+{-| Msg for all of the states of the view during **login**
+-}
+type Msg
+    = SubmittedForm
+    | EnteredEmail String
+    | EnteredPassword String
+    | CompletedLogin --  Result
+    | GotSession
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredPassword password ->
+            updateForm (\form -> { form | password = password }) model
+
+        _ ->
+            ( model, Cmd.none )
+
+
+{-| helper to only update model
+-}
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    ( { model | form = transform model.form }, Cmd.none )
+
+
+
+-- VIEW
+
+
+viewForm : Form -> Html Msg
+viewForm form =
+    Html.form [ onSubmit SubmittedForm ]
+        [ fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , placeholder "Email"
+                , onInput EnteredEmail
+                , value form.email
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "password"
+                , placeholder "Password"
+                , onInput EnteredPassword
+                , value form.password
+                ]
+                []
+            ]
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign in" ]
+        ]
+
+
+view : Model -> Html Msg
+view model =
+    div [ class "cred-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                    [ h1 [ class "text-xs-center" ] [ text "Sign in" ]
+                    , p [ class "text-xs-center" ]
+                        [ a [ Route.href Route.Register ]
+                            [ text "Need an account?" ]
+                        ]
+                    , ul [ class "error-messages" ]
+                        (List.map viewProblem model.problems)
+                    , viewForm model.form
+                    ]
+                ]
+            ]
+        ]
+
+
+viewProblem : Problem -> Html msg
+viewProblem problem =
+    let
+        errorMessage =
+            case problem of
+                InvalidEntry _ ->
+                    "f"
+
+                ServerError str ->
+                    str
+    in
+    li [] [ text errorMessage ]

src/Main.elm

+module Main exposing (..)
+
+import Browser exposing (..)
+import Browser.Navigation as Nav
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Login exposing (Model)
+import Route exposing (..)
+import Url exposing (Url)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { route : Route
+    , page : Page
+    , navKey : Nav.Key
+    }
+
+
+type Page
+    = NotFoundPage
+    | LoginPage Login.Model
+
+
+
+-- UPDATE
+
+
+type Msg
+    = LoginMsg Login.Msg
+    | LinkClicked UrlRequest
+    | UrlChanged Url
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case ( msg, model.page ) of
+        ( LoginMsg loginMsg, LoginPage m ) ->
+            let
+                ( updatedPageModel, updatedCmd ) =
+                    Login.update loginMsg m
+
+                m1 =
+                    ( { model | page = LoginPage updatedPageModel }
+                    , Cmd.map LoginMsg updatedCmd
+                    )
+            in
+            m1
+
+        ( LinkClicked urlReq, _ ) ->
+            case urlReq of
+                Browser.Internal url ->
+                    ( model
+                    , Nav.pushUrl model.navKey (Url.toString url)
+                    )
+
+                Browser.External url ->
+                    ( model
+                    , Nav.load url
+                    )
+
+        ( UrlChanged url, _ ) ->
+            let
+                newRoute =
+                    Route.parseUrl url
+            in
+            ( { model | route = newRoute }, Cmd.none )
+                |> initCurrentPage
+
+        ( _, _ ) ->
+            ( model, Cmd.none )
+
+
+
+-- без изменений
+-- VIEW
+
+
+type alias Document msg =
+    { title : String
+    , body : List (Html msg)
+    }
+
+
+view : Model -> Document Msg
+view model =
+    { title = "Post App"
+    , body = [ currView model ]
+    }
+
+
+currView : Model -> Html Msg
+currView model =
+    case model.page of
+        NotFoundPage ->
+            notFoundView
+
+        LoginPage pageModel ->
+            Login.view pageModel |> Html.map LoginMsg
+
+
+notFoundView : Html msg
+notFoundView =
+    h3 [] [ text "Oops! The page you requested was not found!" ]
+
+
+
+-- MAIN
+
+
+main : Program () Model Msg
+main =
+    Browser.application
+        { init = init
+        , view = view
+        , update = update
+        , subscriptions = \_ -> Sub.none
+        , onUrlRequest = LinkClicked
+        , onUrlChange = UrlChanged
+        }
+
+
+init : () -> Url -> Nav.Key -> ( Model, Cmd Msg )
+init flags url navKey =
+    let
+        model =
+            { route = Route.parseUrl url
+            , page = NotFoundPage
+            , navKey = navKey
+            }
+    in
+    initCurrentPage ( model, Cmd.none )
+
+
+initCurrentPage : ( Model, Cmd Msg ) -> ( Model, Cmd Msg )
+initCurrentPage ( model, existingCmds ) =
+    let
+        ( currPage, mappedCmds ) =
+            case model.route of
+                Route.NotFound ->
+                    ( NotFoundPage, Cmd.none )
+
+                Route.Login ->
+                    let
+                        ( pageModel, pageCmds ) =
+                            Login.init
+                    in
+                    ( LoginPage pageModel, Cmd.map LoginMsg pageCmds )
+    in
+    ( { model | page = currPage }
+    , Cmd.batch [ existingCmds, mappedCmds ]
+    )

src/Register.elm

+module Register exposing (..)
+
+import Browser exposing (..)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Route exposing (..)
+
+
+
+-- MODEL
+
+
+type alias Model =
+    { problems : List Problem
+    , form : Form
+    }
+
+
+type Problem
+    = InvalidEntry String
+    | ServerError String
+
+
+type alias Form =
+    { login : String
+    , email : String
+    , name : String
+    , password : String
+    }
+
+
+init : ( Model, Cmd Msg )
+init =
+    ( Model [] (Form "" "" "" ""), Cmd.none )
+
+
+
+-- UPDATE
+
+
+type Msg
+    = SubmittedForm
+    | EnteredEmail String
+    | EnteredPassword String
+    | EnteredLogin String
+    | EnteredName String
+    | CompletedLogin --  Result
+    | GotSession
+
+
+updateForm : (Form -> Form) -> Model -> ( Model, Cmd Msg )
+updateForm transform model =
+    ( { model | form = transform model.form }, Cmd.none )
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        EnteredEmail email ->
+            updateForm (\form -> { form | email = email }) model
+
+        EnteredPassword psw ->
+            updateForm (\form -> { form | password = psw }) model
+
+        EnteredLogin login ->
+            updateForm (\form -> { form | login = login }) model
+
+        EnteredName name ->
+            updateForm (\form -> { form | name = name }) model
+
+        _ ->
+            ( model, Cmd.none )
+
+
+
+-- VIEW
+
+
+viewForm : Form -> Html Msg
+viewForm form =
+    Html.form [ onSubmit SubmittedForm ]
+        [ fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "name"
+                , placeholder "Name"
+                , onInput EnteredName
+                , value form.name
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "login"
+                , placeholder "Login"
+                , onInput EnteredLogin
+                , value form.login
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , placeholder "Email"
+                , onInput EnteredEmail
+                , value form.email
+                ]
+                []
+            ]
+        , fieldset [ class "form-group" ]
+            [ input
+                [ class "form-control form-control-lg"
+                , type_ "password"
+                , placeholder "Password"
+                , onInput EnteredPassword
+                , value form.password
+                ]
+                []
+            ]
+        , button [ class "btn btn-lg btn-primary pull-xs-right" ]
+            [ text "Sign up" ]
+        ]
+
+
+view : Model -> Html Msg
+view model =
+    div [ class "cred-page" ]
+        [ div [ class "container page" ]
+            [ div [ class "row" ]
+                [ div [ class "col-md-6 offset-md-3 col-xs-12" ]
+                    [ h1 [ class "text-xs-center" ] [ text "Sign up" ]
+                    , p [ class "text-xs-center" ]
+                        [ a [ Route.href Route.Login ]
+                            [ text "Already have an account?" ]
+                        ]
+
+                    -- , ul [ class "error-messages" ]
+                    --     (List.map viewProblem model.problems)
+                    , viewForm model.form
+                    ]
+                ]
+            ]
+        ]

src/Route.elm

+module Route exposing (Route(..), href, parseUrl)
+
+import Html exposing (Attribute)
+import Html.Attributes as Attr
+import Url exposing (Url)
+import Url.Parser exposing (..)
+
+
+type Route
+    = NotFound
+    | Register
+    | Login
+
+
+parseUrl : Url -> Route
+parseUrl url =
+    case parse matchRoute url of
+        Just route ->
+            route
+
+        Nothing ->
+            NotFound
+
+
+matchRoute : Parser (Route -> a) a
+matchRoute =
+    oneOf
+        [ map Login top -- эта штука на localhost:9000/
+        , map Register (s "register")
+        , map Login (s "login")
+        ]
+
+
+href : Route -> Attribute msg
+href targetRoute =
+    Attr.href (routeToString targetRoute)
+
+
+routeToString : Route -> String
+routeToString page =
+    "#/" ++ String.join "/" (routeToPieces page)
+
+
+routeToPieces : Route -> List String
+routeToPieces page =
+    case page of
+        Login ->
+            [ "login" ]
+
+        Register ->
+            [ "register" ]
+
+        _ ->
+            []