ElmでHttpリクエスト。Jsonを投げる例。

http_request_by_elm.elm

import Http (..)
import Graphics.Input (Input, input, button)
import Graphics.Input.Field (Content, noContent, field, defaultStyle)
import Json
import Dict
import Text (centered, toText)

{--

    ElmでのHttpリクエスト(Jsonを投げる)の例
    
    名前とメッセージを入力する欄を作成し、それをボタンを押すごとに特定のURLへ送信する
    
    @author mk2

 --}

-- ベースURL
-- そのまま投げるとjavascriptのクロスドメインに引っかかるので、nodejsのcorsproxy(https://github.com/gr2m/CORS-Proxy)
-- を起動してプロキシ経由で投げます
proxyUrl = "http://localhost:9292"
baseUrl = proxyUrl ++ "/localhost/index.php"

jsonHeader = [ ("Content-Type", "application/json") ]

-- Requestを作成する
-- urlはパスで、bodyはリクエストボディ
makeRequest : String -> String -> (Request String)
makeRequest url body = request "post" (baseUrl ++ url) body jsonHeader

-- リクエストを送信するボタンの入力部
-- (makeRequest "" "...")は初期値を作成しています
sendButtonClick : Input (Request String)
sendButtonClick = input (makeRequest "" "{'name':'', 'message':''}")

{--------------
ユーザー入力周り
 --------------}

-- ユーザー名入力フィールド
name : Input Content
name = input noContent

nameField : Content -> Element
nameField = field defaultStyle name.handle id "Name"

-- メッセージ入力フィールド
message : Input Content
message = input noContent

messageField : Content -> Element
messageField = field defaultStyle message.handle id "Message"

-- メッセージ送信ボタン
sendButton : (Content, Content) -> Element
sendButton sendContent =
    let userName = .string . fst <| sendContent
        userMessage = .string . snd <| sendContent
        body = Json.Object (Dict.fromList [ ("name", Json.String userName), ("message", Json.String userMessage) ])
    in button sendButtonClick.handle (makeRequest "" (Json.toString "" body)) "Post"

-- レスポンスを表示する関数
dispResponse : (Response String) -> Element
dispResponse response =
    let toElem = centered . toText
    in case response of
            Success str -> toElem str
            Waiting -> toElem  "Wait..."
            Failure ecode emsg -> toElem "Error"

-- レスポンスを示すシグナル
responseSignal : Signal (Response String)
responseSignal = send sendButtonClick.signal

-- 入力フォームを表示するための関数
messageForm : Content -> Content -> Element
messageForm nameContent messageContent =
    flow right [
                 nameField nameContent
               , messageField messageContent
               , sendButton (nameContent, messageContent)
               ]

-- 全体（入力フォーム、送信ボタン）を表示するための関数
display : Content -> Content -> (Request String) -> Element
display nameContent messageContent response =
    flow down [
                messageForm nameContent messageContent
              , dispResponse response
              ]

main = display <~ name.signal ~ message.signal ~ responseSignal