はじめに

この記事では、PureScriptで行うサーバサイドアプリ（REST APIサーバ)の開発をご紹介します！

ただし、あくまで「わたしがRESTのAPIを作るときはこうやってる」というやりかたを紹介するにすぎないので、当然ここで述べている方法が唯一絶対のものではありません。
ちなみに、記事で選択していない他のソリューションについては、記事の最後にAppendixとしてまとめてあります。

記事の流れは以下のような感じです:

最初に、ライブラリの使い方を説明します。パス文字列を扱うためのライブラリや、JSONシリアライズ/デシリアライズなどの周辺のライブラリ事情も合わせて説明しています
次に、それらを用いてブログ記事の取得や作成を行える至極単純なREST APIを実装します。この時点でのAPIの実装は、一つの関数の中で直接HTTPリクエストやレスポンスを触ったり、DBにアクセスしたりするモノリシックな構造です
後半では、そのようなアーキテクチャになっているのを、処理の抽象度のレベルに応じてレイヤーに分離することで、アプリケーションのアーキテクチャを改善する手法を紹介します

最近巷で流行っている、レイヤードアーキテクチャとか、関数型のドメインモデリングとかが、PureScriptだとどうできるのかが気になっている方は、ぜひ後半部分をお読みください。だいぶ長大ですが！

使用技術

今回の記事で作るアプリケーションは、大きく以下の２つのライブラリに基づいています:

httpurple ... PureScriptでREST APIを書くためのライブラリ。HTTPurple🪁と凧の絵文字をつけるのが本式？
run ... PureScriptにおける代数的作用のライブラリレベルの実装(代数的作用についてはあとのセクションで詳しく述べます)

（もちろん、REST APIとして動かすに当たり、nodeなりpostgresなりDockerなりに依存していますが、そのへんはPureScript関係ないので端折ります)

早わかりHTTPurple🪁

わたしがHTTPurpleを好きなポイントは、やはりそのシンプルさです！
世の中にはオールインワンでヘビーなWebフレームワークがあふれる中、HTTPurpleは非常に軽量でシンプルなライブラリです。

REST APIのやることなんて、結局はリクエストからレスポンスを計算する作用を持った関数にすぎない
ルーティングなんてPureScriptのパターンマッチでイナフ

という姿勢が垣間見えるあたり、わたしとしては非常に好感触です。

HTTPurpleでは、すべてのリクエストのデータが Request型に集約されています。
（このデータ型はHTTPurple.Request モジュールで定義されている）

Request型はレコードで、その代表的なフィールドは以下のような感じです:

type Request route =
  { route :: route
  , method :: Method
  , query :: Object String
  , body :: RequestBody
  , ...
  }

この他にも、いくつかのフィールドを持っています。詳しいことはドキュメントを御覧ください。

HTTPurpleを用いたAPI開発では、このRequest型の値を受け取って、ResponseM型の値を返す関数を記述します:

router :: Request MyRoute -> ResponseM

HTTPurpleでは、このような関数は「ルーター関数(Router function)」と呼ばれています。

ResposneMは型エイリアスで、本体は以下のような定義となっています:

type ResponseM = Aff Response

つまり、Responseを返すAffモナドを返す、ということです。
Responseもレコード型ですが、普通はこのレコードを手で作って返すことはせず、HTTPレスポンスのステータスに応じてokやbadRequestのような関数を使うのが基本です。これらの関数はHTTPurple.Responseモジュールで定義されています。
Response型の中身についてもドキュメントを参照してください。別に知らなくてもこの先を読むうえでは何も困りません。

Requestはrouteフィールドの型について多相的になっていますが、この型パラメタはルートのデータ型で具象化するようになっています。
たとえば、ブログの記事とコメントのAPIを作っていて、以下のようなパスを公開するとします:

/posts

/posts/:postId

/posts/:postId/comments?sorting=(asc|desc)

このようなルートは、以下のようなデータ型で表現できるでしょう:

type PostId = String

data Sort = ASC | DESC 

data MyRoute
  = Posts 
  | Post PostId 
  | PostComments PostId { sorint :: Maybe Sort }

このようなルート定義を持つAPIの場合、リクエストの型は Request MyRouteになるという感じです。
たとえば、 "/posts"へのGETリクエストの場合、

req = { route: Posts, method: Get, ... }

のような値が渡されることになります。

以上より、HTTPurpleでのAPI開発は、以下のようにルータ関数を実装することに帰着します:

router :: Request MyRoute -> ResponseM
router { route, method } = case method, route of
  -- "/posts"へのGetリクエストのハンドラ
  Get, Posts -> do
    -- ResponseMはAffモナドなので、任意の作用を起こせる
    Console.log "Hello"

    -- Status 200
    ok 
      [ { id: "article-1", title: "Article 1", body: "..." }
      , { id: "article-2", title: "Article 2", body: "..." }
      ]

  -- "/posts/:postId/comments への Postリクエスト
  Post, Posts -> do 
    ... 

  -- 上記以外は 404
  _, _ -> notFound

Routing Duplex

HTTPurpleがどのようにリクエストのパス文字列からMyRoute型の値を得ているのかについて、簡単に触れておきましょう。
HTTPurpleは、背後でRouting Duplexというライブラリを用いています。

routing-duplexとは、(上記のMyRouteのような)ルートを表すデータ型とパス文字列の間の相互変換を可能にするコーデックを作るためのライブラリです。
以下のように各ルートのパスそのものを模した宣言的DSLでコーデックを記述できる、非常に面白いライブラリです。myrouteの定義と、上のパス文字列の一覧をよく見比べてください。

import Data.Generic.Rep (class Generic)
import Routing.Duplex (RouteDuplex', optional, prefix, root, string)
import Routing.Duplex.Generic (noArgs, sum)
import Routing.Duplex.Generic.Syntax ((?), (/))

-- MyRouteをGenericのインスタンスにすることがPoint!
derive instance Generic MyRoute _ 

-- ルートパスを宣言的に記述
myroute :: RD.RouteDuplex' MyRoute 
myroute = root $ sum
  { "Posts": "posts" / noArgs 
  , "Post": "posts" / segment
  , "PostComments": "posts" / segment / "comments" ? { sorting: optional <<< sort }
  }

以上を用いると、以下のようにパス文字列とMyRouteの間で相互変換が可能になります。

PSCi> import Routing.Duplex

PSCi> parse myroute "/posts/my-great-post"
Right (Post "my-great-post")

PSCi> print myroute (PostComments "my-great-post" { sorting: Just ASC })
"/posts/my-great-post/comments?sorting=asc"

ちなみに、カスタムのルートコーデックsortを定義していますが、これは以下のようにして作ることができます:

sort :: RouteDuplex' String -> RouteDuplex' Sort
sort = as sortToString sortFromString
  where
  sortToString :: Sort -> String
  sortToString = case _ of
    Asc -> "asc"
    Desc -> "desc"

  sortFromString :: String -> Either String Sort
  sortFromString = case _ of
    "asc" -> Right Asc
    "desc" -> Right Desc
    val -> Left $ "Not a sort: " <> val

まあ詳しいことはrouting-duplexのREADME を見てください。

APIサーバの起動

以上で、サーバを起動する準備ができました!
以下のようにserveにルータ関数とルートコーデックを渡してやれば、直ちに指定したポートでリクエストを待ち受けるサーバを立ち上げることができます:

main :: ServerM
main = do
  serve { port: 8080 } { route: myroute, router }

とてもシンプルですね！

JSONシリアライズ/デシリアライズ

通常、APIサーバとユーザの間では、データをJSONの形でやり取りします。
そのため、サーバサイドではまずユーザからのリクエストデータをデシリアライズし、
またユーザへ返却するレスポンスデータをシリアライズする必要があります。
このセクションでは、HTTPurpleでJSONを扱う方法を説明します。

PureScriptでは、JsonをPureScriptの型がついた値にデコードする際に使えるライブラリとして、

argonaut
codec-argonaut
simple-json
etc

など、いくつかの選択肢があります。わたしはcodec-argonautを好んでよく使用しますが、この辺はわりと好みでどれを使ってもいいと思います。

HTTPurpleのいいところのひとつは、こういったライブラリのうちどれか１つに依存するのではなく、ユーザ側で好きにJSONライブラリを選べるようになっている点です。

HTTPurple側は、JsonDecoder, JsonEncoderというインターフェースを用意しているので、これに合う形で好きなライブラリを使えばいいです。
具体的には、JsonDecoderは以下のようなnewtypeラッパーになっているので、

newtype JsonDecoder = JsonDecoder (String -> Either err json)

好きなライブラリを使って「Stringを受け取ってデコード結果をEitherに包んで返す関数」を作り、それをJsonDecoderコンストラクタに渡してやれば良いことになります。

もしcodec-argonautを使うなら、以下のようにデータ型に応じたコーデックを作ると:

import Codec.Argonaut as CA
import Codec.Argonaut.Record as CAR

-- "/posts"へのPOSTリクエストにおけるリクエストボディとレスポンスの型
type CreatePostReq = 
  { title :: String
  , body :: String
  }

type CreatePostResp = { postId :: PostId }

createPostReq :: CA.JsonCodec CreatePostReq
createPostReq = CA.object "CreatePostReq" $ 
  CAR.record
    { title: CA.string
    , body: CA.string
    }

createPostResp :: CA.JsonCodec CreatePostResp
createPostResp = CA.object "CreatePostResp" $ 
  CAR.record { postId: CA.string }

以下のようにすることでStringとPureScriptの型がついた値の間で相互変換が可能になるので:

import Data.Argonaut.Parser as J
import Data.Codec.Argonaut as CA

decode :: forall a. CA.JsonCodec a -> String -> Either String a 
decode codec = J.jsonParser 
  >=> (CA.decode codec >>> lmap CA.printJsonDecodeError)

encode :: forall a. CA.JsonCodec a -> a -> String
encode codec = CA.encode codec >>> J.stringify

これらを用いて、HTTPurpleのJsonDecoder, JsonEncoderを容易に得ることができます:

decoder :: forall a. CA.JsonCodec a -> HTTpurple.JsonDecoder String a
decoder codec = JsonDecoder (decode codec)

encoder :: forall a. CA.JsonCodec a -> HTTPurple.JsonEncoder a
encoder codec = JsonEncoder (encode codec)

HTTPurpleは、fromJsonという関数を提供しており、これを上記のJsonDecoderとともに用いることで、HTTPurpleのRequestレコードに含まれるRequestBodyから任意の型へデコードが可能になります。また、デコードが失敗しdecoderからLeftが返却された際は空のBadRequestレスポンスを返します。

ただ、この関数はデコード結果をResponseMでなく、ContT Response m jsonという形(mは任意のモナド)で返してくれるので、ルータ関数にするには以下のようにusingContコンビネータを使ってContTを"剥がして"やる必要があります:

import HTTPurple (usingCont)
import HTTPurple.Json (fromJson)

router :: Request MyRoute -> ResponseM
router { req, method, body } -> usingCont $ case method, route of 
  Post, Posts -> do
    { title, body } <- body # fromJson (decoder createPostReq)
    ...
    ok $ toJson (encoder createPostResp) { postId: "my-blog-post-1" }

データベースに接続しよう

バックエンドの開発で避けては通れないのがデータベースとの連携です。次にここを見てみましょう。

早速ですが、PureScriptでデファクトスタンダードなDBライブラリはありません!!!

焦るなかれ、PureScriptではちょちょいとFFIを書くだけで無限にあるnpmパッケージの資産が使えるので、適当なNodeのDBライブラリを使えば何も問題ありません！

今回はpgを使うことにします。

pgでは以下のようにDBに接続してクエリを発行するらしいので:

import pg from 'pg'

// Poolクライアント作って
const pool = new pg.Pool({ host: 'localhost', user: 'database-user' })
const client = await pool.connect()

// SQL投げる
const res = await client.query('SELECT * FROM posts')
console.log(res.rows)

// 最後にPoolクライアントを解放して接続を切る
client.release();
await pool.end()

こんな感じでFFIを書いときます:

import Control.Promise (Promise, toAffE)

foreign import data Pool :: Type

-- pgのindex.d.tsを参考に...
type PoolOptions = 
  { host :: String
  , user :: String
  , ... 
  }

foreign import createPool :: PoolOptions -> Effect Pool 

foreign import data PoolClient :: Type

foreign import connectImpl :: EffectFn1 Pool (Promise PoolClient) 

foreign import release :: PoolClient -> Effect Unit

foreign import endImpl :: EffectFn1 Pool (Promise Unit) 

connect :: Pool -> Aff PoolClient
connect = toAffE <<< runEffectFn1 connectImpl

end :: Pool -> Aff Unit
end = toAffE <<< runEffectFn1 endImpl

toAffE は js-promise-affライブラリで提供されている関数です。
Effect (Promise a)をAff aに変換してくれるもので、Promiseを返すasyncなJS関数へのFFIを書く時に重宝します。

これで、以下のようにしてDBとのコネクションを確立できます:

connectDb :: Aff Unit
connectDb = do 
  pool <- liftEffect $ createPool { "connectionString: "..." }
  conn <- connect pool
  
  ...

  liftEffect $ release conn
  end pool

SQLについては、INSERT INTO posts (title, body) VALUES ($1, $2)のようにパラメータを持ったクエリを投げられるようにしたいので、私はよく以下のように型クラスを作って対応しています:

-- SQLのパラメタに指定できる値
foreign import data SQLValue :: Type 

class ToSQLValue a where
  toSQLValue :: a -> SQLValue

unsafeToSQLValue :: forall a. a -> SQLValue
unsafeToSQLValue = unsafeCoerce

instance ToSQLValue Int where
  toSQLValue = unsafeToSQLValue

instance ToSQLValue String where
  toSQLValue = unsafeToSQLValue

などなど

そして、以下のようにFFIを書いておきます:

foreign import queryImpl :: 
  EffectFn2 
    PoolClient 
    (Array SQLValue) 
    (Promise (Array Foreign))

query :: PoolClient -> Array SQLValue -> Aff (Array Foreign)
query pool = runEffectFn2 queryImpl pool >>> toAffE

これを用いて、以下のようにSQLを発行することができます:

do
  rows <- conn `query` "INSERT INTO posts (title, body) VALUES ($1, $2);"
    [ toSQLValue "my-blog-post-1"
    , toSQLValue "This is my shiny blog post!!"
    ]
  ...

rowsはクエリの実行結果をArray Foreignになっているので、Argonautなりsimple-jsonなり、好きなライブラリを使ってPureScriptの型がついた値にデコードすればいいです。

ぜんぶをまとめる

そんなわけで、ひとまずAPIサーバとして動かすための道具は一通り揃いました！
ここまで説明した内容をいったんまとめてみます。
こちらがPureScriptのコードです:

type PostId = String

data Route
  = Posts 
  | Post PostId

derive instance Eq Route
derive instance Generic Route _ 
derive instance Show Route where
  show = genericShow
  
route :: RouteDuplex' Route 
route = root $ sum 
  { "Posts" : "posts" / noArgs 
  , "Post" : "posts" / segment 
  }

type PostInfo = 
  { id :: PostId
  , title :: String
  , body :: String
  }

postInfo :: CA.JsonCodec PostInfo 
postInfo = CA.object "PostInfo" $
  CAR.record
    { id: CA.string 
    , title: CA.string
    , body: CA.string
    }

-- エンドポイントごとのハンドラの入力・出力のインターフェース
type CreatePostsInput = { title :: String, body :: String }

type CreatePostsOutput = { postId :: PostId }

createPostsInput :: CA.JsonCodec CreatePostInput 
createPostsInput = ...

type ListPostsOutput = { posts :: Array PostInfo }

listPostsOutput = CA.JsonCodec ListPostsOutput 
listPostsOutput = ...

-- サーバを起動
main :: ServerM 
main = do 
  pool <- Pg.createPool { connectionString: "..." }
  conn <- Pg.connect pool
  
  serve { port: 3000 } { route, router: router conn }
  where 
  router conn req@{ route: route', method } = usingCont
    case method, route' of
      Get, Posts -> do
        posts <- listPosts conn
        ok $ toJson (encoder listPostsOutput) { posts }

      Post, Posts -> do 
        inp <- fromJson (decoder createPostReq) req.body
        postId <- createPost conn inp
        ok $ toJson (encoder createPostResp) { postId }

      ... 
      
  listPosts conn = do
    rows <- Pg.query conn "SELECT * FROM posts" []
      
    -- １行ずつdecodeして、失敗したものはWarning出してスルーする
    rows 
      # foldM
          (
            \posts row -> case CA.decode postInfo (unsafeCoerce row) of 
              Right post -> pure $ Array.snoc posts post
              Left err -> 
                Console.warn ("Failed to decode post:" <> CA.printJsonDecodeError err)
                  $> posts
          )
          []

アーキテクチャの改善：モノリシックからレイヤードへ

一応REST APIとして動かすことはできましたが、アプリの構造が完全にモノリシックになっていることに若干の不満を覚えた方も多いと思います。

そこで、このセクションでは、前のセクションまでで作成したアプリの構造を改善してみましょう。

ものの本では「レイヤード・アーキテクチャ」とか「クリーン・アーキテクチャ」などと言われているやつで、DI(依存性の注入)とかリポジトリパターンのような、小難しい専門用語とともに説明されるアレです。

業務の概念を型で表現しよう

ここまででもなんとなく説明の流れの都合でそれっぽい型が出てきていましたが、改めて定義しておきます。
関数型プログラミングは型を決めることから始まるのだし、型をきちんと考えることが設計になります。

type PostId = String

type PostInfo = 
  { id :: PostId
  , title :: String
  , body :: String
  }

postInfo :: CA.JsonCodec PostInfo
postInfo = ...

次に、これらの型を用いて各エンドポイントのハンドラの処理を記述するためのDSLを構築します。

業務を記述するためのDSLをつくろう

少しの思想

前のセクションでのモノリシックなアーキテクチャでは、HTTPurpleのRequest/Responseを直接読み書きしていたり、pgを使ってダイレクトにDBにアクセスしていたりするのでイケていないです。

より正確にいうと、ビジネスロジックがEffectの中で書かれていることが問題です。なぜEffectの中にいるのが問題なのか?

業務のロジックが副作用を持った関数で書かれていることが問題なのではありません。¹

実用的な規模のアプリのロジックが副作用を一切伴わないことなどありえないので、当然業務のロジックは作用を伴う関数で記述せざるを得ません。そして多くの場合、業務を正確に語るうえでは、「作用の意味」もまた大事な業務の一部ではないでしょうか？

であるならば、業務に忠実に設計するためには「概念を型で正確に表現する」だけでは不十分で、「業務において発生する作用も正確に表現する」必要があるのです！

そう考えた時、作用に対するラベルとしてのEffectとは、（値に対するラベルとしての）型でいえばanyみたいなもので、業務を記述する上で作用については設計を諦めることを意味します。

我々としては、「作用がなんであるか」をも含めて業務を正確に記述できるようなDSL(ドメイン固有言語)を作って、その中で業務のロジックを記述したいです²。

ここに、それをするための非常に洗練されたアイデアがあります。
そう、代数的作用(Algebraic Effects) です！

Algebraic Effectsとは！？

PureScriptは、言語として代数的作用を第一級サポートしているわけではありませんが、　row polymorphismによってライブラリレベルで代数的作用を実現した、runというライブラリがあります。

runは, Runという型を提供していて、これが代数的作用モナドです。
作用を持った関数は、Effect aではなくRun r aという型を返す関数として実装します。

気になるのはRun r a における rですが、これこそが作用に対するラベルです。

具体例として、「ロギング」という作用をRunの文脈でどう扱うかを示します。

これらのコードは初見では難しく見えると思いますが、大部分はボイラープレートなので、慣れないうちはあまり深く考えずに丸写しでも大丈夫です。何度も書いているうちに、いずれ理解る時が来ます（きっと）

まず、以下のように型パラメタを１つ取るLogと言う型を作ります。
そして、この型のコンストラクタに、ロギング作用を発生させるプリミティブな操作（のシグネチャ）を列挙します。
たとえば、「ログレベルと文字列を受け取る。作用の結果として返す値はない。」という操作をプリミティブと考えるならば、こんな感じになります:

data LogLevel = Debug | Info | Warn | Error

data Log a = Log LogLevel String a   -- LogLevelと文字列を受け取る。返す値はない。

derive instance Functor Log

LogがFunctorのインスタンスになっていることが肝心です。
あとは、(log :: Log)とかProxy :: Proxy "log"みたいなのをよく書くことになるので、以下のようなショートハンドを作っておきます:

type LOG r = (log :: Log | r)

_log :: Proxy "log"
_log = Proxy

後で見るように、このLOGという識別子が、ロギング作用に対するラベルになります。

以上の準備をすることで、この作用を生じさせるための関数を以下のように作ることができます:

import Type.Row (type (+))

log :: forall r. LogLevel -> String -> Run (LOG + r) Unit 
log level msg = Run.lift _log $ Log level msg unit

-- 以下は、プリミティブなlogを使って定義される便利関数

debug :: forall r. String -> Run (LOG + r) Unit
debug = log Debug

info :: forall r. String -> Run (LOG + r) Unit
info = log Info

warn :: forall r. String -> Run (LOG + r) Unit
warn = log Warn

error :: forall r. String -> Run (LOG + r) Unit
error = log Error

log関数のシグネチャに注目してください。戻り値の型がforall r. Run (LOG + r) Unitとなっています。
これは、logは作用を伴う関数で、特にLOGというラベルで表現されるロギングの作用を伴うことを表しています。
また、forall rがポイントで、これによってlogは他のラベルを持つ作用関数といっしょに使われることが可能になります。

たとえば、「データベースアクセス」の作用をDBというラベルで表示したとして、以下のような関数が定義されていた時:

DB.purs

data Db a 
  = InsertPost String String (Array PostId -> a) -- titleとbodyを受けとる。作用の結果として postId を返す
  | ListPosts (Array PostInfo -> a) -- 作用の結果として, PostInfoの配列を返す

derive instance Functor Db 

type DB r = (db :: DB | r)

_db :: Proxy "db"
_db = Proxy

insertPost :: forall r. String -> String -> Run (DB + r) PostId
insertPost title body = Run.lift _db $ InsertPost title body identity

listPosts :: forall r. Run (DB + r) (Array PostInfo)
listPosts = Run.lift _db $ ListPosts identity

以下のようにlogとinsertPostを同時に使用することができます:

App.purs

f :: forall r. Run (LOG + DB + r) Unit
f = do
  postId <- insertPost 
    "My Blog Post 1"
    "This is my really shiny blog post!"

  info "1 row inserted"

fの型に注目して下さい. Run (DB + LOG + r) Unitとなっています。
これは、fの中でLOG作用の関数とDB作用の関数を両方とも使っていることを意味します。
このように、異なるラベルに属する作用を合わせて使うと、個々のラベルをあわせたシグネチャになるというのが、代数的作用の特徴の１つです。

ちなみに、Dbのコンストラクタ(InsertPost, ListPosts)における最後の引数の型が(PostId -> a)のような関数型になっていますが、これはInsertPostプリミティブのシグネチャとして「作用の結果としてPostIdの値を返す」としたいためです。こうすることで、上の例のようにinsertPost関数からの戻り値を変数に束縛することができるようになります。

ここで１つ気づいていただきたいのが、ここまでで作用のシグネチャだけを提示していて、それが具体的にどのような計算作用をもたらすのかは一切語っていないことです。

ロギング作用でいえば、Logというアクションが「ログレベルとログに吐く文言を受け取り、結果を何も返さない」ことだけを規定していて、具体的なログ出力のメカニズム（stdoutに表示するとか、ファイルに出力するとか...)については何も決めていないのです。

代数的作用では、そのような「作用のもたらす効果」をプログラマが自由に実装できます。
runライブラリでは、これを「作用の解釈(interpret)」とよんでいますが、「作用のハンドル」といわれることも多く、代数的作用が別名「作用ハンドラ(Effect Handlers)」と呼ばれる所以になっています。

runでは、以下のように、まず作用のシグネチャを与えているfunctor (ロギング作用でいうところのLogfunctor)の値を受けとり、Run r aの計算として返却する関数を用いて、Runエフェクトを解釈することができます:

import Run as Run

interpret :: forall a r. (Log ~> Run r) -> Run (LOG + r) a -> Run r a
interpret handler = Run.interpret (Run.on _log handler Run.send)

~>という意味深な矢印がありますが、これは単にforall a. f a -> g aのことを f ~> gと書けるという省略記法です³。

最後の戻り値の型における作用ラベルの中から、ロギング作用のラベルLOGが消えていることが、ロギング作用が解釈されたことを意味しています。

interpret関数に渡すべきものはLog ~> Run rという形をしていますが、これこそがログ出力をどのように行うかを決める実装です。

たとえば、最もシンプルにJSネイティブのconsole.logを使って標準出力に吐くのでよいのであれば、以下のように実装できましょう:

import Effect.Console as Console
import Run (EFFECT)
import Run as Run

jsConsoleHandler :: forall r. LogLevel -> Log ~> Run (EFFECT + r)
jsConsoleHandler minLevel = case _ of 
  Log level msg next -> do
    -- level が minLevel に満たない場合はスキップする
    when (level >= minLevel) do 
      Run.liftEffect $ Console.log msg
    pure next

EFFECTラベルは、runで定義済みの作用ラベルで、Effectモナドによる任意の計算作用をRunモナドへ持ち上げた際に付されるラベルです。他にも、AFFという非同期作用や, READER, WRITER, STATE, EXCEPT等、transformersライブラリで定義されている諸々のモナド変換子と互換性のある作用が定義されています。

このような感じで、すべてのRun作用を解釈して、最終的に作用のラベルが(EFFECT + AFF) だけになったら、最後に runBaseAff'関数を用いて　Affモナドに解釈することができます。

以下は、Run (DB + LOG)モナドをAffに解釈する例です:

import MyBlog.API.Effect.Log as Log
import MyBlog.API.Effect.DB as DB
import Run (Run, EFFECT, AFF)
import Run as Run

runEffect :: forall a. Run (DB + LOG) a -> Aff a 
runEffect m = m 
  # Log.interpret jsConsoleHandler
  # DB.interpret nodePgHandler
  # Run.runBaseAff'

代数的作用を使うメリット

以上のように、代数的作用を使うことで、バックエンドアプリを書くうえで様々な利点があることがわかりました:

作用のシグネチャをプログラムすることで、業務における作用の意味が明文化される
業務のロジックを記述するための「ドメイン特化言語(DSL)」を構築できる。このDSLを使えば、作用の具体的な効果に言及することなく、インターフェースレベルでロジックを記述できる
作用のシグネチャと作用ハンドラが分離されるので、自然とレイヤーが分かれた構造になる

加えて、作用ハンドラはいくつ書いてもよいので、たとえばDB作用のハンドラで実際にDBに接続せずDBをモックしたハンドラを書いて、テストと実環境でハンドラを差し替えたりすることも容易に可能なので、テスタビリティも向上するというボーナス利点もあります:

interpret :: forall a. (Db ~> Run r) -> Run (DB + r) a -> Run r a 
interpret handler = Run.interpret (Run.on _db handler Run.send)

-- 実環境用。Pgを使ってDBに接続する
nodePgHandler :: forall r. Pg.PoolClient -> Db ~> Run (AFF + EFFECT + r)
nodePgHandler conn = case _ of 
  InsertPost title body reply -> do 
    rows <- Run.liftAff $ 
      Pg.query conn 
        """
        INSERT INTO posts (title, body) VALUES ($1, $2);
        """
        [toSQLValue title
        , toSQLValue body
        ]

    case Array.head rows of 
      Nothing -> Run.liftEffect $ Exn.error "Failed to execute query!"
      Just fgn -> do 
        -- readString :: Foreign -> Run _ String はどっかで適用に実装しているとする
        postId <- readString fgn   
        pure (reply postId)

  ListPosts reply -> ...

-- テスト用。モックを返す。
mockDbHandler :: forall r. Db ~> Run r
mockDbHandler = case _ of 
  InsertPost _ _ reply -> do 
    pure $ reply "my-blog-post-1"

  ListPosts reply -> do 
    pure $ reply 
      [ { title: "My Blog Post 1", body: "This is my really shiny blog post!" }
      , { title: "My Blog Post 2", body: "This is yet another great post!" }
      ]

以上のことを用いて、コードブロックを抽象度のレベルごとに分離して、それっぽい感じで実装したものがこちらになります:

記事で説明していないポイントもいくつかあるので、いくつか補足の説明をしておきます。

まず、ディレクトリの構成は以下のようになっています:

src
  |_ MyBlog/Backend/
     |_ API/
     |  |_ Effect/             --- DSLの定義。Runを使ったボイラープレートの集まり
     |  |_ Server/
     |  |  |_ Endpoint.purs    --- エンドポイント(ルート)の定義
     |  |  |_ CreatePost.purs  --- エンドポイントのハンドラの処理内容。
     |  |  |_ ListPosts.purs   --- 同上
     |  |  |_ Utils.purs       --- エラーの定義など
     |  |_ Server.purs         --- Server/以下のサブモジュールを使って、HTTPurpleのルータ関数を定義
     |
     |_ Foreign/ 　　　　　　　　 --- npmライブラリへのバインディング
     |  |_ Pg.purs, Pg.js 
     |  |_ UUID.purs, uud.js
     |  |_ Dayjs.purs, Dayjs.js
     |
     |_ Types.purs             --- PostIdやPostInfoなどコアなデータ型の定義 
     |_ API.purs               --- 各Effectのインタープリタを定義して、ルータ関数を実行
     |_ DB.purs                --- Pgを使った、DB周りの関数たち
     |_ Main.purs              --- エントリポイント

この他にも、ルートの型をMyRouteからEndpointに改名しているなど、記事中の実装に対して細かい修正をしている箇所がありますが、そのへんはまあ雰囲気で読んで下さい。

エラーのハンドリングは、シンプルにRunのEXCEPT作用を使っています。
エラータイプは、普通のJSのErrorにしていますが、アプリの規模が大きければオリジナルのエラーの型を定義してもいいでしょう。大事なのはエラーをトラックできるように、どんな異常が起こったのかがわかりやすい設計にすることだと思います。
実際に異常を検知してエラーを投げている箇所は、API.pursのnodePgHandler内にあります。

コアなTypes.pursがMain.pursと同階層にいるのは、DB.pursからもPostInfo等の型を参照しているため（DBからとってきたレコードをPostInfoにデコードして返しているため）です。
これは微妙といえば微妙で、コアなデータ型とは別にテーブルスキーマを下にしたPostModelなどの型を作って、DB絡みの関数からの戻り値はそちらにしてもいいでしょう。

その場合、PostModelからPostInfoへの面倒な変換をすることにはなりますが、私としてはDBのテーブルスキーマとコアなデータ型は必ずしも一致しないものだと考えているので、致し方ないと思います。

まとめ

そんなわけで、当初の想定とは裏腹にかなり長大な記事になってしまいました！
HTTPurpleについて説明するだけの、もうちょいサクっと読める記事のはずだったんですけどね...
ここまで根気強くお読みくださった方はありがとうございました＆お疲れ様でした。

記事の前半では、HTTPurpleを用いてサーバサイドアプリ（REST API）を書く方法について説明し、後半ではモノリシックなアプリだったのを代数的作用を用いていい感じに分離する方法を詳しく述べました。

最初にも述べた通り、この記事で述べた方法は、わたしが普段サーバサイドのアプリやCLIアプリを書いてる際の方法論ほぼそのままになります。
ですので、それなりに実用的な規模にもスケールすると思いますし、単なるHelloWorldよりは実戦的な内容になっているかと思います。

本文中ではエラーハンドリングについてあまり詳しく述べていませんが、本文からリンクしているGitHubのコードベース内では、シンプルにRunのEXCEPT作用でエラーを扱っているので参考にしていただければと思います。

この記事でカバーしきれていないトピックとして、HTTPurpleのミドルウェアがあります。
ミドルウェアを用いると、nodeのexpressのミドルウェアがそのまま使えたり、Requestレコードを拡張してカスタムのフィールドを生やしたりすることができます。
この機能は、たとえば認証を通してユーザデータをRequestに持たせたりということに応用できます。
詳しいことはHTTPurpleのドキュメントを参照してください。

また、Runによる代数的作用は非常に万能のように思えますが、制限もあります。
たとえば、Runモナドの計算から別のRunモナドの計算をForkして並列処理したりすることは難しいです。
これは、Runが高階エフェクトのライブラリではないからとかなんとか(このあたりあまり詳しくないのでよくわかりません！)

ともかく、この記事がPureScriptでサーバサイドのアプリも書きたい！という方のための一助になれば幸いです。

Appendix: 他のHTTPサーバライブラリとの比較

PureScriptでREST APIを書くための選択肢としては、HTTPurple以外では以下のものがあります

payload
purescript-express
自分でバインディングを書く

Payloadは、APIの仕様(エンドポイントごとのリクエストパラメータやレスポンスの型等)を型レベルで記述するライブラリです。
HaskellのServantを触ったことがある方は、あんな感じをイメージするとよいそうな。

APIスペックとハンドラ(リクエストからレスポンスを計算する関数)のシグネチャが整合していることをコンパイラがチェックしてくれる
型レベルメタプログラミングでAPIを呼び出すためのクライアントコードが自動的に生成される

など、httpurpleよりも型システムを酷使しているところはウケる人にはウケるでしょう（わたしも一時期はPayloadでよくREST APIを書いてました）。

欠点としては、

ハンドラの型がAffに固定されていて、独自のモナドを使いたい場合はやや工夫が必要
リクエスト/レスポンスのJSONとPureSriptのデータ型の値の間の相互変換がsimple-jsonに依存している
IDEが~~ヘボくて~~レコードのプロパティをサジェストしてくれないので、Payloadの吐くクライアントコードは使いやすいとはいいがたい

などですかね。まあ３つめはPayloadというよりPureScriptの問題ですが(爆)

あとは、最近のコンパイラに合わせてメンテナンスはされているものの、作者の方が忙しいらしくあまり精力的に機能追加はされてない模様。

purescript-expressは、わたしが使ったことないのでなんとも言えないです。情報求む！

最後に「自分でバインディング書く」ですが、これはbun使いたいとかの事情があればやる必要がありそう。
今のところ私はnodeで満足しているので手出したことはないです。

ということで、最近はお手軽なhttpurpleに一旦落ち着いています！

「(PureScriptのような)純粋関数型言語は副作用を排除しようとする」というのは、関数型言語に対する非常によくある誤解です。作用を排除するのではなく、「純粋な計算と作用を伴う計算を型の上で区別しよう」というのが純粋関数型言語の原理です。 ↩
ものの本でユビキタス言語とかいわれるやつ ↩
圏論における自然変換(natural transformations)の記法を模したもの ↩