HaskellでインメモリなTODO APIアプリを作る

Haskellの練習がてらインメモリDBなTODO APIアプリを作ってみましたー

• haskell-sample/Main.hs

全体的にはこんな感じです

• ベースの部分はWaiとWarpを利用
• ルーティングなどは自作（正規表現とか使わずパーサコンビネータで実装）
• データはメモリ上に保持（IORef）
• CRUDなAPI

あんまりHaskellでTODOアプリ作っている記事が見当たらなかったので、今回は備忘録も兼ねてどうやって作ったかを書いていきます。

アプリサーバを起動する

waiとwarpを使ってWebサーバを起動します。run関数でアプリサーバを起動できます

main :: IO ()
main = do
  tasks <- defaultTasks
  run 8080 (server tasks)

defaultTasksはデフォルトのDB情報（タスク）が入ったIORefを返します

defaultTasks :: IO (IORef DB)
defaultTasks = newIORef $ DB{
  dbRecords = fromList [
    (1, Task{taskId = 1, taskTitle="foo", taskDescription="bar"}),
    (2, Task{taskId = 2, taskTitle="hoge", taskDescription="fuga"})
  ],
  dbNextTaskId = 3
  }

dbNextTaskIdには自動採番するための次のシーケンス番号、dbRecordsにはタスクレコードがData.Map型で入ってます。

これをリクエストハンドラとなる関数に渡すことでリクエスト間で状態を保持できます。

runの第三引数がリクエストハンドラにあたる部分で、型はApplicationになります。Applicationは Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived の型シノニムで、リクエストを受け取ってレスポンスを生成してそれを(Response -> IO ResponseReceived) の関数に食わせて IO ResponseReceived を返します。

ルーティング

parsecでルーティングを書いています。

まずリクエスト（パスやメソッド）に応じてルーティングを変えていく必要があるので、リクエストを引数として Parser Handler を生成します。 HandlerはRequest -> IORef DB -> IO Responseの型シノニムです。

getHandler :: Handler
getHandler req = case parse (parseRoute req) "" (CBS.decode $ BS.unpack path) of
  Left err -> error $ "ParserError"
  Right ls -> ls req
  where path = rawPathInfo req

ルーティングとしては以下を想定しています

• GET /
• GET /posts
• GET /posts/:id
• POST /posts
• PATCH /posts/:id
• DELETE /posts/:id

実装はこんな感じです

parseRoute :: Request -> Parser Handler
parseRoute req = (try $ parseTop req) TP.<|> (try $ parseTask req)

parseTask :: Request -> Parser Handler
parseTask req = do
  let method = requestMethod req
  string "/posts"
  eof *> return (case method of
    "GET" -> indexTask
    "POST" -> addTask
    _ -> notFound) TP.<|> do
    char '/'
    postId <- TP.many1 digit
    let postId' = read postId :: Int
    return (case method of
        "GET" -> showTask postId'
        "PATCH" -> updateTask postId'
        "DELETE" -> deleteTask postId'
        _ -> notFound
      )

CRUD操作

Read系操作

readIORefでIORefの中身のDBが取ってこれるのでそのDBからさらに項目を抜き出してAesonでJSONを返します

indexTask :: Handler
indexTask req ref = do
  db <- readIORef ref
  return (responseLBS status200 [] $ JSON.encode $ elems $ dbRecords db)

ここのrefは最初に作成したIORef DBで、JSON.encodeでJSONを作ってレスポンスを返しています。

GET /posts/:idの場合は、DBのdbRecordsからタスクIDでlookupしたデータをJSONで返します。

showTask :: Int -> Handler
showTask taskId req ref = do
  db <- readIORef ref
  let task = M.lookup taskId (dbRecords db)
  if isNothing task then return notFoundResponse else return (responseLBS status200 [] $ JSON.encode task)

（今思うとわざわざData.Mapにしなくてもguardで絞り込んだりfindすれば良かったのかもしれない）

Write系操作

新規追加のタスクはこんな感じで実装しています。

addTask :: Request -> IORef DB -> IO Response
addTask req ref = do
  db <- readIORef ref
  let nid = dbNextTaskId db
  writeIORef ref $ dbAddTask req db
  let task = M.lookup nid (dbRecords db)
  return (responseLBS status200 [] $ JSON.encode task)

dbAddTask :: Request -> DB -> DB
dbAddTask req db = do
  DB{
    dbRecords = M.insert taskId newTask (dbRecords db),
    dbNextTaskId = taskId + 1
  } where
    reqTask = buildTask req
    taskId = dbNextTaskId db
    newTask = Task{
      taskId = taskId,
      taskTitle = taskTitle reqTask,
      taskDescription = taskDescription reqTask
    }

リクエストからタスクデータを生成してData.Mapに追加したDBを返し、writeIORefでデータを書き換えます。

更新/削除も同様にIORef DBからデータを取得して更新してwriteIORefでデータを書き換えています。