0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@nekonibox(Kenta Inoue)

servant-elmに対応したElm側のテンプレートを作る

0
Last updated at Posted at 2026-04-21

はじめに

Haskellのservantを用いてWebアプリのサーバーを作成する際にservant-elmライブラリを用いると、Elmによるフロント側の各API呼び出し関数を自動生成できます。

しかしながら生成されるのは主にAPI呼び出し関数だけであり、API処理部分は自動生成されずに0から作らないといけないため、この部分をある程度テンプレート化できたら楽になると考えました。

そこで本記事ではservant-elmに対応したElm側のプログラムのテンプレートを作成し、servant-elmを使用した際にAPI処理部分をある程度、条件反射的に作る方法を解説していきます。

※本記事ではあくまで手書きプログラムであり、自動生成を行っているわけではないので注意です。

テストプログラム

本記事では簡単なメモアプリを作るプログラムを作って解説していきます。

ソースはこちら1

まずはHaskell側のプログラムを確認します。

Haskell側

メモの投稿Message型を以下のように定義してみます。

import Elm.Derive as ED

type Message = Message { messageTitle :: String, messageContent :: String } deriving Generic
deriveElmDef ED.defaultOptions ''Message

instance ToJSON Message
instance FromJSON Message

APIの内部実装は省略しますが、APIの型は以下のようにしてみます。

import Servant
import Servant.Elm
import Elm

type API = "AllMessage" :> Post '[JSON] [Message]
           :<|> "PostMessage" :> ReqBody '[JSON] Message :> Post '[JSON] ()

server :: Server API
server = getAllMessage :<|> postMessage

AllMessageが全てのメモを取得、PostMessageがメモを投稿するAPIです。

-- RunServer
startApp :: IO ()
startApp =
  runServerWithCors port (Proxy :: Proxy API) $ server

-- generate API in Elm
generate :: IO ()
generate =
  generateElm port deList (Proxy :: Proxy API) "Api"
  where
    deList = [DefineElm (Proxy :: Proxy Message)]

startAppがサーバを起動する関数、generate関数を実行することで次に紹介するような各APIに対応するElmのAPI呼び出し関数が自動生成されます。

Elm側

上のHaskellコードのgenerate関数で自動生成されるElmコードを見ていきます。

自動生成されるプログラム

まずはMessage型とそのJSON変換コードです。

type alias Message  =
   { messageTitle: String
   , messageContent: String
   }

{- エンコーダとデコーダは型のみ記載します -}
jsonDecMessage : Json.Decode.Decoder ( Message )

jsonEncMessage : Message -> Value

さらに各APIを呼び出す関数が生成され、その関数の型は以下の通りです。

postAllMessage : (Result Http.Error  ((List Message))  -> msg) -> Cmd msg

postPostMessage : Message -> (Result Http.Error  (())  -> msg) -> Cmd msg

ここで、APIの引数をreqbody、返り値をresponseとすると、APIを呼び出す関数の型は

reqbody -> (Result Http.Error response -> msg) -> Cmd msg

になっていることがわかります。

APIの使い方を確認

まずwebアプリを作るThe Elm ArchitectureでAPIをどのように使うのかを確認してみます。

webアプリにおけるThe Elm Architectureは次の4要素から構成されています。(flags,model,msgは型変数)

element :
    { init : flags -> ( model, Cmd msg )
    , view : model -> Html msg
    , update : msg -> model -> ( model, Cmd msg )
    , subscriptions : model -> Sub msg
    }
    -> Program flags model msg

ここで自動生成されるAPI呼び出し関数の返り値の型がCmd msgなのでinitかupdateで使用するのが自然だと考えられます。
initは最初のみに実行され、それ以外はupdateで実行されます。

updateには型変数msg型と型変数model型の2つ引数がありますが、model型は主にview関数で画面を構成するための引数なので、内部状態を保存するのは主にmsg型となります。

msg型を作る

APIを呼び出した後はサーバからのレスポンスを待つ必要があるので、型変数msgにはAPIを呼び出すタイミングの状態とレスポンスを受け取る状態の2つが必要になります。

また、呼び出しにはAPIに渡すための引数が必要であり、レスポンスには受け取った値を次の状態に渡したいので、後述するようにそれらを引数にとる2つの状態を定義します。
レスポンスに関しては実際にはネットワークエラーなども考慮した値を考える必要があります。
ですので、具体的には次のように定義します。

作り方

自動生成される各APIの型

postAPI : reqbody -> (Result Http.Error response -> msg) -> Cmd msg

に対し、Msg型に以下のようなコンストラクタを2つずつ追加します。

type Msg
    = PostAPIRequest request
    | PostAPIResponse (Result Http.Error response)
    ...

各APIに対してそれぞれRequestとResponseのコンストラクタを作ります。
Requestの方はreqbody型を引数にとり(APIの引数reqbodyが複数ある場合はそれら全てを引数に取るかuncurry化して1つの引数として考えます)、Responseの方はAPIの関数引数の引数の型Result Http.Error responseをそのまま引数の型にします。
このように定義するとPostAPIResponseの型がResult Http.Error response -> MsgになるのでpostAPIの引数に直接渡すことができるようになります。

メモアプリの場合

今回のメモアプリの場合を見ていきます。

API呼び出し関数を再掲するとpostAllMessageとpostPostMessageは以下のような型でした。

postAllMessage : (Result Http.Error  ((List Message))  -> msg) -> Cmd msg

postPostMessage : Message -> (Result Http.Error  (())  -> msg) -> Cmd msg

AllMessageの場合は引数なし、返り値List Message型であり、
PostMessageの場合は引数Message型、返り値()型なので、Msgの型に以下のようなコンストラクタを追加します。

type Msg
    = AllMessageRequest
    | AllMessageResponse (Result Http.Error (List Message))
    | PostMessageRequest Message
    | PostMessageResponse (Result Http.Error ())
    ...

ここにAPIを使わない時の状態を追加していく形になります。

model型を作る

update関数のmodel型の方は以下のように作ります。

作り方

まず、API呼び出し中と通信に失敗した場合の画面表示するための2つの状態を追加します。

type Model
    = Loading
    | Failure Http.Error
    ...

実際にLoadingがリクエストしてからレスポンスを受けるまでの間の画面遷移に使い、Failureが通信に失敗した場合のエラー画面遷移するために使います。

これに加えて自動生成される各APIの型

postAPI : reqbody -> (Result Http.Error response -> msg) -> Cmd msg

に対して、APIのレスポンスを受け取った旨を伝える画面を表示する場合、次のコンストラクタを追加します。2

type Model
    =
    ...
    | ViewPostAPI response {- 注釈[2] -}
    ...

この引数responseはAPI呼び出し関数の引数Result Http.Error response -> msgのresponse型と一致させます。

つまり、以下のようなコンストラクタを作ります。

type Model
    = Loading
    | Failure Http.Error
    | ViewPostAPI response
    ...

メモアプリの場合

メモアプリの場合は次の通りです。

API呼び出し関数を再掲するとpostAllMessageとpostPostMessageは以下のような型でした。

postAllMessage : (Result Http.Error  ((List Message))  -> msg) -> Cmd msg

postPostMessage : Message -> (Result Http.Error  (())  -> msg) -> Cmd msg

このAPI呼び出し関数の引数Reslut Http.Error response -> msgの型のresponse型はそれぞれList Messageと()型なので、必要なコンストラクタは以下のようになります。

type Model
    = Loading
    | Failure Http.Error
    | ViewAllMessage (List Message)
    | ViewPostMessage {- 注釈[3] -}
    ...

ViewAllMessageは取得してきたメモを全て表示するための画面遷移を表しています。

ViewPostMessageの方はメモ投稿完了画面を表示するために作っておきます。3

update関数

上で定義したMsg型とModel型を使ってAPIを呼び出す関数updateは次のようになります。

作り方

APIが以下の型をしていた場合

postAPI : reqbody -> (Result Http.Error response -> msg) -> Cmd msg

前述した通りMsgとModelは次のように定義しているはずです。

type Msg
    = PostAPIRequest request
    | PostAPIResponse (Result Http.Error response)
    ...

type Model
    = Loading
    | Failure Http.Error
    | ViewPostAPI response
    ...

このとき、update関数は次のように定義します。

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        PostAPIRequest request ->
            (Loading, postAPI request postAPIResponse)

        PostAPIResponse result ->
            case result of
                Ok response ->
                    (ViewPostAPI response, Cmd.none)
                    {- viewを定義しない場合は別のmodelに遷移させる -}

                Err err ->
                    (Failure err, Cmd.none)

        ...

MsgがRequestのとき、APIを呼び出して次のMsgをResponseの変化させます。
response実行後は通信が正常だった場合、対応するviewを表示させるか別のmodelに遷移させます。
これでAPI呼び出しが一通り実装されることになりました。

メモアプリでの具体例は以下の通りです。

メモアプリの場合

まずメモアプリのMsgとModelの型を確認します。

type Msg
    = AllMessageRequest
    | AllMessageResponse (Result Http.Error (List Message))
    | PostMessageRequest Message
    | PostMessageResponse (Result Http.Error ())
    ...

type Model
    = Loading
    | Failure Http.Error
    | ViewAllMessage (List Message)
    | ViewPostMessage {- 注釈[3] -}
    ...

この時のupdate関数は次の通りです。

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        AllMessageRequest ->
            (Loading, postAllMessage AllMessageResponse)

        AllMessageResponse result ->
            case result of
                Ok messageList ->
                    (ViewAllMessage messageList, Cmd.none)

                Err err ->
                    (Failure err, Cmd.none)

        PostMessageRequest message ->
            (Loading, postPostMessage postMessageRequest)

        PostMessageResponse result ->
            case result of
                Ok _ ->
                    (ViewPostMessage, Cmd.none)

                Err err ->
                    (Failure err, Cmd.none)

         ...

APIを操作する部分の実装はこれで全てです。

後はフロント側だけで完結する部分を実装すれば完成です。

最終的なプログラム

上のコードにメモ入力機能をつけたのが以下のコードです。

{- import文は省略 -}
main =
    Browser.element
        { init = init
        , update = update
        , subscriptions = subscriptions
        , view = view
        }

-- MSG / MODEL
type Msg
    = AllMessageRequest
    | AllMessageResponse (Result Http.Error (List Message))
    | PostMessageRequest Message
    | PostMessageResponse (Result Http.Error ())
    | WriteMessageMsg Message

type Model
    = Loading
    | Failure Http.Error
    | ViewAllMessage (List Message)
    | ViewPostMessage
    | WriteMessageModel Message

-- INIT
init : () -> (Model, Cmd Msg)
init _ = (Loading, postAllMessage AllMessageResponse)

-- UPDATE
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        AllMessageRequest ->
            (Loading, postAllMessage AllMessageResponse)

        AllMessageResponse result ->
            case result of
                Ok messageList ->
                    (ViewAllMessage messageList, Cmd.none)

                Err err ->
                    (Failure err, Cmd.none)

        PostMessageRequest message ->
            (Loading, postPostMessage message PostMessageResponse)

        PostMessageResponse result ->
            case result of
                Ok _ ->
                    (ViewPostMessage, Cmd.none)
                {- 投稿完了画面を作らずにすぐ全メモを表示する場合は次の通り -}
                {-  (Loading, postAllMessage AllMessageResponse) -}

                Err err ->
                    (Failure err, Cmd.none)

        WriteMessageMsg message ->
            (WriteMessageModel message, Cmd.none)

-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions _ =
    Sub.none

-- VIEW
view : Model -> Html Msg
view model =
    case model of
        Loading ->
            text "Loading ..."

        Failure err ->
            text ("Failure: " ++ showError err)

        ViewAllMessage messageList ->
            viewAllMessage messageList

        ViewPostMessage ->
            viewPostMessage

        WriteMessageModel message ->
            writeMessage message

viewMessage : Message -> Html msg
viewMessage message =
    div []
        [ text ( message.messageTitle ++ " / " ++ message.messageContent )
        ]

viewAllMessage : List Message -> Html Msg
viewAllMessage messageList =
    div []
        [ h3 [] [ text "All Messages"]
        , h5 [] [ text "Title / Content" ]
        , div [] (List.map viewMessage messageList)
        , button [onClick (WriteMessageMsg (Message "" ""))]
                      [text "Post New Message"]
        ]

viewPostMessage : Html Msg
viewPostMessage =
    div []
        [ h3 [] [ text "done" ]
        , button [onClick AllMessageRequest] [text "All Messages"]
        ]

writeMessage : Message -> Html Msg
writeMessage message =
    div []
        [ input [ placeholder "title"
                , value message.messageTitle
                , onInput (\s -> WriteMessageMsg {message | messageTitle = s})
                ] []
        , input [ placeholder "content"
                , value message.messageContent
                , onInput (\s -> WriteMessageMsg {message | messageContent = s})
                ] []
        , button [onClick (PostMessageRequest message)] [text "Post"]
        ]

showError : Http.Error -> String
showError err =
    case err of
        Http.BadUrl cmt -> "Bad Url: " ++ cmt

        Http.Timeout -> "Timeout"

        Http.NetworkError -> "Network Error"

        Http.BadStatus num -> "Bad Status: " ++ String.fromInt num

        Http.BadBody cmt -> "Bad Body: " ++ cmt

まとめ

servant-elmで自動生成されたAPI呼び出し関数に対応したElm側のプログラムを作成する方法について解説しました。
今は手書きで作成していますがある程度パターン化されているため、将来的には自動生成されるようなものを作っていきたいです。

  1. ただし、こちらのソースはHaskell側にpersistentを使用していたり、Elm側も一般のAPIに対応するため、ちょっと複雑なコードになっています。 ↩

  2. 画面遷移せずに他の状態に遷移したりする場合、必ずしもこのコンストラクタを作る必要はないですが、テンプレート化するための説明の便宜上作っておきます。 ↩

  3. メモ投稿完了画面を作らずにそのまま全メモを表示させたい場合、メモ投稿後すぐにpostAllMessageAPIを呼び出し、Modelは直接Loadingに遷移させることができるので、ViewPostMessageを作る必要はないです。 ↩

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?