16
3

More than 3 years have passed since last update.

Haskell の GraphQL ライブラリ Morpheus を使ってみた

Last updated at Posted at 2021-08-09

Haskell で GraphQL の API を構築できるライブラリ Morpheus GraphQL を使ってみました。
README の Getting Started を参考に、プロジェクト作成から GraphiQL でクエリを投げて動作確認するところまで行いました。

最終的に出来上がったコードは以下のリポジトリにまとめてあります。

プロジェクト作成

READMEに従い、Stackを使って開発をしていきます。
stack new コマンドでプロジェクトを作成します。

$ stack new morpheus-sample

使用するパッケージとバージョンの指定

package.yaml ファイルの dependenciesmorpheus-graphql を追加します。

package.yaml
dependencies:
  - base >= 4.7 && < 5
  - morpheus-graphql

さらに、stack.yaml ファイルを以下のように変更します。

stack.yaml
resolver: lts-16.2
packages:
  - .
extra-deps:
  - morpheus-graphql-0.17.0
  - morpheus-graphql-app-0.17.0
  - morpheus-graphql-core-0.17.0

ここで一旦ビルドします。stack build でビルドしてみましょう。

$ stack build
...
Registering library for morpheus-sample-0.1.0.0..
Completed 27 action(s). 

よさそうです。

スキーマの定義

スキーマの定義方法は2つあります。
GraphQLの記法で定義を書いたファイルを読み込む方法と、Haskellの型として定義する方法です。
せっかくHaskellで書いているので、今回は型で定義してみました。

Main.hs
data Query m = Query
  { user :: UserArgs -> m User
  } deriving (Generic, GQLType)

data User = User
  { name :: Text
  , email :: Text
  } deriving (Generic, GQLType)

data UserArgs = UserArgs
  { name :: Text
  } deriving (Generic, GQLType)

ユーザーは名前(name)とメールアドレス(email)を持ち、名前で検索できる、という感じです。

データベースもどきの準備

データベースを用意する代わりに、ユーザーのリストと検索用の関数を作りました。

Main.hs
userDB :: [User]
userDB = 
  [ User "Thoru" "thoru@maidragon.com"
  , User "Kanna" "kanna@maidragon.com"
  , User "Fafnir" "fafnir@maidragon.com"
  , User "Lucoa" "lucoa@maidragon.com"
  , User "Elma" "elma@maidragon.com"
  , User "Ilulu" "ilulu@maidragon.com"
  ]

findUserByName :: Text -> Maybe User
findUserByName name = find (\(User name' _) -> name == name') userDB

次はこれを元にリゾルバを作成していきます。

リゾルバの実装

ユーザーのリゾルバ resolveUser を実装をします。
resolveUser の型 UserArgs -> ResolverQ e IO User はスキーマで定義した user :: UserArgs -> m User に対応しています。

Main.hs
resolveUser :: UserArgs -> ResolverQ e IO User
resolveUser (UserArgs name) = maybe (fail "User not found.") return $ findUserByName name

そして、以下のように rootResolver を作成し、それを interpreter に渡すことで、gqlApi が完成しました。
(今回、Mutation と Subscription は実装しないので、Undefined を指定しています。)

Main.hs
rootResolver :: RootResolver IO () Query Undefined Undefined
rootResolver =
  RootResolver
    { queryResolver = Query {user = resolveUser}
    , mutationResolver = Undefined
    , subscriptionResolver = Undefined
    }

gqlApi :: ByteString -> IO ByteString
gqlApi = interpreter rootResolver

gqlApi にクエリを渡すと、リゾルバを通して適切なデータが返ってきます。

サーバーの実装

Morpheus の README では scotty でサーバーを実装していますが、今回は waiwarp を使ってサーバーを実装してみました。リクエストのBodyを gqlApi に渡し、実行結果を返すようにしています。

Main.hs
app :: Application
app request respond = do
  body <- getRequestBodyChunk request
  respond . responseLBS status200 [("Content-Type", "text/plain")] <=< gqlApi $ B.fromStrict body

main :: IO ()
main = do
  putStrLn $ "http://localhost:3000/"
  run 3000 app

これで完成です!

動作確認

stack exec でサーバーを起動します。

$ stack exec morpheus-sample-exe
http://localhost:3000/

GraphiQLでクエリを投げてみます。

graphiql.PNG

正しくデータが取得できました。

おまけ

上記コードと言語拡張やインポート等を含めた完成版のファイルを以下に掲載します。

Main.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}

module Main where

import Control.Monad
import Data.Morpheus
import Data.Morpheus.Types
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import Data.Text (Text)
import qualified Data.Text as T
import Data.List
import GHC.Generics
import Network.Wai
import Network.HTTP.Types (status200)
import Network.Wai.Handler.Warp (run)

data Query m = Query
  { user :: UserArgs -> m User
  } deriving (Generic, GQLType)

data User = User
  { name :: Text
  , email :: Text
  } deriving (Generic, GQLType)

data UserArgs = UserArgs
  { name :: Text
  } deriving (Generic, GQLType)

userDB :: [User]
userDB = 
  [ User "Thoru" "thoru@maidragon.com"
  , User "Kanna" "kanna@maidragon.com"
  , User "Fafnir" "fafnir@maidragon.com"
  , User "Lucoa" "lucoa@maidragon.com"
  , User "Elma" "elma@maidragon.com"
  , User "Ilulu" "ilulu@maidragon.com"
  ]

findUserByName :: Text -> Maybe User
findUserByName name = find (\(User name' _) -> name == name') userDB

resolveUser :: UserArgs -> ResolverQ e IO User
resolveUser (UserArgs name) = maybe (fail "User not found.") return $ findUserByName name

rootResolver :: RootResolver IO () Query Undefined Undefined
rootResolver =
  RootResolver
    { queryResolver = Query {user = resolveUser}
    , mutationResolver = Undefined
    , subscriptionResolver = Undefined
    }

gqlApi :: ByteString -> IO ByteString
gqlApi = interpreter rootResolver

app :: Application
app request respond = do
  body <- getRequestBodyChunk request
  respond . responseLBS status200 [("Content-Type", "text/plain")] <=< gqlApi $ B.fromStrict body

main :: IO ()
main = do
  putStrLn $ "http://localhost:3000/"
  run 3000 app
16
3
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
16
3