LoginForm.elm

module LoginForm (Model, init, Action, update, view) where

import Html exposing (..)
import Html.Attributes exposing (value, placeholder)
import Html.Events exposing (on, targetValue, onClick)
import Http
import Json.Decode as Json
import Effects
import Task

type alias Model =
  { loginText : String
  , passwordText : String
  , message : String
  }

type Action
  = UpdateLogin String
  | UpdatePassword String
  | SubmitForm
  | LoginResponse (Maybe String)

init : Model
init =
  { loginText = ""
  , passwordText = ""
  , message = ""
  }

update : Action -> Model -> (Model, Effects.Effects Action)
update action model = case action of
  UpdateLogin s ->
    ( { model | loginText = s }
    ,  Effects.none)
  UpdatePassword s ->
    ( { model | passwordText = s }
    , Effects.none)
  SubmitForm ->
    ( model
    , runLogin model.loginText model.passwordText)
  LoginResponse response ->
    case response of
      Just x ->
        ( { init | message = "Just" }
        , Effects.none)
      Nothing ->
        ( { init | message = "Nothing" }
        , Effects.none)

view : Signal.Address Action -> Model -> Html
view address model =
  div [] [
      input [
        value model.loginText
      , placeholder "Login"
      , on "input" targetValue (Signal.message address << UpdateLogin)
      ] []
    , input [
        value model.passwordText
      , placeholder "Password"
      , on "input" targetValue (Signal.message address << UpdatePassword)
      ] []
    , button [
        onClick address SubmitForm
      ] [text "Login"]
    , text model.message
    ]

runLogin : String -> String -> Effects.Effects Action
runLogin user pass =
    Http.get stupidDecoder ("http://localhost/foo")
    |> Task.toMaybe
    |> Task.map (\a -> LoginResponse a)
    |> Effects.task

stupidDecoder : Json.Decoder String
stupidDecoder = Json.at [] Json.string

Main.elm

import LoginForm
import StartApp
import Effects exposing (Never, map)
import Task

import Html exposing (..)
import Html.Attributes exposing (value, placeholder, id)
import Html.Events exposing (on, targetValue, onClick)

app =
  StartApp.start
    { init = init
    , update = update
    , view = view
    , inputs = []
    }

main =
  app.html

port tasks : Signal (Task.Task Never ())
port tasks =
    app.tasks

init =
  ({ loginForm = LoginForm.init
   },
   Effects.none)

type alias Model = {
    loginForm : LoginForm.Model
  }

update : Action -> Model -> (Model, Effects.Effects Action)
update action model = case action of
  LoginFormAction a ->
    let rawResult = LoginForm.update a model.loginForm
        newModel = { model | loginForm = fst rawResult }
        newEffects = Effects.map LoginFormAction (snd rawResult)
    in (newModel, newEffects)

view : Signal.Address Action -> Model -> Html
view address model =
  div [id "login"] [
    h2 [] [text "Login"]
  , LoginForm.view (Signal.forwardTo address LoginFormAction) model.loginForm
  ]

type Action =
  LoginFormAction LoginForm.Action