この記事では、前回の記事で紹介したプログラムの解説をします。

Main.hs(再掲)

{-# LANGUAGE OverloadedStrings, OverloadedLists, OverloadedLabels #-}
module Main where

import Data.Function ( (&) )
import Data.Text ( Text )
import Pipes
import qualified Pipes.Extras as Pipes
import Control.Monad ( void )

import GI.Gtk ( Label(..), Window(..) )
import GI.Gtk.Declarative
import GI.Gtk.Declarative.App.Simple

data State = Initial | Showing Text
data Event = Show Text | Closed

view' :: State -> AppView Window Event
view' s =
    bin
        Window
        [ #title := "First Example"
        , on #deleteEvent (const (True, Closed))
        , #widthRequest := 400
        , #heightRequest := 300
        ]
    $ case s of
        Initial -> widget Label [ #label := "No message" ]
        Showing msg -> widget Label [ #label := msg ]

update' :: State -> Event -> Transition State Event
update' _ (Show msg) = Transition (Showing msg) (return Nothing)
update' _ Closed = Exit

main :: IO ()
main = void $ run App { view = view'
                      , update = update'
                      , inputs = [ greetings ]
                      , initialState = Initial
                      }
    where
        greetings =
            cycle ["Hello", "World"]
                & map Show
                & Pipes.each
                & (>-> Pipes.delay 1.0)

言語拡張

一行目では適用する言語拡張を指定しています。

{-# LANGUAGE OverloadedStrings, OverloadedLists, OverloadedLabels #-}

ここでは、OverloadedStrings、OverloadedLists、OverloadedLabelsを指定しています。それぞれの言語拡張の意味は使用箇所で適宜説明します。

言語拡張は、このようにソースコードの冒頭に書く方法以外にも、コンパイル実行時にオプションとして指定することもできます。GHCを直接呼び出すときは、

ghc -XOverloadedStrings -XOverloadedLists -XOverloadedLabels Main.hs

という様に-Xオプションで指定します。また、stackを用いる場合は、package.yamlファイルのexecutables項目下のghc-optionsで以下のように指定します。

package.yaml

executables:
  <project名>-exe:
    main:                Main.hs
    source-dirs:         app
    ghc-options:
    - -XOverloadedStrings
    - -XOverloadedLists
    - -XOverloadedLabels
    dependencies:
    - <project名>

これにより、stack buildでソースコードをコンパイルする際にオプションが渡されるようになります。

App.Simpleフレームワーク

このソースコードではApp.Simpleフレームワークを用いてアプリケーションを作っています。このフレームワークはWeb開発で用いるReduxと同じ機能を提供します。

App.Simpleフレームワークでは、画面表示(UI)はStateのみに依存します。そして、StateはUIやInputsによって生み出されるEventによって変化します。このように、画面表示を変化させる処理を一度Stateに集約することで、アプリケーションの構成が分かりやすくなり、また、問題が生じたときにデバッグしやすくなります。

Control.Concurrent.Chan

図中のEvent QueueはMain.hsでは表れていませんが、gi-gtk-declarative-app-simpleライブラリのソースコードではeventsという名前でたびたび使われています。

main関数

Pipesライブラリ

これまでInputsはProducerとして扱ってきましたが、よく見るとProducerのリストとして定義されています。実は、このProducerのリストはライブラリ内部で単独のProducerに変換されており、この変換にはpipes-concurrencyライブラリが使われています。早速pipes-concurrencyライブラリの説明をしたいところですが、pipes-concurrencyライブラリはpipesライブラリの拡張ライブラリなので、まずは大元のpipesライブラリから説明をします。

pipesライブラリは、Producer、Pipe、Consumerという３つのデータ型を提供しています。(そのほかにも機能があります!! 詳しくはドキュメントをご覧ください。)

Producerがデータを生成し、Pipeがそれを加工し、Consumerがデータを活用するというイメージです。具体的には、Producerでyield関数を引数付きで呼び出すことでPipeにデータを渡し、Pipeではawait関数でデータを受け取って加工した後yield関数でConsumerにデータを渡し、Consumerではawait関数でデータを受け取り処理します。

結局、データを次の段階に渡すにはyield関数を使い、前の段階から受け取るにはawait関数を使えばよいというだけです。そして、各段階を繋げるには>->という演算子を使い、出来上がったデータフローを実行するにはrunEffect関数を使います。

百聞は一見に如かずなので具体例を挙げます。

PipesExample.hs

import Pipes

pr :: Producer String IO ()
pr = do
    str <- lift $ getLine
    yield str

pp :: Pipe String String
pp = do
    str <- await
    yield $ "Hello, " ++ str

cs :: Consumer String IO ()
cs = do
    str <- await
    lift $ putStr str

main = runEffect $ pr >-> pp >-> cs

実行結果

> stack exec ghc PipesExample.hs
> ./PipesExample
John
Hello, John

ちなみにですが、prの定義でstr <- lift $ getLineとしていますが、ここをstr <- getLineとしてはダメです。これは、この部分のdo式が扱っているモナドはProducer String IOなのに対し、str <- getLineが関係しているモナドはIOだからです。そのため、モナド変換子(MonadTrans)クラスのlift関数でモナドを昇格する必要があります。

次にpipes-concurrencyライブラリの説明に移ります。このライブラリを使うと、複数のProducer/Consumerを一つのProducer/Consumerにまとめることができます。

これをどのように実現しているかというと、Producerから放出される値を一度キューに保存し、PipeやConsumerからの要請に従ってキューから値を取り出しています。