Java (JVM)環境でのClojureとJavaScript環境でのClojureScriptを組み合わせると、典型的なWebアプリケーションのサーバサイドもフロントエンドもほぼ同等の言語で開発できるというのはClojureの魅力のひとつですが、日本語でも英語でも入門者向けにそのようなフルスタックなClojure開発のしかたを解説するリソースはまだ多くないようです。

今回は国内Clojurianの間でも人気のサーバサイドフレームワークDuct、ClojureScriptのReactラッパーReagentを基礎としたフレームワークre-frameを利用して、REST API + SPAという構成でTODOアプリを開発する例をご紹介します。

ビルドツールとしてサーバサイドの開発にはLeiningen、フロントエンドの開発にはshadow-cljsを使うことにします(開発/実行環境としてJavaとNode.jsが必要です)。

ちなみにDuctにはduct/module.cljsというClojureScript開発をサポートするモジュールが存在しますが、Ductはもともとサーバサイド向けのフレームワークでClojureScript開発をそれほど便利にしてくれるわけでもなく、そもそもREST APIとSPAを同一プロジェクトで管理しなければならない理由もないので、利用するのは避けてフロントエンドはshadow-cljsによるプロジェクトとして開発します(そのほうがREPL駆動開発のフローも快適になるので個人的にオススメです)。

また、この記事では定番のTODOアプリを例にClojure/ClojureScriptで基本的なREST APIとSPAを開発する流れを示すことを目的とするため、本格的な開発では当然検討するであろう認証/認可、入力バリデーション、エラーハンドリング、ログ出力、UI/UX設計、自動テスト、静的解析、CI/CDなどについては省略します。

サンプルコード

本記事でこのあと示していくコードはこちらのサンプルコードリポジトリにまとめてあります。

READMEの手順に従ってローカル開発環境を準備したり本番環境向けにビルドしたりすることができます。

lagenorhynque/clj-rest-api-and-cljs-spa-example
- todo-api: REST API (Clojure)
- todo-app: SPA (ClojureScript)

最終形の画面イメージ:

REST APIの開発(Clojure)

TODO管理アプリのサーバサイドを、Ductを基礎としたREST APIとして作ってみましょう。

1. Ductプロジェクトの生成

LeiningenのDuctテンプレート(執筆時点ではバージョン0.12.1)を利用してREST APIのscaffoldingを生成します。

今回はDuctの標準モジュールをフル活用してDBアクセスのあるREST APIを作りたいので、以下のようなコマンドを実行してみました。

# Ductプロジェクトを生成
$ lein new duct todo-api +api +ataraxy +example +postgres

以下のようなDuctプロジェクトが生成されます。

# 生成結果を確認
$ tree -a todo-api
todo-api
├── .gitignore
├── README.md
├── dev
│   ├── resources
│   │   └── dev.edn
│   └── src
│       ├── dev.clj
│       └── user.clj
├── project.clj
├── resources
│   └── todo_api
│       ├── config.edn
│       └── public
├── src
│   ├── duct_hierarchy.edn
│   └── todo_api
│       ├── handler
│       │   └── example.clj
│       └── main.clj
└── test
    └── todo_api
        └── handler
            └── example_test.clj

12 directories, 11 files

また、必要に応じて lein duct setup で追加の設定ファイルを生成しておいても良いでしょう(バージョン管理対象としない個人設定が必要な状況で便利です)。

※ ここまでのdiff

2. ローカルDBの準備

ここではDBとしてPostgreSQLを使うことにします。

ローカル開発用にはdocker-composeを利用すると便利です。

todo-api/docker-compose.yml

version: "3"
services:
  postgresql:
    image: postgres:12.3
    ports:
      - "5432:5432"
    volumes:
      - postgresql-data:/var/lib/postgresql/data
    environment:
      POSTGRES_USER: dev
      POSTGRES_PASSWORD: pass
      POSTGRES_DB: todo
      POSTGRES_INITDB_ARGS: "--encoding=UTF-8 --locale=C"
      TZ: "Asia/Tokyo"

volumes:
  postgresql-data:
    driver: local

$ cd todo-api
# ローカルDBを起動
$ docker-compose up -d

そして用意したDBの接続情報をJDBC URLとして dev/resources/dev.edn に設定しておきます。

todo-api/dev/resources/dev.edn

{:duct.database/sql
 {:connection-uri "jdbc:postgresql://localhost:5432/todo?user=dev&password=pass"}}

※ ここまでのdiff

3. 依存ライブラリの整理/追加

テンプレートから生成されたものをそのまま利用することもできますが、適宜 lein ancient :all (Leiningenプラグインlein-ancientの機能)や lein deps :tree の結果を参考に依存ライブラリを最新化したり不要なものを取り除いたり整理すると良いでしょう。

todo-api/project.clj

(defproject todo-api "0.1.0-SNAPSHOT"
  :description "Todo API"
  :url "https://github.com/lagenorhynque/clj-rest-api-and-cljs-spa-example"
  :min-lein-version "2.0.0"
  :dependencies [[duct/core "0.8.0"]
                 [duct/module.ataraxy "0.3.0"]
                 [duct/module.logging "0.5.0"]
                 [duct/module.sql "0.6.0"]
                 [duct/module.web "0.7.0"]
                 [org.clojure/clojure "1.10.1"]
                 [org.postgresql/postgresql "42.2.14"]]
  :plugins [[duct/lein-duct "0.12.1"]]
  :main ^:skip-aot todo-api.main
  :resource-paths ["resources" "target/resources"]
  :prep-tasks     ["javac" "compile" ["run" ":duct/compiler"]]
  :middleware     [lein-duct.plugin/middleware]
  :profiles
  {:dev  [:project/dev :profiles/dev]
   :repl {:prep-tasks   ^:replace ["javac" "compile"]
          :repl-options {:init-ns user}}
   :uberjar {:aot :all}
   :profiles/dev {}
   :project/dev  {:source-paths   ["dev/src"]
                  :resource-paths ["dev/resources"]
                  :dependencies   [[eftest "0.5.9"]
                                   [fipp "0.6.23"]
                                   [hawk "0.2.11"]
                                   [integrant/repl "0.3.1"]
                                   [kerodon "0.9.1"]]}})

ここでは、各ライブラリを執筆時点での最新版に更新し、可読性のためアルファベット順に並べ替え、以下のライブラリを追加しています。

org.postgresql/postgresql: PostgreSQLのJDBCドライバ(※ 利用するDBMS用のものを用意する)
fipp, hawk: duct/core 0.8.0を利用する場合に開発時の依存に加える必要がある

※ ここまでのdiff

4. DBアクセスなしのハンドラ関数の実装

duct/module.ataraxyのルーティング機能を活用して、HTTPリクエストをハンドリングするRingのハンドラ関数を実装します。

今回のTODOアプリのためのAPIは、インターフェースも内部実装も過去記事ミニマリストのためのClojure REST API開発入門でのサンプルREST APIとほぼ同等です。

todo-api/src/todo_api/handler/todo.clj

(ns todo-api.handler.todo
  (:require [ataraxy.core :as ataraxy]
            [ataraxy.response :as response]
            [integrant.core :as ig]))

(def todos
  (atom {1 {:id 1
            :task "build an API"}
         2 {:id 2
            :task "?????"}
         3 {:id 3
            :task "profit!"}}))

(defmethod ig/init-key ::list-todos [_ {:keys [db]}]
  (fn [_]
    ;; TODO: DBアクセス
    [::response/ok (vals @todos)]))

(defmethod ig/init-key ::create-todo [_ {:keys [db]}]
  (fn [{[_ todo] :ataraxy/result}]
    ;; TODO: DBアクセス
    (let [todo-id (->> @todos
                       keys
                       (apply max)
                       inc)]
      (swap! todos assoc todo-id (merge {:id todo-id}
                                        (select-keys todo [:task])))
      [::response/created (str "/todos/" todo-id) (get @todos todo-id)])))

(defmethod ig/init-key ::fetch-todo [_ {:keys [db]}]
  (fn [{[_ todo-id] :ataraxy/result}]
    ;; TODO: DBアクセス
    (if-let [todo (get @todos todo-id)]
      [::response/ok todo]
      [::response/not-found {:message (str "Todo " todo-id " doesn't exist")}])))

(defmethod ig/init-key ::delete-todo [_ {:keys [db]}]
  (fn [{[_ todo-id] :ataraxy/result}]
    ;; TODO: DBアクセス
    (if (get @todos todo-id)
      (do (swap! todos dissoc todo-id)
          [::response/no-content])
      [::response/not-found {:message (str "Todo " todo-id " doesn't exist")}])))

(defmethod ig/init-key ::update-todo [_ {:keys [db]}]
  (fn [{[_ todo-id todo] :ataraxy/result}]
    ;; TODO: DBアクセス
    (swap! todos assoc todo-id (merge {:id todo-id}
                                      (select-keys todo [:task])))
    [::response/created (str "/todos/" todo-id) (get @todos todo-id)]))

todo-api/resources/todo_api/config.edn

{:duct.profile/base
 {:duct.core/project-ns todo-api

  :todo-api.handler.todo/list-todos {:db #ig/ref :duct.database/sql}
  :todo-api.handler.todo/create-todo {:db #ig/ref :duct.database/sql}
  :todo-api.handler.todo/fetch-todo {:db #ig/ref :duct.database/sql}
  :todo-api.handler.todo/delete-todo {:db #ig/ref :duct.database/sql}
  :todo-api.handler.todo/update-todo {:db #ig/ref :duct.database/sql}}

 :duct.profile/dev   #duct/include "dev"
 :duct.profile/local #duct/include "local"
 :duct.profile/prod  {}

 :duct.module/ataraxy
 {"/todos"
  {:get [:todo/list-todos]
   [:post {todo :body-params}] [:todo/create-todo todo]
   ["/" todo-id]
   {:get [:todo/fetch-todo ^int todo-id]
    :delete [:todo/delete-todo ^int todo-id]
    [:put {todo :body-params}] [:todo/update-todo ^int todo-id todo]}}}
 :duct.module/logging {}
 :duct.module.web/api {}
 :duct.module/sql {}}

あとでDBアクセスする実装に書き換えやすいように、あらかじめDB接続情報(正確にはHikariCPのDataSourceオブジェクトを持つClojureレコード) db がハンドラ関数に渡るようにしてあります。

ミニマリストのためのClojure REST API開発入門の例と同様に、APIサーバを起動(Emacs/Spacemacsユーザなら cider-jack-in 後に (dev), (reset))して curl でコマンドラインから動作確認してみましょう。

;; REPLからAPIサーバを起動
user> (dev)
:loaded
dev> (reset)
:reloading (todo-api.main todo-api.handler.todo dev user)
:duct.server.http.jetty/starting-server {:port 3000}
:resumed

# コマンドラインからAPIの動作を確認
# TODO一覧取得
$ curl -s "http://localhost:3000/todos" -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> GET /todos HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
>
< HTTP/1.1 200 OK
< Date: Sat, 20 Jun 2020 14:23:06 GMT
< Content-Type: application/json; charset=utf-8
< Content-Length: 82
< Server: Jetty(9.2.21.v20170120)
<
{ [82 bytes data]
* Connection #0 to host localhost left intact
[
  {
    "id": 1,
    "task": "build an API"
  },
  {
    "id": 2,
    "task": "?????"
  },
  {
    "id": 3,
    "task": "profit!"
  }
]
# 指定IDのTODO取得
$ curl -s "http://localhost:3000/todos/3" -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> GET /todos/3 HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
>
< HTTP/1.1 200 OK
< Date: Sat, 20 Jun 2020 14:23:16 GMT
< Content-Type: application/json; charset=utf-8
< Content-Length: 25
< Server: Jetty(9.2.21.v20170120)
<
{ [25 bytes data]
* Connection #0 to host localhost left intact
{
  "id": 3,
  "task": "profit!"
}
# 指定IDのTODO削除
$ curl -s "http://localhost:3000/todos/2" -X DELETE -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> DELETE /todos/2 HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
>
< HTTP/1.1 204 No Content
< Date: Sat, 20 Jun 2020 14:23:30 GMT
< Content-Type: application/octet-stream
< Server: Jetty(9.2.21.v20170120)
<
* Connection #0 to host localhost left intact
# TODO新規作成
$ curl -s "http://localhost:3000/todos" -d '{"task": "something new"}' --header "Content-Type: application/json" -X POST -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> POST /todos HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
> Content-Type: application/json
> Content-Length: 25
>
} [25 bytes data]
* upload completely sent off: 25 out of 25 bytes
< HTTP/1.1 201 Created
< Date: Sat, 20 Jun 2020 14:23:42 GMT
< Location: http://localhost:3000/todos/4
< Content-Type: application/json; charset=utf-8
< Content-Length: 31
< Server: Jetty(9.2.21.v20170120)
<
{ [31 bytes data]
* Connection #0 to host localhost left intact
{
  "id": 4,
  "task": "something new"
}
# 指定IDのTODO更新(または新規作成)
$ curl -s "http://localhost:3000/todos/3" -d '{"task": "something different"}' --header "Content-Type: application/json" -X PUT -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> PUT /todos/3 HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
> Content-Type: application/json
> Content-Length: 31
>
} [31 bytes data]
* upload completely sent off: 31 out of 31 bytes
< HTTP/1.1 201 Created
< Date: Sat, 20 Jun 2020 14:24:01 GMT
< Location: http://localhost:3000/todos/3
< Content-Type: application/json; charset=utf-8
< Content-Length: 39
< Server: Jetty(9.2.21.v20170120)
<
{ [39 bytes data]
* Connection #0 to host localhost left intact
{
  "id": 3,
  "task": "something different"
}
# TODO一覧取得(ここまでの更新結果の確認)
$ curl -s "http://localhost:3000/todos" -v | jq
*   Trying ::1...
* TCP_NODELAY set
* Connected to localhost (::1) port 3000 (#0)
> GET /todos HTTP/1.1
> Host: localhost:3000
> User-Agent: curl/7.54.0
> Accept: */*
>
< HTTP/1.1 200 OK
< Date: Sat, 20 Jun 2020 14:24:18 GMT
< Content-Type: application/json; charset=utf-8
< Content-Length: 130
< Server: Jetty(9.2.21.v20170120)
<
{ [130 bytes data]
* Connection #0 to host localhost left intact
[
  {
    "id": 1,
    "task": "build an API"
  },
  {
    "id": 3,
    "task": "something different"
  },
  {
    "id": 4,
    "task": "something new"
  }
]

※ ここまでのdiff

5. DBマイグレーションの設定と適用

duct/migrator.ragtimeのDBマイグレーション機能を活用して、SQLファイルによるDBマイグレーションスクリプトを適用できるようにします。

todo-api/resources/todo_api/config.edn

@@ -5,7 +5,12 @@
   :todo-api.handler.todo/create-todo {:db #ig/ref :duct.database/sql}
   :todo-api.handler.todo/fetch-todo {:db #ig/ref :duct.database/sql}
   :todo-api.handler.todo/delete-todo {:db #ig/ref :duct.database/sql}
-  :todo-api.handler.todo/update-todo {:db #ig/ref :duct.database/sql}}
+  :todo-api.handler.todo/update-todo {:db #ig/ref :duct.database/sql}
+
+  :duct.migrator/ragtime
+  {:migrations #ig/ref :duct.migrator.ragtime/resources}
+  :duct.migrator.ragtime/resources
+  {:path "migrations"}}

  :duct.profile/dev   #duct/include "dev"
  :duct.profile/local #duct/include "local"

このように設定すると、 resources/migrations ディレクトリ配下のSQLファイル *.up.sql, *.down.sql の内容でRagtimeによるDBマイグレーションを行うことができるようになります。

また、REPLやコマンドラインからDBマイグレーションの適用やロールバックがしやすいように、ユーティリティ関数 dev/db-migrate, dev/db-rollback を定義し、Leiningenのエイリアスに設定してみました。

todo-api/dev/src/dev.clj

(ns dev
  (:refer-clojure :exclude [test])
  (:require [clojure.repl :refer :all]
            [fipp.edn :refer [pprint]]
            [clojure.tools.namespace.repl :refer [refresh]]
            [clojure.java.io :as io]
            [duct.core :as duct]
            [duct.core.repl :as duct-repl]
            [eftest.runner :as eftest]
            [integrant.core :as ig]
            [integrant.repl :refer [clear halt go init prep reset]]
            [integrant.repl.state :refer [config system]]
            [ragtime.jdbc]
            [ragtime.repl]))

(duct/load-hierarchy)

(defn read-config []
  (duct/read-config (io/resource "todo_api/config.edn")))

(defn test []
  (eftest/run-tests (eftest/find-tests "test")))

(def env-profiles
  {"dev"  [:duct.profile/dev :duct.profile/local]})

(defn- validate-env [env]
  (when-not (some #{env} (keys env-profiles))
    (throw (IllegalArgumentException. (format "env `%s` is undefined" env)))))

(defn- load-migration-config [env]
  (when-let [profiles (get env-profiles env)]
    (let [prepped (duct/prep-config (read-config) profiles)
          {{:keys [connection-uri]} :duct.database.sql/hikaricp} prepped
          resources-key :duct.migrator.ragtime/resources]
      {:datastore (ragtime.jdbc/sql-database connection-uri)
       :migrations (-> prepped
                       (ig/init [resources-key])
                       (get resources-key))})))

(defn db-migrate
  "Migrate DB to the latest migration."
  [env]
  (validate-env env)
  (ragtime.repl/migrate (load-migration-config env)))

(defn db-rollback
  "Rollback DB one migration."
  [env]
  (validate-env env)
  (ragtime.repl/rollback (load-migration-config env)))

(def profiles
  [:duct.profile/dev :duct.profile/local])

(clojure.tools.namespace.repl/set-refresh-dirs "dev/src" "src" "test")

(when (io/resource "local.clj")
  (load "local"))

(integrant.repl/set-prep! #(duct/prep-config (read-config) profiles))

todo-api/project.clj

@@ -26,4 +26,8 @@
                                    [fipp "0.6.23"]
                                    [hawk "0.2.11"]
                                    [integrant/repl "0.3.1"]
-                                   [kerodon "0.9.1"]]}})
+                                   [kerodon "0.9.1"]]
+                  :aliases {"db-migrate" ^{:doc "Migrate DB to the latest migration."}
+                            ["run" "-m" "dev/db-migrate"]
+                            "db-rollback" ^{:doc "Rollback DB one migration."}
+                            ["run" "-m" "dev/db-rollback"]}}})

今回は次のようなマイグレーションスクリプトを用意したので、

todo-api/resources/migrations/0001-create-todo-table.up.sql

CREATE TABLE todo (
  id SERIAL NOT NULL,
  task TEXT NOT NULL,
  PRIMARY KEY (id)
);

todo-api/resources/migrations/0001-create-todo-table.down.sql

DROP TABLE todo;

REPLから以下のように呼び出すと dev 環境のDBにマイグレーションが適用されます。

;; REPLからDBマイグレーション適用
dev> (db-migrate "dev")
Applying 0001-create-todo-table#8fcde0b1
nil

もしくはコマンドラインから次のように呼び出しても同様です。

# コマンドラインからDBマイグレーション適用
$ lein db-migrate dev
Applying 0001-create-todo-table#8fcde0b1

ここでは不要ですが、 (db-rollback "dev") (または lein db-rollback dev)すると dev 環境のDBマイグレーションが1段階ロールバックされます。

※ ここまでのdiff

6. DBバウンダリ関数の実装

DBにアクセスするための関数をDBのバウンダリ(境界)プロトコルで抽象化した関数として実装します。

ClojureでのDBアクセスの低レベルライブラリとしてはclojure.java.jdbcが定番ですが、その後継ライブラリnext.jdbcも登場しているので、今回はnext.jdbcを利用します。

todo-api/project.clj

@@ -8,7 +8,8 @@
                  [duct/module.sql "0.6.0"]
                  [duct/module.web "0.7.0"]
                  [org.clojure/clojure "1.10.1"]
-                 [org.postgresql/postgresql "42.2.14"]]
+                 [org.postgresql/postgresql "42.2.14"]
+                 [seancorfield/next.jdbc "1.1.569"]]
   :plugins [[duct/lein-duct "0.12.1"]]
   :main ^:skip-aot todo-api.main
   :resource-paths ["resources" "target/resources"]
@@ -26,7 +27,8 @@
                                    [fipp "0.6.23"]
                                    [hawk "0.2.11"]
                                    [integrant/repl "0.3.1"]
-                                   [kerodon "0.9.1"]]
+                                   [kerodon "0.9.1"]
+                                   [orchestra "2020.07.12-1"]]
                   :aliases {"db-migrate" ^{:doc "Migrate DB to the latest migration."}
                             ["run" "-m" "dev/db-migrate"]
                             "db-rollback" ^{:doc "Rollback DB one migration."}

また、バウンダリ関数の振る舞いをclojure.specで保護するにあたって関数の戻り値も instrument でチェックされるようにOrchestraを導入し、次のように integrant.repl/reset をラップする dev/reset 関数を定義して reset 時にspecが orchestra.spec.test/instrument されるようにしてみました。

todo-api/dev/src/dev.clj

@@ -8,16 +8,22 @@
             [duct.core.repl :as duct-repl]
             [eftest.runner :as eftest]
             [integrant.core :as ig]
-            [integrant.repl :refer [clear halt go init prep reset]]
+            [integrant.repl :refer [clear halt go init prep]]
             [integrant.repl.state :refer [config system]]
             [ragtime.jdbc]
-            [ragtime.repl]))
+            [ragtime.repl]
+            [orchestra.spec.test :as stest]))

 (duct/load-hierarchy)

 (defn read-config []
   (duct/read-config (io/resource "todo_api/config.edn")))

+(defn reset []
+  (let [result (integrant.repl/reset)]
+    (with-out-str (stest/instrument))
+    result))
+
 (defn test []
   (eftest/run-tests (eftest/find-tests "test")))

あとはTODOアプリのAPIに必要なDBアクセス関数をnext.jdbcのユーティリティを活用して実装するだけです。

todo-api/src/todo_api/boundary/db/todo.clj

(ns todo-api.boundary.db.todo
  (:require [clojure.spec.alpha :as s]
            [duct.database.sql]
            [next.jdbc :as jdbc]
            [next.jdbc.result-set :as rs]
            [next.jdbc.sql :as sql]))

(s/def ::id nat-int?)
(s/def ::task string?)
(s/def ::todo
  (s/keys :req-un [::id
                   ::task]))
(s/def ::row-count nat-int?)

(s/fdef find-todos
  :args (s/cat :db any?)
  :ret (s/coll-of ::todo))

(s/fdef find-todo-by-id
  :args (s/cat :db any?
               :id ::id)
  :ret (s/nilable ::todo))

(s/fdef create-todo!
  :args (s/cat :db any?
               :todo (s/keys :req-un [::task]))
  :ret ::id)

(s/fdef upsert-todo!
  :args (s/cat :db any?
               :id ::id
               :todo (s/keys :req-un [::task]))
  :ret ::id)

(s/fdef delete-todo!
  :args (s/cat :db any?
               :id ::id)
  :ret ::row-count)

(defprotocol Todo
  (find-todos [db])
  (find-todo-by-id [db id])
  (create-todo! [db todo])
  (upsert-todo! [db id todo])
  (delete-todo! [db id]))

(defn ->connectable [db]
  (-> db :spec :datasource))

(def jdbc-opts
  {:return-keys true
   :builder-fn rs/as-unqualified-lower-maps})

(extend-protocol Todo
  duct.database.sql.Boundary
  (find-todos [db]
    (sql/query (->connectable db)
               ["SELECT id, task FROM todo"] jdbc-opts))
  (find-todo-by-id [db id]
    (sql/get-by-id (->connectable db)
                   :todo id jdbc-opts))
  (create-todo! [db todo]
    (-> (->connectable db)
        (sql/insert! :todo (select-keys todo [:task]) jdbc-opts)
        :id))
  (upsert-todo! [db id {:keys [task]}]
    (-> (->connectable db)
        (jdbc/execute-one! ["INSERT INTO todo (id, task) VALUES (?, ?)
                               ON CONFLICT ON CONSTRAINT todo_pkey
                               DO UPDATE SET task = ?"
                            id task task]
                           jdbc-opts)
        :id))
  (delete-todo! [db id]
    (-> (->connectable db)
        (sql/delete! :todo {:id id})
        :next.jdbc/update-count)))

今回は必要なSQLが単純なためnext.jdbcの機能だけで実装しましたが、より複雑なSQLを扱う場合にはHoney SQLやHugSQLなどのSQLライブラリの利用を検討すると良いでしょう。

※ ここまでのdiff

7. DBバウンダリ関数のハンドラ関数への組み込み

ハンドラ関数の実装をDBバウンダリ関数で実際にDBアクセスするものに置き換えます。

todo-api/src/todo_api/handler/todo.clj

@@ -1,50 +1,31 @@
 (ns todo-api.handler.todo
-  (:require [ataraxy.core :as ataraxy]
-            [ataraxy.response :as response]
-            [integrant.core :as ig]))
-
-(def todos
-  (atom {1 {:id 1
-            :task "build an API"}
-         2 {:id 2
-            :task "?????"}
-         3 {:id 3
-            :task "profit!"}}))
+  (:require [ataraxy.response :as response]
+            [integrant.core :as ig]
+            [todo-api.boundary.db.todo :as db.todo]))

 (defmethod ig/init-key ::list-todos [_ {:keys [db]}]
   (fn [_]
-    ;; TODO: DBアクセス
-    [::response/ok (vals @todos)]))
+    [::response/ok (db.todo/find-todos db)]))

 (defmethod ig/init-key ::create-todo [_ {:keys [db]}]
   (fn [{[_ todo] :ataraxy/result}]
-    ;; TODO: DBアクセス
-    (let [todo-id (->> @todos
-                       keys
-                       (apply max)
-                       inc)]
-      (swap! todos assoc todo-id (merge {:id todo-id}
-                                        (select-keys todo [:task])))
-      [::response/created (str "/todos/" todo-id) (get @todos todo-id)])))
+    (let [todo-id (db.todo/create-todo! db todo)]
+      [::response/created (str "/todos/" todo-id) (db.todo/find-todo-by-id db todo-id)])))

 (defmethod ig/init-key ::fetch-todo [_ {:keys [db]}]
   (fn [{[_ todo-id] :ataraxy/result}]
-    ;; TODO: DBアクセス
-    (if-let [todo (get @todos todo-id)]
+    (if-let [todo (db.todo/find-todo-by-id db todo-id)]
       [::response/ok todo]
       [::response/not-found {:message (str "Todo " todo-id " doesn't exist")}])))

 (defmethod ig/init-key ::delete-todo [_ {:keys [db]}]
   (fn [{[_ todo-id] :ataraxy/result}]
-    ;; TODO: DBアクセス
-    (if (get @todos todo-id)
-      (do (swap! todos dissoc todo-id)
+    (if (db.todo/find-todo-by-id db todo-id)
+      (do (db.todo/delete-todo! db todo-id)
           [::response/no-content])
       [::response/not-found {:message (str "Todo " todo-id " doesn't exist")}])))

 (defmethod ig/init-key ::update-todo [_ {:keys [db]}]
   (fn [{[_ todo-id todo] :ataraxy/result}]
-    ;; TODO: DBアクセス
-    (swap! todos assoc todo-id (merge {:id todo-id}
-                                      (select-keys todo [:task])))
-    [::response/created (str "/todos/" todo-id) (get @todos todo-id)]))
+    (db.todo/upsert-todo! db todo-id todo)
+    [::response/created (str "/todos/" todo-id) (db.todo/find-todo-by-id db todo-id)]))

次のような初期データをDBに投入して、DBバウンダリ関数組み込み前と同様に動作することが確認できればREST APIの開発は完了です。

-- psqlから todo テーブルにレコード追加
todo=# insert into todo (task) values ('build an API'), ('?????'), ('profit!');
INSERT 0 3

※ ここまでのdiff

SPAの開発 (ClojureScript)

TODO管理アプリのフロントエンドを、re-frameを基礎としたSPAとして作ってみましょう。

1. shadow-cljsプロジェクトの生成

shadow-cljsの create-cljs-project を利用してClojureScriptでSPA開発を始めるためのscaffoldingを生成します。

# shadow-cljsプロジェクトを生成
$ npx create-cljs-project todo-app

以下のようなshadow-cljsプロジェクトが生成されます。

$ tree -a -I node_modules todo-app
todo-app
├── .gitignore
├── package-lock.json
├── package.json
├── shadow-cljs.edn
└── src
    ├── main
    └── test

3 directories, 4 files

※ ここまでのdiff

2. 依存ライブラリと設定の追加

re-frameによるSPA開発に必要な依存ライブラリとビルド設定を追加します。

ここではshadow-cljsでのre-frame関連設定について一例としてこちらのサンプルコードも参考にしています: quangv/shadow-re-frame-simple-example

また、画面のルーティングと遷移の制御にはbidiとAccountantを利用することにしました。

todo-app/shadow-cljs.edn

;; shadow-cljs configuration
{:source-paths
 ["src/dev"
  "src/main"
  "src/test"]

 :dependencies
 [[bidi "2.1.6"]
  [binaryage/devtools "1.0.2"]
  [day8.re-frame/re-frame-10x "0.6.5"]
  [re-frame "0.12.0"]
  [reagent "0.10.0"]
  [venantius/accountant "0.2.5"]]

 :builds
 {:app {:target :browser
        :output-dir "public/js"
        :asset-path "/js"

        :modules
        {:main
         {:entries [todo-app.core]}}

        :compiler-options
        {:closure-defines
         {"re_frame.trace.trace_enabled_QMARK_" true}}

        :devtools
        {:http-root "public"
         :http-port 8080
         :preloads [devtools.preload
                    day8.re-frame-10x.preload]}

        :release
        {:output-dir "dist/js"}}}}

そしてエントリーポイントとなるClojureScriptファイルも用意しておきます。

todo-app/src/main/todo_app/core.cljs

(ns todo-app.core)

(defn ^:export init []
  (js/alert "Hello, world!"))

※ ここまでのdiff

3. HTMLとCSSの追加

SPAの起点となるHTMLファイルとCSSファイルを用意します。

todo-app/public/index.html

<!DOCTYPE html>
<html lang="en">
  <head>
    <meta charset="utf-8">
    <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
    <title>Todo App</title>
    <link href="/css/style.css" rel="stylesheet" type="text/css">
  </head>
  <body>
    <div id="app"></div>
    <script src="/js/main.js" type="text/javascript"></script>
    <script>
      todo_app.core.init();
    </script>
  </body>
</html>

CSSファイルについてはひとまず空にしておきます。

todo-app/public/css/style.css

この段階で開発サーバを起動(Emacs/Spacemacsユーザなら cider-jack-in-cljs して shadow, :app を選択)してブラウザに反映されることを確認してみましょう。

# コマンドラインからフロントエンドの開発サーバを起動
$ npx shadow-cljs watch app

[:app] Build completed. というメッセージが表示されたら http://localhost:8080 にアクセスしてみましょう。

想定通り todo-app.core/init 関数が実行され、アラートが表示されれば初期設定は完了です。

※ ここまでのdiff

4. re-frameテンプレート相当の構成とルーティングの実装

re-frameの機能とbidi、Accountantを組み合わせて基本的な画面遷移を実装します。

現段階では create-cljs-project 後に最小限のClojureScriptコードを書いただけの状態なので、shadow-cljsプロジェクトにre-frame-templateと同等の初期実装を反映することにしましょう。

todo-app/src/main/todo_app/config.cljs

(ns todo-app.config)

(def debug?
  ^boolean goog.DEBUG)

todo-app/src/main/todo_app/core.cljs

(ns todo-app.core
  (:require [accountant.core :as accountant]
            [bidi.bidi :as bidi]
            [re-frame.core :as re-frame]
            [reagent.dom :as rdom]
            [todo-app.config :as config]
            [todo-app.events :as events]
            [todo-app.routes :refer [routes]]
            [todo-app.views :as views]))

(defn dev-setup []
  (when config/debug?
    (enable-console-print!)
    (println "dev mode")))

(defn mount-root []
  (re-frame/clear-subscription-cache!)
  (let [root-el (.getElementById js/document "app")]
    (rdom/unmount-component-at-node root-el)
    (rdom/render [views/main-panel] root-el)))

(defn ^:export init []
  (re-frame/dispatch-sync [::events/initialize-db])
  (accountant/configure-navigation!
   {:nav-handler (fn [path]
                   (re-frame/dispatch [::events/set-current-route
                                       (bidi/match-route routes path)]))
    :path-exists? (fn [path]
                    (boolean (bidi/match-route routes path)))
    :reload-same-path? true})
  (accountant/dispatch-current!)
  (dev-setup)
  (mount-root))

名前空間 todo-app.core にはアプリケーションのエントリーポイント init があり、ここでre-frameのdbの初期化、Accountantによる画面遷移の初期設定、Reagentのルートコンポーネントのマウントなどをしています。

todo-app/src/main/todo_app/routes.cljs

(ns todo-app.routes
  (:require [accountant.core :as accountant]
            [bidi.bidi :as bidi]))

(def routes
  ["/" {"" :todo-app.views/home
        "list" :todo-app.views/list
        "create" :todo-app.views/create
        [[ #"\d+" :id ] "/edit"] :todo-app.views/edit}])

(defn navigate [view]
  (accountant/navigate! (bidi/path-for routes view)))

re-frameテンプレートの初期構成とは別で用意した名前空間 todo-app.routes では、bidiのルーティング定義 routes とそれを利用した画面遷移用の関数 navigate を定義しています。

todo-app/src/main/todo_app/db.cljs

(ns todo-app.db)

(def default-db
  {})

名前空間 todo-app.db では、re-frameのdbの初期値を定義しています。

todo-app/src/main/todo_app/events.cljs

(ns todo-app.events
  (:require [re-frame.core :as re-frame]
            [todo-app.db :as db]))

(re-frame/reg-event-db
 ::initialize-db
 (fn  [_ _]
   db/default-db))

(re-frame/reg-event-db
 ::set-current-route
 (fn [db [_ route]]
   (assoc db :route route)))

名前空間 todo-app.events では、re-frameのイベントとして現在のルーティング情報を設定するものを登録しています。

todo-app/src/main/todo_app/subs.cljs

(ns todo-app.subs
  (:require [re-frame.core :as re-frame]))

(re-frame/reg-sub
 ::current-route
 (fn [db _]
   (get db :route {:handler :todo-app.views/home})))

名前空間 todo-app.subs では、re-frameのサブスクリプションとして現在のルーティング情報を取得するものを登録しています。

todo-app/src/main/todo_app/views.cljs

(ns todo-app.views
  (:require [re-frame.core :as re-frame]
            [todo-app.subs :as subs]))

(defmulti view :handler)

(defmethod view ::home [_]
  [:div "Home"])

(defmethod view ::list [_]
  [:div "Todo List"])

(defmethod view ::create [_]
  [:div "Create New Todo"])

(defmethod view ::edit [{:keys [route-params]}]
  [:div (str "Edit Todo " (:id route-params))])

(defmethod view :default [_]
  [:div "404 Not Found"])

(defn main-panel []
  [:div "Todo App"
   [view @(re-frame/subscribe [::subs/current-route])]])

名前空間 todo-app.views では、マルチメソッドによる view コンポーネントを定義し、現在のルーティング情報によって画面が切り替わるように実装しています。

ここまでの実装が想定通りかどうか、ブラウザで動作確認してみましょう。

ホーム画面: http://localhost:8080

TODO一覧画面: http://localhost:8080/list

TODO新規作成画面: http://localhost:8080/create

TODO編集画面(id=1の場合): http://localhost:8080/1/edit

Not Found画面: e.g. http://localhost:8080/undefined-path

ちなみに画面右側に表示されているのはre-frame-10xのダッシュボードで、re-frame開発時にプロジェクトに設定しておくと非常に便利です(キーバインドCtrl-Hで開閉します)。

※ ここまでのdiff

5. CORSの設定とTODO一覧画面の実装

TODOアプリのREST APIに別ホストのSPA側からアクセスできるようにCORSの設定を追加し、TODO一覧取得APIの結果を表示する一覧画面を実装します。

本記事の前半で開発したREST APIではそのまま別ホストからアクセスしようとするとCORSに関してエラーが発生してしまうため、まずはサーバサイドに若干の改修が必要です。

Ductのduct/module.webはRingベースのWeb/APIサーバなので、Ring CORSというライブラリを利用するとRingのミドルウェアによってCORSの設定を簡単に行うことができます。

todo-api/project.clj

@@ -9,6 +9,7 @@
                  [duct/module.web "0.7.0"]
                  [org.clojure/clojure "1.10.1"]
                  [org.postgresql/postgresql "42.2.14"]
+                 [ring-cors "0.1.13"]
                  [seancorfield/next.jdbc "1.1.569"]]
   :plugins [[duct/lein-duct "0.12.1"]]
   :main ^:skip-aot todo-api.main

todo-api/src/todo_api/main.clj

@@ -4,9 +4,12 @@

 (duct/load-hierarchy)

+(def custom-readers
+  {'todo-api/regex re-pattern})
+
 (defn -main [& args]
   (let [keys     (or (duct/parse-keys args) [:duct/daemon])
         profiles [:duct.profile/prod]]
     (-> (duct/resource "todo_api/config.edn")
-        (duct/read-config)
+        (duct/read-config custom-readers)
         (duct/exec-config profiles keys))))

todo-api/dev/src/dev.clj

@@ -12,12 +12,14 @@
             [integrant.repl.state :refer [config system]]
             [ragtime.jdbc]
             [ragtime.repl]
-            [orchestra.spec.test :as stest]))
+            [orchestra.spec.test :as stest]
+            [todo-api.main :refer [custom-readers]]))

 (duct/load-hierarchy)

 (defn read-config []
-  (duct/read-config (io/resource "todo_api/config.edn")))
+  (duct/read-config (io/resource "todo_api/config.edn")
+                    custom-readers))

 (defn reset []
   (let [result (integrant.repl/reset)]

todo-api/resources/todo_api/config.edn

@@ -7,6 +7,13 @@
   :todo-api.handler.todo/delete-todo {:db #ig/ref :duct.database/sql}
   :todo-api.handler.todo/update-todo {:db #ig/ref :duct.database/sql}

+  :todo-api.middleware/wrap-cors
+  {:access-control-allow-origin [#todo-api/regex ".*"]
+   :access-control-allow-methods [:get :put :post :delete]}
+
+  :duct.handler/root
+  {:middleware [#ig/ref :todo-api.middleware/wrap-cors]}
+
   :duct.migrator/ragtime
   {:migrations #ig/ref :duct.migrator.ragtime/resources}
   :duct.migrator.ragtime/resources

todo-api/src/todo_api/middleware.clj

(ns todo-api.middleware
  (:require [integrant.core :as ig]
            [ring.middleware.cors :refer [wrap-cors]]))

(defmethod ig/init-key ::wrap-cors [_ config]
  #(apply wrap-cors % (apply concat config)))

Ringミドルウェア ring.middleware.cors/wrap-cors は正規表現でoriginのURLを指定するようになっていることから、Ductのedn形式の設定ファイルに正規表現もそのままリテラルで書けるようにカスタムタグ #todo-api/regex を定義してみました(ednではリーダーマクロ #" " が使えないため cf. regex in edn? - Google Groups)。

今回は :access-control-allow-origin [#todo-api/regex ".*"] として任意のホストからのアクセスを許可したので、フロントエンドの開発サーバ http://localhost:8080 からもAPIを呼び出せるようになります。

ここからはフロントエンド側の実装に戻り、TODO一覧取得APIを呼び出して結果を画面表示できるようにします。

re-frameでエフェクトとしてHTTPリクエストを実行するにはre-frame-http-fxを利用することができます(後継ライブラリとしてre-frame-http-fx-alphaというものも登場しているようです)。

todo-app/shadow-cljs.edn

@@ -8,6 +8,7 @@
  [[bidi "2.1.6"]
   [binaryage/devtools "1.0.2"]
   [day8.re-frame/re-frame-10x "0.6.5"]
+  [day8.re-frame/http-fx "v0.2.0"]
   [re-frame "0.12.0"]
   [reagent "0.10.0"]
   [venantius/accountant "0.2.5"]]
@@ -32,4 +33,5 @@
                     day8.re-frame-10x.preload]}

         :release
-        {:output-dir "dist/js"}}}}
+        {:output-dir "dist/js"
+         :closure-defines {todo-app.config/API_URL "<production api url>"}}}}}

todo-app/src/main/todo_app/config.cljs

@@ -2,3 +2,5 @@

 (def debug?
   ^boolean goog.DEBUG)
+
+(goog-define API_URL "http://localhost:3000")

APIのURLは開発環境と本番環境などビルドによって値を差し替えたい設定値なので、Shadow CLJS User’s Guide > 6.5. Closure Definesを参考に goog-define で todo-app.config/API_URL として定義し、 :closure-defines オプションで上書きできるようにしてみました。

todo-app/src/main/todo_app/events.cljs

@@ -1,7 +1,15 @@
 (ns todo-app.events
-  (:require [re-frame.core :as re-frame]
+  (:require [ajax.core :as ajax]
+            [day8.re-frame.http-fx]
+            [re-frame.core :as re-frame]
+            [todo-app.config :as config]
             [todo-app.db :as db]))

+(def request-defaults
+  {:timeout 6000
+   :response-format (ajax/json-response-format {:keywords? true})
+   :on-failure [::set-error]})
+
 (re-frame/reg-event-db
  ::initialize-db
  (fn  [_ _]
@@ -11,3 +19,21 @@
  ::set-current-route
  (fn [db [_ route]]
    (assoc db :route route)))
+
+(re-frame/reg-event-db
+ ::set-error
+ (fn [db [_ res]]
+   (assoc db :error res)))
+
+(re-frame/reg-event-fx
+ ::fetch-todos
+ (fn [_ _]
+   {:http-xhrio (assoc request-defaults
+                       :method :get
+                       :uri (str config/API_URL "/todos")
+                       :on-success [::update-todos])}))
+
+(re-frame/reg-event-db
+ ::update-todos
+ (fn [db [_ res]]
+   (assoc db :todos res)))

::fetch-todos イベントで利用している :http-xhrio がre-frame-http-fxによって利用可能になるエフェクト(fx)で、開発環境の場合 http://localhost:3000/todos にGETでリクエストして得たレスポンスデータ(TODOリスト)をdbに書き込みます。

todo-app/src/main/todo_app/subs.cljs

@@ -5,3 +5,8 @@
  ::current-route
  (fn [db _]
    (get db :route {:handler :todo-app.views/home})))
+
+(re-frame/reg-sub
+ ::todos
+ (fn [db _]
+   (:todos db)))

あとはdbに入っているTODOリストをサブスクリプションで取り出し、画面に反映するだけです。

todo-app/src/main/todo_app/views.cljs

@@ -1,5 +1,6 @@
 (ns todo-app.views
   (:require [re-frame.core :as re-frame]
+            [todo-app.events :as events]
             [todo-app.subs :as subs]))

 (defmulti view :handler)
@@ -8,7 +9,12 @@
   [:div "Home"])

 (defmethod view ::list [_]
-  [:div "Todo List"])
+  (re-frame/dispatch [::events/fetch-todos])
+  [:div "Todo List"
+   [:ul
+    (map (fn [{:keys [id task]}]
+           [:li {:key id} task])
+         @(re-frame/subscribe [::subs/todos]))]])

 (defmethod view ::create [_]
   [:div "Create New Todo"])

ここでは手軽さを優先して view コンポーネント内で (re-frame/dispatch [::events/fetch-todos]) して ::events/fetch-todos を発火しています(コンポーネント再描画のたびに不要なイベントが発火してしまう問題があるので、後ほどより良い実装に修正します)。

TODO一覧画面を開いてみると、サーバサイドのDBの todo テーブルの内容がREST APIを介してフロントエンドのdbに入り、画面に一覧表示されることが確認できます。

※ ここまでのdiff

6. TODO新規作成/編集画面の実装

更新系操作(TODO新規作成/更新/削除)も画面から実行できるようにしてTODOアプリの機能を仕上げます。

新規作成/編集画面のフォームにはForkというライブラリを利用することにしました。

todo-app/shadow-cljs.edn

@@ -9,6 +9,7 @@
   [binaryage/devtools "1.0.2"]
   [day8.re-frame/re-frame-10x "0.6.5"]
   [day8.re-frame/http-fx "v0.2.0"]
+  [fork "1.2.6"]
   [re-frame "0.12.0"]
   [reagent "0.10.0"]
   [venantius/accountant "0.2.5"]]

todo-app/src/main/todo_app/db.cljs

@@ -1,4 +1,5 @@
 (ns todo-app.db)

 (def default-db
-  {})
+  {:todos []
+   :selected-todo nil})

todo-app/src/main/todo_app/routes.cljs

@@ -8,5 +8,7 @@
         "create" :todo-app.views/create
         [[ #"\d+" :id ] "/edit"] :todo-app.views/edit}])

-(defn navigate [view]
-  (accountant/navigate! (bidi/path-for routes view)))
+(defn navigate
+  ([view] (navigate view {}))
+  ([view params]
+   (accountant/navigate! (apply bidi/path-for routes view (apply concat params)))))

todo-app/src/main/todo_app/fx.cljs

(ns todo-app.fx
  (:require [re-frame.core :as re-frame]
            [todo-app.routes :as routes]))

(re-frame/reg-fx
 ::navigate
 (fn [{:keys [view params]}]
   (routes/navigate view params)))

画面遷移は画面状態を変更する一種の副作用なので、re-frameのエフェクト ::navigate として登録してイベントから発生させられるようにします。

/todo-app/src/main/todo_app/events.cljs

@@ -3,7 +3,8 @@
             [day8.re-frame.http-fx]
             [re-frame.core :as re-frame]
             [todo-app.config :as config]
-            [todo-app.db :as db]))
+            [todo-app.db :as db]
+            [todo-app.fx :as fx]))

 (def request-defaults
   {:timeout 6000
@@ -15,10 +16,25 @@
  (fn  [_ _]
    db/default-db))

-(re-frame/reg-event-db
+(defmulti on-navigate (fn [view _] view))
+(defmethod on-navigate :todo-app.views/list [_ _]
+  {:dispatch [::fetch-todos]})
+(defmethod on-navigate :todo-app.views/edit [_ params]
+  {:dispatch [::fetch-todo-by-id (:id params)]})
+(defmethod on-navigate :default [_ _] nil)
+
+(re-frame/reg-event-fx
  ::set-current-route
- (fn [db [_ route]]
-   (assoc db :route route)))
+ (fn [{:keys [db]} [_ {:keys [handler route-params]
+                       :as route}]]
+   (merge {:db (assoc db :route route)}
+          (on-navigate handler route-params))))
+
+(re-frame/reg-event-fx
+ ::navigate
+ (fn [_ [_ view params]]
+   {::fx/navigate {:view view
+                   :params params}}))

 (re-frame/reg-event-db
  ::set-error
@@ -31,9 +47,54 @@
    {:http-xhrio (assoc request-defaults
                        :method :get
                        :uri (str config/API_URL "/todos")
-                       :on-success [::update-todos])}))
+                       :on-success [::set-todos])}))
+
+(re-frame/reg-event-db
+ ::set-todos
+ (fn [db [_ res]]
+   (assoc db
+          :todos res
+          :selected-todo nil)))
+
+(re-frame/reg-event-fx
+ ::fetch-todo-by-id
+ (fn [{:keys [db]} [_ todo-id]]
+   {:db (assoc db :selected-todo nil)
+    :http-xhrio (assoc request-defaults
+                       :method :get
+                       :uri (str config/API_URL "/todos/" todo-id)
+                       :on-success [::set-selected-todo])}))

 (re-frame/reg-event-db
- ::update-todos
+ ::set-selected-todo
  (fn [db [_ res]]
-   (assoc db :todos res)))
+   (assoc db :selected-todo res)))
+
+(re-frame/reg-event-fx
+ ::create-todo
+ (fn [_ [_ {:keys [values]}]]
+   {:http-xhrio (assoc request-defaults
+                       :method :post
+                       :uri (str config/API_URL "/todos")
+                       :params values
+                       :format (ajax/json-request-format)
+                       :on-success [::navigate :todo-app.views/list])}))
+
+(re-frame/reg-event-fx
+ ::update-todo-by-id
+ (fn [_ [_ todo-id {:keys [values]}]]
+   {:http-xhrio (assoc request-defaults
+                       :method :put
+                       :uri (str config/API_URL "/todos/" todo-id)
+                       :params values
+                       :format (ajax/json-request-format)
+                       :on-success [::navigate :todo-app.views/list])}))
+
+(re-frame/reg-event-fx
+ ::delete-todo-by-id
+ (fn [_ [_ todo-id]]
+   {:http-xhrio (assoc request-defaults
+                       :method :delete
+                       :uri (str config/API_URL "/todos/" todo-id)
+                       :format (ajax/json-request-format)
+                       :on-success [::fetch-todos])}))

ここでは新たにマルチメソッド on-navigate を定義し、 ::navigate イベントによる画面遷移時に画面によって発火させたいイベントを個別に紐付けられるようにしてみました。

これにより、データ取得のためのAPI呼び出しイベントを画面遷移時にのみ発火させることができます(コンポーネント再描画のたびにイベント発火してしまう問題を解決)。

todo-app/src/main/todo_app/subs.cljs

@@ -10,3 +10,8 @@
  ::todos
  (fn [db _]
    (:todos db)))
+
+(re-frame/reg-sub
+ ::selected-todo
+ (fn [db _]
+   (:selected-todo db)))

todo-app/src/main/todo_app/views.cljs

@@ -1,30 +1,67 @@
 (ns todo-app.views
-  (:require [re-frame.core :as re-frame]
+  (:require [fork.core :as fork]
+            [re-frame.core :as re-frame]
             [todo-app.events :as events]
             [todo-app.subs :as subs]))

 (defmulti view :handler)

 (defmethod view ::home [_]
-  [:div "Home"])
+  [:div "Home"
+   [:ul
+    [:li [:button {:on-click #(re-frame/dispatch [::events/navigate ::list])}
+          "View"]]
+    [:li [:button {:on-click #(re-frame/dispatch [::events/navigate ::create])}
+          "Create"]]]])

 (defmethod view ::list [_]
-  (re-frame/dispatch [::events/fetch-todos])
   [:div "Todo List"
    [:ul
     (map (fn [{:keys [id task]}]
-           [:li {:key id} task])
+           [:li {:key id}
+            task
+            [:button {:on-click #(re-frame/dispatch [::events/navigate ::edit {:id id}])}
+             "Edit"]
+            [:button {:on-click #(re-frame/dispatch [::events/delete-todo-by-id id])}
+             "Delete"]])
          @(re-frame/subscribe [::subs/todos]))]])

+(defn todo-form [props]
+  [fork/form (merge {:prevent-default? true
+                     :clean-on-unmount? true}
+                    props)
+   (fn [{:keys [values
+                form-id
+                handle-change
+                handle-blur
+                submitting?
+                handle-submit]}]
+     [:form {:id form-id
+             :on-submit handle-submit}
+      [:label "Task"]
+      [:input {:name "task"
+               :value (values "task")
+               :on-change handle-change
+               :on-blur handle-blur}]
+      [:button {:type "submit"
+                :disabled submitting?}
+       "Submit"]])])
+
 (defmethod view ::create [_]
-  [:div "Create New Todo"])
+  [:div "Create New Todo"
+   [todo-form {:on-submit #(re-frame/dispatch [::events/create-todo %])}]])

 (defmethod view ::edit [{:keys [route-params]}]
-  [:div (str "Edit Todo " (:id route-params))])
+  [:div (str "Edit Todo " (:id route-params))
+   (when-let [{:keys [id task]} @(re-frame/subscribe [::subs/selected-todo])]
+     [todo-form {:initial-values {"task" task}
+                 :on-submit #(re-frame/dispatch [::events/update-todo-by-id id %])}])])

 (defmethod view :default [_]
   [:div "404 Not Found"])

 (defn main-panel []
-  [:div "Todo App"
+  [:div
+   [:div {:on-click #(re-frame/dispatch [::events/navigate ::home])}
+    "Todo App"]
    [view @(re-frame/subscribe [::subs/current-route])]])

動作確認してみると、以下のように振る舞うことが確認できます。

ホーム画面
- Viewボタンを押下すると、TODO一覧画面へ遷移
- Createボタンを押下すると、TODO新規作成画面へ遷移

TODO新規作成画面
- Taskを入力してSubmitボタンを押下すると、TODOを作成してTODO一覧画面へ遷移

TODO一覧画面
- リストのEditボタンを押下すると、対応するTODO編集画面へ遷移
- リストのDeleteボタンを押下すると、対応するTODOを削除してTODOリストを最新化

TODO編集画面
- Taskを入力してSubmitボタンを押下すると、TODOを更新してTODO一覧画面へ遷移

※ ここまでのdiff

7. UIフレームワークの導入

UIフレームワークを導入して画面のデザインを整えます。

今回はMaterial DesignのMaterial-UIを利用することにしました。

npm install @material-ui/core @material-ui/icons のようにしてJavaScriptライブラリもshadow-cljsプロジェクトからシームレスに利用することができます。

todo-app/package.json

@@ -6,6 +6,8 @@
     "shadow-cljs": "2.10.12"
   },
   "dependencies": {
+    "@material-ui/core": "^4.10.2",
+    "@material-ui/icons": "^4.9.1",
     "highlight.js": "9.18.1",
     "react": "16.13.1",
     "react-dom": "16.13.1",

todo-app/public/css/style.css

@@ -0,0 +1,4 @@
+body {
+  font-family: HelveticaNeue, Helvetica;
+  margin: 0;
+}

ここでは単体のCSSファイルで最小限の設定にとどめていますが、本格的な開発ではClojureScriptのCSSライブラリGarden, stylefyなどの利用も検討すると良いでしょう。

todo-app/src/main/todo_app/routes.cljs

@@ -3,12 +3,13 @@
             [bidi.bidi :as bidi]))

 (def routes
-  ["/" {"" :todo-app.views/home
-        "list" :todo-app.views/list
+  ["/" {"" :todo-app.views/list
         "create" :todo-app.views/create
-        [[ #"\d+" :id ] "/edit"] :todo-app.views/edit}])
+        ["edit/" [ #"\d+" :id ]] :todo-app.views/edit}])
+
+(def path-for (partial bidi/path-for routes))

 (defn navigate
   ([view] (navigate view {}))
   ([view params]
-   (accountant/navigate! (apply bidi/path-for routes view (apply concat params)))))
+   (accountant/navigate! (apply path-for view (apply concat params)))))

このタイミングでルーティング定義を見直し、URL構成を変更してみました。

todo-app/src/main/todo_app/events.cljs

@@ -98,3 +98,13 @@
                        :uri (str config/API_URL "/todos/" todo-id)
                        :format (ajax/json-request-format)
                        :on-success [::fetch-todos])}))
+
+(re-frame/reg-event-db
+ ::open-delete-dialog
+ (fn [db [_ todo-id]]
+   (assoc db :delete-dialog {:todo-id todo-id})))
+
+(re-frame/reg-event-db
+ ::close-delete-dialog
+ (fn [db _]
+   (assoc db :delete-dialog nil)))

todo-app/src/main/todo_app/subs.cljs

@@ -15,3 +15,13 @@
  ::selected-todo
  (fn [db _]
    (:selected-todo db)))
+
+(re-frame/reg-sub
+ ::delete-dialog-open?
+ (fn [db _]
+   (some? (:delete-dialog db))))
+
+(re-frame/reg-sub
+ ::delete-target
+ (fn [db _]
+   (get-in db [:delete-dialog :todo-id])))

todo-app/src/main/todo_app/views.cljs

@@ -1,30 +1,74 @@
 (ns todo-app.views
-  (:require [fork.core :as fork]
+  (:require ["@material-ui/core/AppBar" :default AppBar]
+            ["@material-ui/core/Avatar" :default Avatar]
+            ["@material-ui/core/Breadcrumbs" :default Breadcrumbs]
+            ["@material-ui/core/Button" :default Button]
+            ["@material-ui/core/Container" :default Container]
+            ["@material-ui/core/Dialog" :default Dialog]
+            ["@material-ui/core/DialogActions" :default DialogActions]
+            ["@material-ui/core/DialogTitle" :default DialogTitle]
+            ["@material-ui/core/Fab" :default Fab]
+            ["@material-ui/core/IconButton" :default IconButton]
+            ["@material-ui/core/Link" :default Link]
+            ["@material-ui/core/List" :default List]
+            ["@material-ui/core/ListItem" :default ListItem]
+            ["@material-ui/core/ListItemAvatar" :default ListItemAvatar]
+            ["@material-ui/core/ListItemSecondaryAction" :default ListItemSecondaryAction]
+            ["@material-ui/core/ListItemText" :default ListItemText]
+            ["@material-ui/core/TextField" :default TextField]
+            ["@material-ui/core/Toolbar" :default Toolbar]
+            ["@material-ui/core/Typography" :default Typography]
+            ["@material-ui/icons/Add" :default AddIcon]
+            ["@material-ui/icons/Delete" :default DeleteIcon]
+            ["@material-ui/icons/Save" :default SaveIcon]
+            ["@material-ui/icons/Work" :default WorkIcon]
+            [fork.core :as fork]
             [re-frame.core :as re-frame]
+            [reagent.core :as reagent]
             [todo-app.events :as events]
+            [todo-app.routes :as routes]
             [todo-app.subs :as subs]))

 (defmulti view :handler)

-(defmethod view ::home [_]
-  [:div "Home"
-   [:ul
-    [:li [:button {:on-click #(re-frame/dispatch [::events/navigate ::list])}
-          "View"]]
-    [:li [:button {:on-click #(re-frame/dispatch [::events/navigate ::create])}
-          "Create"]]]])
-
 (defmethod view ::list [_]
-  [:div "Todo List"
-   [:ul
+  [:div
+   [:p "Todo List"]
+   [:> List
     (map (fn [{:keys [id task]}]
-           [:li {:key id}
-            task
-            [:button {:on-click #(re-frame/dispatch [::events/navigate ::edit {:id id}])}
-             "Edit"]
-            [:button {:on-click #(re-frame/dispatch [::events/delete-todo-by-id id])}
-             "Delete"]])
-         @(re-frame/subscribe [::subs/todos]))]])
+           ^{:key id}
+           [:> ListItem {:button true
+                         :on-click #(re-frame/dispatch [::events/navigate ::edit {:id id}])}
+            [:> ListItemAvatar
+             [:> Avatar
+              [:> WorkIcon]]]
+            [:> ListItemText {:primary task}]
+            [:> ListItemSecondaryAction
+             [:> IconButton {:edge "end"
+                             :aria-label "delete"
+                             :on-click #(re-frame/dispatch [::events/open-delete-dialog id])}
+              [:> DeleteIcon]]]])
+         @(re-frame/subscribe [::subs/todos]))]
+   [:> Dialog {:open @(re-frame/subscribe [::subs/delete-dialog-open?])
+               :on-close #(re-frame/dispatch [::events/close-delete-dialog])
+               :aria-labelledby "alert-dialog-title"}
+    [:> DialogTitle {:id "alert-dialog-title"}
+     "Are you sure you want to delete this?"]
+    [:> DialogActions
+     [:> Button {:on-click #(re-frame/dispatch [::events/close-delete-dialog])
+                 :color "primary"}
+      "Cancel"]
+     [:> Button {:on-click (fn []
+                             (re-frame/dispatch [::events/delete-todo-by-id
+                                                 @(re-frame/subscribe [::subs/delete-target])])
+                             (re-frame/dispatch [::events/close-delete-dialog]))
+                 :color "secondary"
+                 :variant "contained"}
+      "Delete"]]]
+   [:> Fab {:color "secondary"
+            :aria-label "add"
+            :on-click #(re-frame/dispatch [::events/navigate ::create])}
+    [:> AddIcon]]])

 (defn todo-form [props]
   [fork/form (merge {:prevent-default? true
@@ -38,30 +82,53 @@
                 handle-submit]}]
      [:form {:id form-id
              :on-submit handle-submit}
-      [:label "Task"]
-      [:input {:name "task"
-               :value (values "task")
-               :on-change handle-change
-               :on-blur handle-blur}]
-      [:button {:type "submit"
-                :disabled submitting?}
-       "Submit"]])])
+      [:> TextField {:label "Task"
+                     :required true
+                     :name "task"
+                     :default-value (values "task")
+                     :on-change handle-change
+                     :on-blur handle-blur}]
+      [:> Button {:type "submit"
+                  :disabled submitting?
+                  :color "secondary"
+                  :variant "contained"
+                  :start-icon (reagent/as-element [:> SaveIcon])}
+       "Save"]])])

 (defmethod view ::create [_]
-  [:div "Create New Todo"
+  [:div
+   [:p "Create New Todo"]
    [todo-form {:on-submit #(re-frame/dispatch [::events/create-todo %])}]])

 (defmethod view ::edit [{:keys [route-params]}]
-  [:div (str "Edit Todo " (:id route-params))
+  [:div
+   [:p (str "Edit Todo (id: " (:id route-params) ")")]
    (when-let [{:keys [id task]} @(re-frame/subscribe [::subs/selected-todo])]
      [todo-form {:initial-values {"task" task}
                  :on-submit #(re-frame/dispatch [::events/update-todo-by-id id %])}])])

 (defmethod view :default [_]
-  [:div "404 Not Found"])
+  [:div
+   [:p "404 Not Found"]])

 (defn main-panel []
-  [:div
-   [:div {:on-click #(re-frame/dispatch [::events/navigate ::home])}
-    "Todo App"]
-   [view @(re-frame/subscribe [::subs/current-route])]])
+  (let [{:keys [handler]
+         :as current-route} @(re-frame/subscribe [::subs/current-route])]
+    [:div
+     [:> AppBar {:position "static"}
+      [:> Toolbar
+       [:> Breadcrumbs {:aria-label "breadcrumb"}
+        [:> Link {:color "inherit"
+                  :variant "h6"
+                  :href (routes/path-for ::list)}
+         "TODOS"]
+        (case handler
+          ::create [:> Typography {:color "textPrimary"
+                                   :variant "h6"}
+                    "CREATE"]
+          ::edit [:> Typography {:color "textPrimary"
+                                 :variant "h6"}
+                  "EDIT"]
+          nil)]]]
+     [:> Container
+      [view current-route]]]))

shadow-cljsプロジェクトでの (:require ["@material-ui/core/AppBar" :default AppBar]) という記法はJavaScriptにおける import AppBar from "@material-ui/core/AppBar"; に相当します(cf. Shadow CLJS User’s Guide > 12.1.1. Using npm packages)。

また、 [:> WorkIcon] という記法は [(reagent/adapt-react-class WorkIcon)] と等価で、ReactコンポーネントをReagentコンポーネントとして扱う際の略記法です(cf. reagent/doc/InteropWithReact.md > Creating Reagent "Components" from React Components)。

※ ここまでのdiff