はじめに
仕事で使うためにGUIライブラリを探している時にthreepenny-guiを知りました．ブラウザGUIのライブラリで，一からデスクトップアプリを使うより簡単で，本来ならStateモナドなどで持ち回す必要のある状態も，ブラウザ上の要素情報として持ち回されるため，get-setが容易に思えました
samplesを一通り動かした後，ドイツ語の単語勉強用アプリを動かすことにしました．執筆時点ではまだ細部の追い込みが終わっていませんので年末にもう少し進めたいと思います
samplesフォルダにある例を動かせば，より詳しく使い方が分かりますので，ここでは作例を紹介していきます
目標仕様
- ドイツ語単語をランダムに表示
- [回答]ボタンを押すと，英語訳or日本語訳を表示する
- [次へ]ボタンを押すと，表示するドイツ語単語を更新する
ドイツ語リストは自作が面倒だったので，下記URLから拝借しています
http://moz.la.coocan.jp/wortschatz/
パーサを書かずに横着抽出しているので，ウムラウト文字や一部例外的な表示をする単語では正しく表示できませんが，単語抽出は以下のコードで行っています．要改良です
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Simple
import qualified Network.HTTP.Client as C
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Random
import Data.Time.Clock
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Char8 as BS
import Data.Char (toLower)
import Control.Monad
import Control.Concurrent (threadDelay)
import Paths
import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core
getRandRange r = fst . randomR r . mkStdGen . floor . utctDayTime <$> getCurrentTime
getURL = ((!!) urls) <$> getRandRange (0, length urls-1)
pickWord xs = ((!!) xs) <$> getRandRange (0, length xs-1)
getWord :: IO BS.ByteString
getWord = do
res <- getResponseBody <$> (httpLBS =<< getURL)
let ws = map (\s -> BS.take (BS.length s-4) s) . filter isWord . map BS.strip . BS.lines . LBS.toStrict $ res
pickWord ws
where
isWord str = "<br>" `BS.isSuffixOf` str
&& (toLower (BS.head str) `elem` ['a'..'z']
|| "<BR>" `BS.isPrefixOf` str)
また，翻訳文はDeepL APIを使用します．
使用には会員登録が必要なので，そのうちgoogle APIに切り替えるつもりです
data Target = EN | DE | JA deriving (Eq, Show)
deepLKey = "your api key"
getDeepL :: BS.ByteString -> Target -> IO LBS.ByteString
getDeepL s t = do
manager <- C.newManager tlsManagerSettings
res <- C.httpLbs req manager
return $ C.responseBody res
where
req = setRequestMethod "POST"
$ setRequestPort 443
$ setRequestHost "api-free.deepl.com"
$ setRequestSecure True
$ setRequestPath "/v2/translate"
$ setRequestHeader "Authorization" [BS.pack $ "DeepL-Auth-Key " ++ deepLKey]
$ setRequestQueryString [("text",Just s),("target_lang", Just . BS.pack . show $ t)]
$ defaultRequest
GUIを動かす
main関数は startGUI を呼び出せばよく，この時に読み込ませたいcss,jsや画像データなどがあればdefaultConfig に指定することが出来ます
main = do
static <- getStaticDir
startGUI defaultConfig { jsStatic = Just static } setup
GUIの要素はsetup関数で配置していきます．
動的に追加・削除したい要素はコールバック関数で指定しますが，今回はボタンクリック時のイベントのみで実装していくことにします
mkButton :: String -> UI Element
mkButton title = do
button <- UI.button #. "button" #+ [string title]
view <- UI.p #+ [element button]
return button
setup :: Window -> UI ()
setup w = do
return w # set title "Erweitern Wortschatz!"
newWord <- liftIO getWord
wordText <- UI.span # set text (BS.unpack newWord)
# set UI.id_ "word"
translateBtn <- mkButton "Antwort"
nextBtn <- mkButton ">"
contents <- UI.div #+ [element wordText]
#+ [(row [element translateBtn, element nextBtn])]
getBody w #+ [element contents]
on UI.click translateBtn $ \_ -> do
nowWord <- get text wordText
ubersetz <- liftIO $ getDeepL newWord EN
element wordText # set text (BS.unpack . LBS.toStrict $ ubersetz )
on UI.click nextBtn $ \_ -> do
newWord' <- liftIO getWord
element wordText # set text (BS.unpack newWord')
setup関数内で，コールバック，初期GUIの設定を記述します
今回必要なのは以下です
wordText： 単語/翻訳文を表示
translateBtn: [回答]ボタン （ドイツ語表記）
nextBtn: 次の問題を表示するボタン （タイマー更新に切り替え次第廃止予定）
これらをdiv，bodyで包むのが前半，後半は二つのボタンクリックイベント時の挙動を定義しています
要素の値はget,setで取得・書き換えが可能です．直観的ですね
ここまでのコードを実行すると，下記画面が生成されます
ちなみに，ここで翻訳ボタンを押すと，deepL APIからの返答として
{"translations":[{"detected_source_language":"DE","text":"known"}]}
が返ってきます．"text"要素の部分が翻訳された用語になりますので，パーサを組んでこ抽出してやれば，単語学習器としての基本機能は揃いますので，年末にTrifectaで実装予定です
以上，threepenny-guiの紹介でした．
機能毎にモジュールを分けての記述もしやすく，ブラウザベースのGUI開発を個人的には推していきたいです．他に面白いGUIライブラリがあれば是非ご紹介ください