PureScriptでNodeのrl.questionを使う

```
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のドキュメントから引用しています。)

```js
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`の型を見てみます。

```hs
createConsoleInterface :: Completer -> Effect Interface
```

引数には`noCompletion :: Completer`を指定しておきます。

次に`question`の型を見てみます。

```hs
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に相当するようです。
コールバック関数を書いてみます。

```hs
callback :: String -> Effect Unit
callback answer = log $ "Thank you for your valuable feedback: " <> answer
```

というわけでPureScriptで一連のコードを書いてみました。

```hs
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`を実行してしまっています。
したがって、コールバック関数が呼び出された後に閉じるようにしなければなりません。

その場しのぎで解決してみます。

```hs
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`をコールバックの中に無理矢理押し込んでみました。
こうすれば一応動きますが、ネストする必要があります。

例えばもう一つ質問を追加してみましょう。

```hs
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_`で実行できます。

```hs
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

```hs
makeAff :: forall a. ((Either Error a -> Effect Unit) -> Effect Canceler) -> Aff a
```

今は`Effect Canceler`が無視できるとして、`Either Error a → Effect Unit`だけ見てみます。
これは実行された時にどのように処理をするのかを記述するようです。
ECMAScriptの`Promise`で言う所の`reject`と`resolve`ですね。
とりあえず何もしないものを作ってみます。

```hs
aff :: Aff String
aff = makeAff go
  where
  go :: (Either Error String -> Effect Unit) -> Effect Canceler
  go _ = pure nonCanceler
```

## questionのAffラッパー

上記の実装ではコンパイルは通りますが、`question`を入れる余地がありません。
do構文で書き換えて`question`を入れてみます。

```hs
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'`の型は異なる点に注意です。

```hs
callback :: Either Error String -> Effect Unit
callback' :: String -> Effect Unit
```

`callback`を使って`callback'`を書いてみます。今回は全て成功扱いで良いでしょう。

```hs
callback' str = callback (Right str)
--            = callback <<< Right
```

最後に、残った未知の引数を追加してあげましょう。

```hs
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`以下を一般化します。

```hs
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`と名付けてみます。
ちなみに、`$>`を使うと以下のように書くこともできます。

```hs
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_

```hs
runAff_ :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect Unit
```

作った`Aff`を解決します。
ここでもやはり`Either`で`reject`, `resolve`相当の処理が必要です。


# Affを走らせる

```hs
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'`に処理を書いてみます。

```hs
    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

```hs
liftEffect :: forall a m. MonadEffect m => Effect a -> m a
```

これで`Effect a`を`Aff a`にできます。

# 今回のコード

```hs
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回質問する

```hs
    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`の文脈ですね。

```hs
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`を取得できるようにしてみます。

```hs
    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で標準入力
  - https://qiita.com/goldarn_ring/items/e3cc607dd63e57d91fe5
- AffですべてのPromises/Generatorsを過去にする／そして何故我々は作用をモナドで抽象化すべきなのか
  - https://qiita.com/hiruberuto/items/98598af2b0e9a6206ef3
- `purescript-node-readline-aff`
  - https://github.com/ChrisPenner/purescript-node-readline-aff