Haskellで作るTUIアプリ

はじめに

Haskellを勉強してきたので、何か作りたくなりました。

GoにWuzzというものがあったので、

これをシンプルにしたものを作ってみました。wuzzkell

初心者ながら作ったものですが、メモとして残しておきます。

Http-clientライブラリはreqを使用しています。
使い方はこちらを参考にしました。

TUIで使うライブラリ

Haskellにはbrickというtui用のライブラリがあるのでこれを使います。

brickではUI, イベント, アトリビュート等を管理するApp型があります。

data App s e n =
    App { appDraw :: s -> [Widget n]
        , appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
        , appHandleEvent :: s -> BrickEvent n e -> EventM n (Next s)
        , appStartEvent :: s -> EventM n s
        , appAttrMap :: s -> AttrMap
        }

sは状態を管理するデータ、eはアプリケーション定義イベント、nはWidgetの名前を意味しています。

このAppに対応する関数をそれぞれ定義していくことで、TUIアプリが作成できます。

-- | Defines how the brick application will work / handle events
app :: App BrickState DoRequest Name
app = App
  { appDraw = drawUi
  , appChooseCursor = BF.focusRingCursor $ view stFocus
  , appHandleEvent = handleEvent
  , appStartEvent = pure
  , appAttrMap = const theMap
  }

sにあたるものを定義します。

data BrickState = BrickState
  { _stEditURL :: BE.Editor Text Name -- ^ Editor for the URL
  , _stEditHeader :: BE.Editor Text Name -- ^ Editor for the Header
  , _stEditParam :: BE.Editor Text Name -- ^ Editor for the URL Param
  , _stListMethod :: BL.List Name Http.StdMethod  -- ^ List for the Http Method
  , _stEditBody :: BE.Editor Text Name -- ^ Editor for the Body
  , _stEditResponseHeader :: BE.Editor Text Name -- ^ ReadOnly Editor for the Response Header. 
  , _stEditResponseBody :: BE.Editor Text Name -- ^ ReadOnly Editor for the Response Body
  , _stFocus :: BF.FocusRing Name -- ^ Focus ring - a circular list of focusable controls
  , _stHttpReq :: HttpRequest -- ^ Request Data
  , _stIsSending :: Bool -- ^ Whether Sending request or not
  , _stAppEventChan :: Maybe (BChan DoRequest) -- ^ Chan Of App Event
  }
makeLenses ''BrickState

このうちのappDrawとappHandleEventを見ていきます

appDraw

UIを構成する関数になります。

描画するものはここで全て定義します。

drawUi :: BrickState -> [Widget Name]
drawUi st = [sendingWidget, B.padAll 1 contentBlock]
  where
    sendingWidget = if st ^. stIsSending
      then C.vCenterLayer $ C.hCenterLayer $ B.border $ B.txt "Sending request.."
      else B.emptyWidget
    contentBlock = B.withBorderStyle BS.unicode $ B.border
                 $ B.vBox [urlWidget, requests <+> results]
    requests = B.hLimitPercent 30 $ B.vBox [B.vLimitPercent 40 $ urlParamWidget <=> B.vLimit 3 methodWidget, requestDataWidget, requestHeadersWidget]
    results =  B.vBox [B.vLimitPercent 40 responseHeaderWidget, responseBodyWidget]

-- 省略

リストの先頭から順に前面で描画されていきます。 sendingWidgetは描画されない場合もあるので、emptyWidgetで使い分けします。

UIは縦、横の最大値や配置場所等細かく定義できます。

appHandleEvent

アプリケーションの動きを定義します。

イベントの種類はマウスダウン, マウスアップ, キーボード, アプリ定義外部イベントがあります。
戻り値はイベントを終えた次の状態を指しています。

handleEvent ::  BrickState -> BrickEvent Name DoRequest -> EventM Name (Next BrickState)
handleEvent st ev = case ev of
  AppEvent DoRequest -> do
      res <- liftIO $ doRequest $ st ^. stHttpReq
      B.continue $ st
         & over stEditResponseHeader
            ( BE.applyEdit
              ( const $ Z.moveCursor (0, 0) $ Z.textZipper (T.linesCR $ res ^. responseHeader) Nothing )
            )
         & over stEditResponseBody
            ( BE.applyEdit
              ( const $ Z.moveCursor (0, 0) $ Z.textZipper (T.linesCR $ res ^. responseBody) Nothing )
            )
         & set stIsSending False
  MouseDown n _ _ _ -> B.continue (st & over stFocus (BF.focusSetCurrent n))
  MouseUp n _ _  -> B.continue (st & over stFocus (BF.focusSetCurrent n))
  MouseUp n _ _  -> B.continue (st & over stFocus (BF.focusSetCurrent n))
  VtyEvent ve@(V.EvKey k ms) ->
    case (k, ms) of
      (V.KEsc, []) -> B.halt st
      (V.KChar '\t', _) -> B.continue $ st & over stFocus BF.focusNext
      (V.KBackTab, []) -> B.continue $ st & over stFocus BF.focusPrev
      (V.KChar 'r', [V.MCtrl]) -> submitEvent st >>= B.continue
  where
  submitEvent st' = case st' ^. stAppEventChan of
    Nothing -> pure st'
    Just chan -> do
      liftIO $ writeBChan chan DoRequest
      pure $ st' & set stIsSending True

ここで悩んだのが, Http リクエストを送る際の挙動で本家Wuzzはリクエストを送る際にpopupを出しています。

これを実現したかったのですが、handleEventが処理を終えてようやく描画されるようになります。なので、一つのイベントでは popupを出す描画と消す描画ができないです。

そこで今回はpopupを出すときにアプリケーション定義イベントを発生させるようにしています。

実行

アプリケーション定義イベント、マウスダウンイベントを定義しているのでcustomMainをつかいます。

  let st = initBrickState & set stAppEventChan (Just chan)  
  void $ customMain initialVty buildVty (st ^. stAppEventChan) app st
  where
    buildVty = do
      v <- V.mkVty =<< V.standardIOConfig
      V.setMode (V.outputIface v) V.Mouse True
      pure v

まとめ

いざ作ってみると思い通りに行かなかったりしたのですが、なんとかここまで作れました。
最初はUI書く場所やイベントが発生後の描画処理について制限があったりと、どう書けばいいのわからなかったのですが、いざ見直してみると一貫性が保たれていて何やっているのか分かりやすく感じます。

また別のツールをHaskellで書いたりして少しずつHaskellに慣れていきたいと思います。