purs --version
0.12.5
前置き
NodeAPIのドキュメント (https://nodejs.org/api/readline.html) を参考にしつつ、Readlineの一部の機能をPureScriptで動かしてみます。
PureScriptからNodeのAPIを使うためのラッパーは既に用意されています。
(レポジトリ: https://github.com/purescript-node)
この中のpurescript-node-readlineというパッケージを使ってみます。
目標は以下の処理をPureScriptで書くことです。
(NodeAPIのドキュメントから引用しています。)
const readline = require('readline');
const rl = readline.createInterface({
input: process.stdin,
output: process.stdout
});
rl.question('What do you think of Node.js? ', (answer) => {
// TODO: Log the answer in a database
console.log(`Thank you for your valuable feedback: ${answer}`);
rl.close();
});
Effect環境で使ってみる
インターフェースの作成からです。
stdin, stdoutを指定してくれるcreateConsoleInterfaceがあるようなのでこれを使います。
createConsoleInterfaceの型を見てみます。
createConsoleInterface :: Completer -> Effect Interface
引数にはnoCompletion :: Completerを指定しておきます。
次にquestionの型を見てみます。
question :: String -> (String -> Effect Unit) -> Interface -> Effect Unit
これに関してはPursuitのドキュメントを見るよりも、NodeAPIのドキュメントを見たほうが分かりやすいです。
https://nodejs.org/api/readline.html#readline_rl_question_query_callback
最初のStringがQuery, String -> Effect Unitがcallbackに相当するようです。
コールバック関数を書いてみます。
callback :: String -> Effect Unit
callback answer = log $ "Thank you for your valuable feedback: " <> answer
というわけでPureScriptで一連のコードを書いてみました。
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log)
import Node.ReadLine ( createConsoleInterface
, noCompletion, question, close)
main :: Effect Unit
main = do
interface <- createConsoleInterface noCompletion
question "What do you think of PureScript? " callback interface
close interface
where
callback :: String -> Effect Unit
callback answer = log $ "Thank you for your valuable feedback: " <> answer
実行してみます。
実行結果
* Build successful.
What do you think of PureScript?
ここで終了です。質問しておきながらユーザーの回答を待たないプログラムの完成です。
原因を探る
先ほどのコードではcallbackの外でcloseを実行してしまっています。
したがって、コールバック関数が呼び出された後に閉じるようにしなければなりません。
その場しのぎで解決してみます。
main :: Effect Unit
main = do
interface <- createConsoleInterface noCompletion
question "What do you think of PureScript? " (callback interface) interface
where
callback :: Interface -> String -> Effect Unit
callback interface answer = do
log $ "Thank you for your valuable feedback: " <> answer
close interface
close interfaceをコールバックの中に無理矢理押し込んでみました。
こうすれば一応動きますが、ネストする必要があります。
例えばもう一つ質問を追加してみましょう。
main :: Effect Unit
main = do
interface <- createConsoleInterface noCompletion
question "What do you think of PureScript? " (callback interface) interface
where
callback :: Interface -> String -> Effect Unit
callback interface answer = do
log $ "Thank you for your valuable feedback: " <> answer
question "Do you like sushi? " (callback2 interface) interface
where
callback2 :: Interface -> String -> Effect Unit
callback2 interface answer = do
log $ "Your answer: " <> answer
close interface
ちょっと辛いです。
綺麗な解決方法: Aff
このように非同期処理が絡んでくると、Effectの文脈で処理をするのに限界が来るようです。
そこで、Affを使います。purescript-affパッケージが必要です。
Affは非同期な環境でエラーを扱ったり、不必要になった処理をキャンセルしたりと高機能なようです。
makeAffを使って作り、それをrunAff_で実行できます。
makeAff :: forall a. ((Either Error a -> Effect Unit) -> Effect Canceler) -> Aff a
runAff_ :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect Unit
例外処理はEither Error aで行っていますね。
今回はキャンセラーは必要が無いのでnonCanceler :: Cancelerが使えそうです。
makeAff
makeAff :: forall a. ((Either Error a -> Effect Unit) -> Effect Canceler) -> Aff a
今はEffect Cancelerが無視できるとして、Either Error a → Effect Unitだけ見てみます。
これは実行された時にどのように処理をするのかを記述するようです。
ECMAScriptのPromiseで言う所のrejectとresolveですね。
とりあえず何もしないものを作ってみます。
aff :: Aff String
aff = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go _ = pure nonCanceler
questionのAffラッパー
上記の実装ではコンパイルは通りますが、questionを入れる余地がありません。
do構文で書き換えてquestionを入れてみます。
aff :: Aff String
aff = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go callback = do
question message callback' interface
pure nonCanceler
ここで、goの引数callbackの型とquestionで必要なcallback'の型は異なる点に注意です。
callback :: Either Error String -> Effect Unit
callback' :: String -> Effect Unit
callbackを使ってcallback'を書いてみます。今回は全て成功扱いで良いでしょう。
callback' str = callback (Right str)
-- = callback <<< Right
最後に、残った未知の引数を追加してあげましょう。
aff :: Aff String
aff = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go callback = do
question message callback' interface
pure nonCanceler
where
interface :: Interface
interface = --
message = "What do you think of PureScript?"
callback' = callback <<< Right
where以下を一般化します。
aff :: String -> Interface -> Aff String
aff message interface = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go callback = do
question message (callback <<< Right) interface
pure nonCanceler
今回はこれをquestionAsyncと名付けてみます。
ちなみに、$>を使うと以下のように書くこともできます。
questionAsync :: String -> Interface -> Aff String
questionAsync message interface = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go callback = question message (callback <<< Right) interface $> nonCanceler
runAff_
runAff_ :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect Unit
作ったAffを解決します。
ここでもやはりEitherでreject, resolve相当の処理が必要です。
Affを走らせる
main :: Effect Unit
main = do
interface <- createConsoleInterface noCompletion
runAff_ (close' interface) (question' interface)
where
close' :: forall a. Interface -> Either Error a -> Effect Unit
close' interface = (\_ -> close interface)
question' :: Interface -> Aff Unit
question' interface = pure unit
上記コードで一応コンパイルは通ります。
question'に処理を書いてみます。
question' :: Interface -> Aff Unit
question' interface = do
answer <- questionAsync message1 interface
logAnswer answer
where
logAnswer :: String -> Aff Unit
logAnswer _ = pure unit
message1 = "What do you think of PureScript? "
message2 = "Thank you for your valuable feedback: "
先ほどのquestionAsyncでAffを作り、ユーザーからの回答をanswerに格納します。
後はそれをもとに何かしらをlogして終了です。
しかし、Aff環境下なのでlogAnswer :: String -> Aff Unitでなければなりません。
(do記法はbindの糖衣構文)
普段使っているのはlog :: String -> Effect UnitなのでEffectをAffに持ち上げる必要があります。
PureScript界のグーグルことPursuitでググりましょう。
https://pursuit.purescript.org/search?q=Effect+a+-%3E+Aff+a
liftEffect :: forall a m. MonadEffect m => Effect a -> m a
これでEffect aをAff aにできます。
今回のコード
module Main where
import Prelude
import Data.Either (Either(..))
import Effect (Effect)
import Effect.Aff (Aff, Canceler, Error, makeAff, nonCanceler, runAff_)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Node.ReadLine (Interface, close, createConsoleInterface, noCompletion, question)
main :: Effect Unit
main = do
interface <- createConsoleInterface noCompletion
runAff_ (close' interface) (question' interface)
where
close' :: forall a. Interface -> Either Error a -> Effect Unit
close' interface = (\_ -> close interface)
question' :: Interface -> Aff Unit
question' interface = do
answer <- questionAsync message1 interface
liftEffect <<< log $ message2 <> answer
where
message1 = "What do you think of PureScript? "
message2 = "Thank you for your valuable feedback: "
questionAsync :: String -> Interface -> Aff String
questionAsync message interface = makeAff go
where
go :: (Either Error String -> Effect Unit) -> Effect Canceler
go callback = question message (callback <<< Right) interface $> nonCanceler
以下おまけです。
2回質問する
question' :: Interface -> Aff Unit
question' interface = do
answer <- questionAsync message1 interface
liftEffect <<< log $ message2 <> answer
answer2 <- questionAsync message3 interface
liftEffect <<< log $ message4 <> answer2
where
message1 = "What do you think of PureScript? "
message2 = "Thank you for your valuable feedback: "
message3 = "Do you like sushi? "
message4 = "Your answer: "
ネストが不要になっています。
質問とその反応をセットにする
質疑応答をセットにしてみます。Affの文脈ですね。
questionAndAnswerAsync :: { question :: String
, reaction :: String -> String }
-> Interface -> Aff String
questionAndAnswerAsync { question , reaction } interface = do
answer <- questionAsync question interface
liftEffect <<< log <<< reaction $ answer
pure answer
後からでもanswerを取得できるようにしてみます。
question' :: Interface -> Aff Unit
question' interface = do
a1 <- questionAndAnswerAsync { question : message1
, reaction : (<>) message2 }
interface
a2 <- questionAndAnswerAsync { question : message3
, reaction : (<>) message4 }
interface
liftEffect <<< log $ "Answers: " <> a1 <> ", " <> a2 <> "\nThanks!"
where
message1 = "What do you think of PureScript? "
message2 = "Thank you for your valuable feedback: "
message3 = "Do you like sushi? "
message4 = "Your answer: "
参考
- PureScriptで標準入力
- AffですべてのPromises/Generatorsを過去にする／そして何故我々は作用をモナドで抽象化すべきなのか
-
purescript-node-readline-aff