2017-05-29

Docker で Haskell アプリケーションを作成 - MongoDB 利用

Docker Haskell MongoDB

MongoDB へ接続する Haskell アプリケーションを Docker で作成してみました。

以下の Docker イメージを使用します。

ビルドツールは stack を使って、MongoDB への接続には以下のライブラリを使います。

MongoDB driver for Haskell

今回のソースは http://github.com/fits/try_samples/tree/master/blog/20170529/

(1) Docker コンテナの実行

Docker で MongoDB と Haskell のコンテナを実行します。

コンテナ間の連携には、deprecated となっている Link 機能（–link）は使わずにユーザー定義ネットワークを使う事にします。

(1.1) bridge ネットワークの作成

bridge ネットワークを新規作成します。

$ docker network create --driver bridge br1

(1.2) MongoDB コンテナの実行

作成したネットワークへ参加するように --net=<ネットワーク名> を使って MongoDB を docker run します。

$ docker run -d --name mongo1 --net=br1 mongo

(1.3) Haskell コンテナの実行

Haskell も同様に docker run します。

ここでは Docker ホスト側の /vagrant/work をコンテナの /work へマウントしています。

$ docker run -it --name hs1 --net=br1 -v /vagrant/work:/work haskell /bin/bash
root@・・・#

確認のため Haskell コンテナ内から MongoDB のコンテナへ ping してみます。

ping 例

root@・・・# ping mongo1
PING mongo1 (172.18.0.2): 56 data bytes
64 bytes from 172.18.0.2: icmp_seq=0 ttl=64 time=0.640 ms
64 bytes from 172.18.0.2: icmp_seq=1 ttl=64 time=0.257 ms
・・・

(2) Haskell アプリケーションの作成

Haskell のコンテナで MongoDB へ接続するアプリケーションを作成します。（以降の処理は (1.3) で起動した Haskell コンテナ内で実施します）

(2.1) プロジェクトのひな型作成

stack new <プロジェクト名> [<テンプレート名>] でプロジェクトのひな型を作ります。

プロジェクト作成

root@・・・# cd /work

root@・・・# stack new sample1
Downloading template "new-template" to create project "sample1" in sample1/ ...
・・・

プロジェクト名のディレクトリが作られ、各種ファイルが生成されます。

(2.2) 依存ライブラリの取得

MongoDB driver for Haskell を使用するため、<プロジェクト名>.cabal ファイルの library/build-depends へ mongoDB を追記します。

今回は Control.Monad.Trans も使うので mtl も追記しています。

sample1/sample1.cabal

・・・
library
  ・・・
  build-depends:       base >= 4.7 && < 5
                     , mongoDB
                     , mtl
  default-language:    Haskell2010
・・・

stack build でビルドすると未取得の依存ライブラリをダウンロードします。

プロジェクトのビルド（依存ライブラリの取得）

root@・・・# cd sample1

root@・・・# stack build --allow-different-user
・・・
mtl-2.2.1: download
mtl-2.2.1: configure
mtl-2.2.1: build
mtl-2.2.1: copy/register
・・・

ここで --allow-different-user オプションを付けていますが、今回のケースではこのオプションを付ける必要がありました。（-v でマウントしたディレクトリを使用した事が原因だと思われる）

なお、–allow-different-user 無しで stack build すると以下のようになりました。

root@・・・# stack build
You are not the owner of '/work/sample1/'. Aborting to protect file permissions.Retry with '--allow-different-user' to disable this precaution.

(2.3) MongoDB 接続アプリケーションの実装

とりあえず someFunc という関数名をそのまま使う事にします。（変更する場合は app/Main.hs も変更します）

OverloadedStrings と ExtendedDefaultRules の言語拡張が最低限必要となるようです。

MongoDB driver for Haskell では、MongoDB に対する処理を Action m a （MonadIO m）で定義し access 関数で処理すればよさそうです。

ここで Action は type Action = ReaderT MongoContext と定義されています。

MongoDB のコレクションへ複数ドキュメントを追加するには insertMany や insertMany_ 関数が使えます。（ドキュメント追加の用途では insert や insertAll 関数等もあります）

関数名の最後の _ の有無は、作成したドキュメントの _id の値を返すかどうかの違いのようです。（_ の付いている方は返さない）

今回は _id の値は不要なので insertMany_ の方を使いました。

MongoDB へ登録するドキュメントは [<項目名> =: <値>, ・・・] という形式で定義できます。

find 関数の結果は Action m Cursor なので、rest 関数（Cursor -> Action m [Document]）をバインド（>>=）して Action m [Document] を取得しています。

接続先の MongoDB ホスト名は MONGO_HOST 環境変数から取得するようにしてみました。

sample1/src/Lib.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}

module Lib
    ( someFunc
    ) where

import System.Environment
import Control.Monad.Trans (lift)
import Database.MongoDB 

someFunc :: IO ()
someFunc = do
    mongo <- mongoHost
    -- MongoDB 接続
    pipe <- connect (host mongo)

    access pipe master "sample" proc

    close pipe

mongoHost :: IO String
mongoHost = getEnv "MONGO_HOST"

proc :: Action IO ()
proc = do
    -- items コレクションへドキュメント追加
    insertMany_ "items" [
        ["name" =: "item1", "value" =: 1],
        ["name" =: "item2", "value" =: 2] ]

    allItems >>= printDocs

-- items コレクションの全ドキュメント取得
allItems :: Action IO [Document]
allItems = rest =<< find ( select [] "items" )

-- ドキュメントの出力
printDocs :: [Document] -> Action IO ()
printDocs docs = lift $ mapM_ print docs

(2.4) ビルドと実行

それでは、ビルドして実行します。

ビルド

root@・・・# stack build --allow-different-user
・・・
/work/sample1/.stack-work/install/x86_64-linux/lts-8.15/8.0.2/bin
Registering sample1-0.1.0.0...

.stack-work ディレクトリへ（ビルドの）成果物が生成されます。

実行するには stack exec <実行ファイル名> で実行するか、実行ファイル（例 .stack-work/install/x86_64-linux/lts-8.15/8.0.2/bin/sample1-exe）を直接実行します。

実行ファイル名はデフォルトで <プロジェクト名>-exe となるようです。

今回は環境変数から MongoDB のホスト名を取得するようにしたので、MONGO_HOST 環境変数へ MongoDB のコンテナ名を設定してから実行します。

実行

root@・・・# export MONGO_HOST=mongo1

root@・・・# stack exec sample1-exe --allow-different-user
[ _id: 592a7ffb2139612699000000, name: "item1", value: 1]
[ _id: 592a7ffb2139612699000001, name: "item2", value: 2]

2016-01-25

PureScript で DOM を操作

Haskell JavaScript PureScript

PureScript の下記ライブラリを使って簡単な DOM 操作を試してみました。

ソースは http://github.com/fits/try_samples/tree/master/blog/20160125/

はじめに

PureScript を使って実装するものと同等の処理を JavaScript で書いてみました。 id で指定した DOM ノードの textContent を変更するだけの簡単な処理です。

sample.js

var Sample = {
    updateContent: (id, content) => {
        var node = document.getElementById(id);

        if (node) {
            node.textContent = content;
        }
    }
};

下記の HTML で実行してみます。（PureScript の方は updateContent の呼び出し部分が少し異なります）

index.html

<!DOCTYPE html>
<html>
<body>
    <h2 id="d"></h2>

    <script src="sample.js"></script>
    <script>
        Sample.updateContent('d', 'sample javascript');
    </script>
</body>
</html>

実行結果

Web ブラウザで表示した結果は以下の通りです。

f:id:fits:20160125204319p:plain

purescript-dom の場合

pulp init でプロジェクトを作成し、pulp dep install で purescript-dom をインストールします。

なお、pulp と gulp を事前にインストール（npm install）しておきます。

purescript-dom インストール

> pulp init
・・・

> pulp dep install purescript-dom --save

src/Main.purs を編集し updateContent 関数を実装します。

以下のように型まわりに注意が必要です。

(a) document 関数は Eff (dom :: DOM | eff) HTMLDocument を返す
(b) getElementById 関数の引数は ElementId と NonElementParentNode
(c) getElementById 関数は Eff (dom :: DOM | eff) (Nullable Element) を返す
(d) setTextContent 関数の引数は String と Node

(a) の結果の HTMLDocument を getElementById の引数へそのまま使えなかったので htmlDocumentToNonElementParentNode 関数で変換しています。

(c) の結果の Nullable はそのままだと使い難いので toMaybe 関数で Maybe 化し、Element も setTextContent の引数に使えなかったので elementToNode 関数で変換しています。

src/Main.purs

module Main where

import Prelude
import Control.Monad.Eff

import Data.Maybe
import Data.Nullable (toMaybe)

import DOM
import DOM.HTML.Types
import DOM.Node.Types
import DOM.HTML (window)
import DOM.HTML.Window (document)
import DOM.Node.NonElementParentNode (getElementById)
import DOM.Node.Node (setTextContent)

updateContent :: forall eff. String -> String -> Eff (dom :: DOM | eff) Unit
updateContent id content = do
    win <- window
    doc <- document win
    node <- getElementById (ElementId id) $ htmlDocumentToNonElementParentNode doc
    case (toMaybe node) of
        Just x -> setTextContent content (elementToNode x)
        _      -> return unit

今回は、gulp を使って pulp browserify を実行するように以下のような gulpfile.js を用意しました。

Sample.updateContent で関数を実行できるように --standalone を指定しています。

gulpfile.js

var gulp = require('gulp');
var child_process = require('child_process');

var pulpCmd = (process.platform == 'win32')? 'pulp.cmd': 'pulp';
var destFile = 'sample.js'

gulp.task('pulp_package', () => {
    // pulp browserify の実行
    var res = child_process.spawnSync(pulpCmd, ['browserify', '--standalone', 'Sample', '-t', destFile]);

    // 実行結果の出力
    [res.stdin, res.stdout, res.stderr].forEach( x => {
        if (x) {
            console.log(x.toString());
        }
    });
});

gulp.task('default', ['pulp_package']);

gulp コマンドを実行すると sample.js が生成されます。

ビルド例（gulp で pulp browserify を実行）

> gulp

下記の HTML で実行してみます。

ここで、Sample.updateContent はカリー化されており function(id) { return function(content) { return function __do() { ・・・ } } } となっている点に注意。

index.html

<!DOCTYPE html>
<html>
<body>
    <h2 id="d"></h2>

    <script src="sample.js"></script>
    <script>
        Sample.updateContent('d')('sample purescript-dom')();
    </script>
</body>
</html>

実行結果

f:id:fits:20160125204344p:plain

purescript-simple-dom の場合

同じ様にして purescript-simple-dom をインストールします。

purescript-simple-dom インストール

> pulp init
・・・

> pulp dep install purescript-simple-dom --save

src/Main.purs を編集し updateContent 関数を実装します。

purescript-dom と比べると余計な型変換が不要なのでシンプルです。

src/Main.purs

module Main where

import Prelude
import Control.Monad.Eff

import DOM

import Data.Maybe
import Data.DOM.Simple.Window (document, globalWindow)
import Data.DOM.Simple.Element (getElementById, setTextContent)

updateContent :: forall eff. String -> String -> Eff (dom :: DOM | eff) Unit
updateContent id content = do
    doc <- document globalWindow
    node <- getElementById id doc

    case node of
        Just x -> setTextContent content x
        _      -> return unit

purescript-dom と同じ様に gulp で sample.js を生成しました。（gulpfile.js は同じ内容です）

HTML は以下の通りです。

index.html

<!DOCTYPE html>
<html>
<body>
    <h2 id="d"></h2>

    <script src="sample.js"></script>
    <script>
        Sample.updateContent('d')('sample purescript-simple-dom')();
    </script>
</body>
</html>

実行結果

f:id:fits:20160125204359p:plain

2016-01-05

pulp を使った PureScript の開発

Haskell JavaScript PureScript

PureScript 用のビルドツールに pulp があります。

pulp を使えば PureScript v0.7 から多少面倒になったビルドや実行が比較的容易になります。

pulp インストール

Node.js の npm で purescript （コンパイラ）と pulp をインストールします。

pulp インストール例

> npm install -g purescript pulp

今回インストールした PureScript コンパイラ・pulp のバージョンは以下の通りです。

なお、PureScript コンパイラに関しては https://github.com/purescript/purescript/releases/ から各 OS 用のバイナリを直接取得する方法もあります。

npm でインストールしたものも実際は node_modules/purescript/vendor ディレクトリへ配置された各 OS 用のバイナリファイル（例. psc.exe）を使っているようです。

pulp を使った開発

今回作成したソースは http://github.com/fits/try_samples/tree/master/blog/20160105/

プロジェクトの作成

任意のディレクトリ内で pulp init を実行すると、必要最小限のファイルが生成されます。

その際に Bower を使って PureScript の主要ライブラリ（以下）を自動的に取得しますので、git コマンドを使えるようにしておく必要があります。

purescript-console
purescript-eff
purescript-prelude

プロジェクト作成例

> pulp init

* Generating project skeleton in ・・・
bower cached        git://github.com/purescript/purescript-console.git#0.1.1
bower validate      0.1.1 against git://github.com/purescript/purescript-console.git#^0.1.0
bower cached        git://github.com/purescript/purescript-eff.git#0.1.2
bower validate      0.1.2 against git://github.com/purescript/purescript-eff.git#^0.1.0
bower cached        git://github.com/purescript/purescript-prelude.git#0.1.3
bower validate      0.1.3 against git://github.com/purescript/purescript-prelude.git#^0.1.0
bower install       purescript-console#0.1.1
bower install       purescript-eff#0.1.2
bower install       purescript-prelude#0.1.3

purescript-console#0.1.1 bower_components\purescript-console
└── purescript-eff#0.1.2

purescript-eff#0.1.2 bower_components\purescript-eff
└── purescript-prelude#0.1.3

ディレクトリ・ファイル構成は以下のようになります。

bower_components
- purescript-console
- purescript-eff
- purescript-prelude
src/Main.purs
test/Main.purs
.gitignore
bower.json

デフォルトで用意されている src/Main.purs の内容は以下の通りです。

src/Main.purs

module Main where

import Prelude
import Control.Monad.Eff
import Control.Monad.Eff.Console

main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
  log "Hello sailor!"

ライブラリの追加には pulp dep install <ライブラリ名> を実行します。そうすると bower install が実施されます。

bower.json の依存パッケージ設定へエントリを追加するには --save オプションを付けます。

purescript-tuples の追加例

> pulp dep install purescript-tuples --save

・・・
bower install       purescript-control#0.3.2
bower install       purescript-invariant#0.3.0

purescript-tuples#0.4.0 bower_components\purescript-tuples
└── purescript-foldable-traversable#0.4.2

purescript-foldable-traversable#0.4.2 bower_components\purescript-foldable-traversable
├── purescript-bifunctors#0.4.0
└── purescript-maybe#0.3.5

purescript-maybe#0.3.5 bower_components\purescript-maybe
└── purescript-monoid#0.3.2

purescript-bifunctors#0.4.0 bower_components\purescript-bifunctors
└── purescript-control#0.3.2

purescript-monoid#0.3.2 bower_components\purescript-monoid
├── purescript-control#0.3.2
└── purescript-invariant#0.3.0

purescript-control#0.3.2 bower_components\purescript-control
└── purescript-prelude#0.1.3

purescript-invariant#0.3.0 bower_components\purescript-invariant
└── purescript-prelude#0.1.3

ビルドと実行

Main.purs を以下のようにタプルを使った処理に書き換えて実行してみます。

src/Main.purs

module Main where

import Prelude
import Control.Monad.Eff
import Control.Monad.Eff.Console
import Data.Tuple

main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
  let t = Tuple "two" 2
  print t
  
  let r = t >>= \x -> Tuple " + 1" (x + 1)
  print r

pulp run を実行するとビルドした後に処理を実施します。
ビルドだけを実施したい場合は pulp build を使います。

実行

> pulp run

* Building project in ・・・\20160105\purescript
psc: No files found using pattern: src/**/*.js
* Build successful.
Tuple ("two") (2)
Tuple ("two + 1") (3)

ビルド結果は output ディレクトリへ生成されます。

パッケージング

pulp browserify を実行すると Browserify を使って output ディレクトリ内のファイルをパッケージングしてくれます。

browserify によるパッケージング

> pulp browserify > sample.js

* Browserifying project in ・・・\20160105\purescript
* Project unchanged; skipping build step.
* Browserifying...

パッケージングしたファイル（sample.js）の実行結果は以下の通りです。

実行結果

> node sample.js

Tuple ("two") (2)
Tuple ("two + 1") (3)

Web ブラウザで実行する事もできます。

index.html

<!DOCTYPE html>
<html>
<script src="sample.js"></script>
</html>

f:id:fits:20160105001028p:plain

備考 - pulp を使わない場合

最後に pulp を使わない場合のビルド・実行方法も書いておきます。

まずは、Bower を使って purescript-console 等の必要なライブラリを手動でインストールします。

ライブラリのインストール例

> bower install purescript-console --save

src/Main.purs を psc コマンドでビルドするには以下のようにします。

psc によるビルド例

> psc src/Main.purs bower_components/purescript-*/src/**/*.purs --ffi bower_components/purescript-*/src/**/*.js

bower_components 内の .purs ファイルと --ffi オプションで bower_components 内の .js ファイルを指定します。

ビルド結果はデフォルトで output ディレクトリへ生成されます。（-o オプションで変更する事も可能）

実行する場合は、NODE_PATH 環境変数へ output ディレクトリを設定し、node コマンドで require('Main/index.js').main() を実行します。

実行例

> set NODE_PATH=output
> node -e "require('Main/index.js').main()"

Tuple ("two") (2)
Tuple ("two + 1") (3)

2014-08-10

Arrow (Kleisli) で List モナド - Haskell, Frege, Scalaz

Haskell Java Frege Scala Scalaz Monad

「Scalaz でリストモナド - Kleisli による関数合成」等で試してきた List モナドを使ったチェスのナイト移動の処理を Arrow （Kleisli）を使って実装し直してみました。

Arrow は計算のための汎用的なインターフェースで、モナドを扱うための Arrow として Kleisli があります。

ソースは http://github.com/fits/try_samples/tree/master/blog/20140810/

Haskell の場合

Haskell の Arrow は >>> や <<< で合成できるようになっています。

Kleisli はモナドを扱うための Arrow なので、下記では List モナドを返す関数 moveKnight を Kleisli へ包んで合成しています。

Kleisli から包んだ関数を取り出すには runKleisli を使います。

3手版

まずは 3手版です。

以前の List モナド版との違いは in3 と canReachIn3 関数を Arrow で実装し直した点です。

Kleisli を使えば、モナド値が無くてもモナドを返す関数（通常の値を取ってモナドを返す関数）を簡単に合成できるので in3 はポイントフリースタイルで定義しました。（このため canReachIn3 関数の引数の順序が以前のものと異なっています）

また、通常の関数は Arrow のインスタンスなので、canReachIn3 関数の部分は単純に canReachIn3 end = runKleisli in3 >>> elem end とする事も可能です。

move_knight.hs

import Control.Arrow

type KnightPos = (Int, Int)

moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- 3手先の移動位置を列挙
in3 :: Kleisli [] KnightPos KnightPos
in3 = Kleisli moveKnight >>> Kleisli moveKnight >>> Kleisli moveKnight

-- 指定位置に3手で到達できるか否かを判定
canReachIn3 :: Arrow a => KnightPos -> a KnightPos Bool
canReachIn3 end = arr (runKleisli in3) >>> arr (elem end)
-- 以下でも可
-- canReachIn3 :: KnightPos -> KnightPos -> Bool
-- canReachIn3 end = runKleisli in3 >>> elem end

main = do
    print $ runKleisli in3 $ (6, 2)

    print $ canReachIn3 (6, 1) $ (6, 2)
    print $ canReachIn3 (7, 3) $ (6, 2)

実行結果

> runghc move_knight.hs

[(8,1),(8,3),・・・
・・・
,(3,4),(3,8)]
True
False

N手版

3手版と同様に inMany と canReachInMany 関数を Arrow で実装し直してみました。

move_knight_many.hs

・・・
-- N手先の移動位置を列挙
inMany :: Int -> Kleisli [] KnightPos KnightPos
inMany x = foldr (>>>) returnA (replicate x (Kleisli moveKnight))

-- 指定位置にN手で到達できるか否かを判定
canReachInMany :: Arrow a => Int -> KnightPos -> a KnightPos Bool
canReachInMany x end = arr (runKleisli (inMany x)) >>> arr (elem end)
-- 以下でも可
-- canReachInMany :: Int -> KnightPos -> KnightPos -> Bool
-- canReachInMany x end = runKleisli (inMany x) >>> elem end

main = do
    print $ runKleisli (inMany 3) $ (6, 2)

    print $ canReachInMany 3 (6, 1) $ (6, 2)
    print $ canReachInMany 3 (7, 3) $ (6, 2)

実行結果

> runghc move_knight_many.hs

[(8,1),(8,3),・・・
・・・
,(3,4),(3,8)]
True
False

Frege の場合

Frege 3.21.586

Frege は Haskell とほとんど同じ実装になりますが、下記の点が異なります。

>>> の代わりに . で Arrow を合成
runKleisli の代わりに run を使用

なお、. は >>> と合成の向きが異なります。

3手版

3手版です。

move_knight.fr

package sample.MoveKnight where

import frege.control.Arrow
import frege.control.arrow.Kleisli

type KnightPos = (Int, Int)

moveKnight :: KnightPos -> [KnightPos]
moveKnight (c, r) = filter onBoard
    [
        (c + 2, r - 1), (c + 2, r + 1),
        (c - 2, r - 1), (c - 2, r + 1),
        (c + 1, r - 2), (c + 1, r + 2),
        (c - 1, r - 2), (c - 1, r + 2)
    ]
    where onBoard (c', r') = c' `elem` [1..8] && r' `elem` [1..8]

-- 3手先の移動位置を列挙
in3 :: Kleisli [] KnightPos KnightPos
in3 = Kleisli moveKnight . Kleisli moveKnight . Kleisli moveKnight

-- 指定位置に3手で到達できるか否かを判定
canReachIn3 :: Arrow a => KnightPos -> a KnightPos Bool
canReachIn3 end = arr (elem end) . arr in3.run
-- 以下でも可
-- canReachIn3 :: KnightPos -> KnightPos -> Bool
-- canReachIn3 end = elem end . in3.run

main args = do
    println $ in3.run $ (6, 2)

    println $ canReachIn3 (6, 1) $ (6, 2)
    println $ canReachIn3 (7, 3) $ (6, 2)

実行結果

> java -jar frege3.21.586-g026e8d7.jar move_knight.fr
・・・
> java -cp .;frege3.21.586-g026e8d7.jar sample.MoveKnight

[(8, 1), (8, 3), ・・・
・・・
 (3, 4), (3, 8)]
true
false

N手版

N手版です。

move_knight_many.fr

package sample.MoveKnightMany where

・・・
-- N手先の移動位置を列挙
inMany :: Int -> Kleisli [] KnightPos KnightPos
inMany x = foldr (.) id (replicate x (Kleisli moveKnight))

-- 指定位置にN手で到達できるか否かを判定
canReachInMany :: Arrow a => Int -> KnightPos -> a KnightPos Bool
canReachInMany x end = arr (elem end) . arr (inMany x).run
-- 以下でも可
-- canReachInMany :: Int -> KnightPos -> KnightPos -> Bool
-- canReachInMany x end = elem end . (inMany x).run

main args = do
    println $ (inMany 3).run $ (6, 2)

    println $ canReachInMany 3 (6, 1) $ (6, 2)
    println $ canReachInMany 3 (7, 3) $ (6, 2)

実行結果

> java -jar frege3.21.586-g026e8d7.jar move_knight_many.fr
・・・
> java -cp .;frege3.21.586-g026e8d7.jar sample.MoveKnightMany

[(8, 1), (8, 3), ・・・
・・・
 (3, 4), (3, 8)]
true
false

Scalaz の場合

Scalaz 7.1.0

最後に Scalaz を使った Scala による実装です。
Haskell と同様に >>> で Arrow を合成できるようになっています。

3手版

3手版です。

MoveKnight.scala

package sample

import scalaz._
import Scalaz._

object MoveKnight extends App {

    type KnightPos = Tuple2[Int, Int]

    val inRange = (p: Int) => 1 to 8 contains p

    val moveKnight = (p: KnightPos) => List(
        (p._1 + 2, p._2 - 1), (p._1 + 2, p._2 + 1),
        (p._1 - 2, p._2 - 1), (p._1 - 2, p._2 + 1),
        (p._1 + 1, p._2 - 2), (p._1 + 1, p._2 + 2),
        (p._1 - 1, p._2 - 2), (p._1 - 1, p._2 + 2)
    ).filter { case (x, y) => inRange(x) && inRange(y) }

    // 3手先の移動位置を列挙
    val in3 = Kleisli(moveKnight) >>> Kleisli(moveKnight) >>> Kleisli(moveKnight)
    // 以下でも可
    // val in3 = Kleisli(moveKnight) >==> moveKnight >==> moveKnight

    // 指定位置に3手で到達できるか否かを判定
    val canReachIn3 = (end: KnightPos) => in3.run >>> { xs => xs.contains(end) }

    in3 (6, 2) |> println

    (6, 2) |> canReachIn3 (6, 1) |> println
    (6, 2) |> canReachIn3 (7, 3) |> println
}

実行結果

> gradle run

MoveKnight
:compileJava UP-TO-DATE
:compileScala UP-TO-DATE
:processResources UP-TO-DATE
:classes UP-TO-DATE
:run
List((8,1), (8,3), ・・・
・・・
・・・, (3,4), (3,8))
true
false

N手版

N手版です。

MoveKnightMany.scala

package sample

import scalaz._
import Scalaz._

object MoveKnightMany extends App {
    ・・・
    // N手先の移動位置を列挙
    val inMany = (x: Int) => List.fill(x) { Kleisli(moveKnight) }.reduce { (a, b) => a >>> b }
    // 以下でも可
    // val inMany = (x: Int) => List.fill(x) { Kleisli(moveKnight) }.reduce { (a, b) => a >=> b }

    // 指定位置にN手で到達できるか否かを判定
    val canReachInMany = (x: Int) => (end: KnightPos) => inMany(x).run >>> { xs => xs.contains(end) }

    (6, 2) |> inMany(3) |> println

    (6, 2) |> canReachInMany(3)(6, 1) |> println
    (6, 2) |> canReachInMany(3)(7, 3) |> println
}

実行結果

> gradle run -Pmany

MoveKnightMany
:compileJava UP-TO-DATE
:compileScala UP-TO-DATE
:processResources UP-TO-DATE
:classes UP-TO-DATE
:run
List((8,1), (8,3), ・・・
・・・
・・・, (3,4), (3,8))
true
false

なお、ビルドと実行には下記のような Gradle ビルド定義ファイルを使用しました。

build.gradle

apply plugin: 'application'
apply plugin: 'scala'

repositories {
    mavenCentral()
}

dependencies {
    compile 'org.scala-lang:scala-library:2.11.2'
    compile 'org.scalaz:scalaz-core_2.11:7.1.0'
}

if (!hasProperty('many')) {
    println 'MoveKnight'
    mainClassName = 'sample.MoveKnight'
}
else {
    println 'MoveKnightMany'
    mainClassName = 'sample.MoveKnightMany'
}

2013-09-01

Frege 上で Java クラスを使用する

Java Haskell Frege

前回、Frege で Functor や Applicative を試しましたが、今回は Frege のソース内で Java クラスを使用してみました。

Frege

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20130901_3/

はじめに

一部の Java クラスは初めから Frege のソース内で使用できるようになっていますが、それ以外の Java クラスを使用するには、下記のような data 宣言を行う必要があります。（厳密な定義は Frege の仕様書をご覧ください）

data <データタイプ名> <型変数・・・> = [mutable | pure] native <Javaタイプ名> where
    [pure] native <関数名> [<Javaメソッド名など>] :: <型シグネチャ・・・>
    ・・・

補足事項は下記。

Immutable（不変）クラスや副作用の無いメソッドに対しては pure native を指定
pure native では無いメソッド（オブジェクトの状態を変化させたりするメソッド等）に対しては IO や ST モナドを返すようにする
Java インスタンスメソッドを使う場合は第一引数を自身のデータタイプとする
"関数名" と "Javaメソッド名" が等しい場合は "Javaメソッド名" を省略可能

Immutable（不変）クラスの場合

まずは Java の Immutable クラスを使用する場合です。

java.math.BigDecimal クラスを題材に、下記のような処理を Frege で実装してみました。（ちなみに java.math.BigInteger の方は Integer として Frege 内で使えます）

(1) 文字列を引数に取るコンストラクタ
(2) toString メソッド
(3) add メソッド
(4) add メソッド（ + 関数として使用）
(5) multiply メソッド（ * 関数として使用）

bigdecimal_sample.fr

package sample.BigDecimalSample where

data BigDecimal = pure native java.math.BigDecimal where
    -- (1)
    pure native new :: String -> BigDecimal
    -- (2)
    pure native toString :: BigDecimal -> String
    -- (3)
    pure native add :: BigDecimal -> BigDecimal -> BigDecimal
    -- (4)
    pure native (+) add :: BigDecimal -> BigDecimal -> BigDecimal
    -- (5)
    pure native (*) multiply :: BigDecimal -> BigDecimal -> BigDecimal

main args = do
    let num1 = BigDecimal.new "100"
    let num2 = BigDecimal.new "50"

    putStrLn $ (num1.add num2).toString
    putStrLn $ (num1.+ num2).toString
    putStrLn $ (num1.* num2).toString

実行結果

> java -cp .;fregec.jar sample.BigDecimalSample
150
150
5000
runtime ・・・

Num の型インスタンス

上記処理で num1.+ num2 では無く num1 + num2 とするには BigDecimal を Num の型インスタンス宣言してやる必要があります。

今回、Num の型インスタンス宣言を行うには下記のような関数定義が必要でした。

(+)
(-)
(*)
one
zero
fromInt
hashCode
<=>

bigdecimal_sample2.fr （Num 型インスタンス宣言版）

package sample.BigDecimalSample2 where

data BigDecimal = pure native java.math.BigDecimal where
    pure native new :: String -> BigDecimal
    pure native toString :: BigDecimal -> String
    pure native zero java.math.BigDecimal.ZERO :: BigDecimal
    pure native one  java.math.BigDecimal.ONE  :: BigDecimal
    pure native (+) add      :: BigDecimal -> BigDecimal -> BigDecimal
    pure native (-) subtract :: BigDecimal -> BigDecimal -> BigDecimal
    pure native (*) multiply :: BigDecimal -> BigDecimal -> BigDecimal
    pure native hashCode :: BigDecimal -> Int
    pure native compareTo :: BigDecimal -> BigDecimal -> Int

instance Ord BigDecimal where
    a <=> b = (a.compareTo b).<=> 0

instance Num BigDecimal where
    pure native fromInt java.math.BigDecimal.valueOf :: Int -> BigDecimal

main args = do
    let num1 = BigDecimal.new "100"
    let num2 = BigDecimal.new "50"

    putStrLn $ (num1 + num2).toString
    putStrLn $ (num1 * num2).toString
    putStrLn $ (num1 - num2).toString

実行結果

> java -cp .;fregec.jar sample.BigDecimalSample2
150
5000
50
runtime ・・・

Mutable（可変）クラスの場合

次は Java の Mutable クラスを使用する場合です。

題材として良さそうなクラスが思い浮かばなかったので、とりあえず java.awt.Point を使ってみました。

Mutable クラスの場合は基本的に pure を付けない native な関数を定義して IO や ST モナドを返すようにします。

IO モナド版

まずは IO モナド版です。

new や toString 等で IO <データタイプ> を返すようにします。（今回は IO Point）

Java のインスタンスメソッドに対する関数（toString や move 等）の第一引数は IO モナドでは無く普通の値（今回の場合は Point）となります。

とりあえず下記のような処理を実装してみました。

(1) new で x=10, y=20 へ設定
(2) move で x=20, y=30 へ移動
(3) translate で x を +5、y を +3

point_sample.fr （IOモナド版）

package sample.PointSample where

data Point = mutable native java.awt.Point where
    native new :: Int -> Int -> IO Point
    native toString :: Point -> IO String
    native move :: Point -> Int -> Int -> IO ()
    native translate :: Point -> Int -> Int -> IO ()

main args = do
    -- (1)
    p <- Point.new 10 20
    -- (2)
    p.move 20 30
    -- (3)
    p.translate 5 3

    p.toString >>= putStrLn

実行結果

> java -cp .;fregec.jar sample.PointSample
java.awt.Point[x=25,y=33]
・・・

ST モナド版

次に ST モナド版です。

new が ST s (Mutable s Point) を返し、toString 等の第一引数が Mutable s Point となっている点が IO モナド版との違いです。

point_sample2.fr （STモナド版）

package sample.PointSample2 where

data Point = mutable native java.awt.Point where
    native new :: Int -> Int -> ST s (Mutable s Point)
    native toString :: Mutable s Point -> ST s String
    native move :: Mutable s Point -> Int -> Int -> ST s ()
    native translate :: Mutable s Point -> Int -> Int -> ST s ()

sample :: Mutable s Point -> ST s String
sample p = do
    p.move 20 30
    p.translate 5 3
    p.toString

main args = do
    Point.new 10 20 >>= sample >>= putStrLn

実行結果

> java -cp .;fregec.jar sample.PointSample2
java.awt.Point[x=25,y=33]
・・・

補足

move や translate 等のオブジェクトの状態を変化させるようなメソッドを一切使わないのであれば java.awt.Point を pure native とする事も可能です。

point_sample3.fr

package sample.PointSample3 where

data Point = pure native java.awt.Point where
    pure native new :: Int -> Int -> Point
    pure native toString :: Point -> String

main args = do
    let p = Point.new 10 20
    putStrLn $ p.toString

2013-08-11

JVM用の純粋関数型言語 Frege で Applicative Functor を使用

Java Haskell Frege

Frege は Haskell によく似た JVM 用の純粋関数型プログラム言語です。

Frege

なかなか面白そうな言語だったので、関数を Applicative として使うサンプル（書籍「すごいHaskellたのしく学ぼう！」より）を試してみました。

ソースは http://github.com/fits/try_samples/tree/master/blog/20130810/

Frege の使い方

Frege を使うには、まず http://code.google.com/p/frege/downloads/list から JAR ファイル（例 frege3.21.107-g4bd09eb.jar）をダウンロードしてきます。

カレントディレクトリに fregec.jar というファイル名で保存した場合、下記のようにすればコンパイル処理を実行できます。（-d で出力先を指定しなければ、カレントディレクトリに Java ソース・クラスファイルが出力されます）

コンパイル

> java -jar fregec.jar [オプション] <ソースファイル>

実行は、下記のように fregec.jar をクラスパスに追加してコンパイル処理で出力された Java クラスを実行するだけです。

実行（Windows の場合）

> java -cp .;fregec.jar <クラス名>

単純な処理の実行

それでは 3 * 5 の結果を出力するだけの単純なプログラム（下記）をコンパイル・実行してみます。

func_sample.fr

package sample.FuncSample where

main args = do
    let f = (*3)
    putStrLn $ show $ f 5

次のような点が Haskell と異なります。

package <クラス名> where が必要
main に引数（上記の args）が必要

ちなみに、package で指定したクラス名が Java ソース化される際のクラス名・パッケージ名に使われます。

下記のようにコンパイルすると sample ディレクトリへ FuncSample.java や FuncSample.class 等が出力されます。

コンパイル

> java -jar func_sample.fr
calling: javac -cp fregec.jar;. -d . -encoding UTF-8 ./sample/FuncSample.java
runtime 4.58 wallclock seconds.

実行結果はこのようになります。

実行結果

> java -cp .;fregec.jar sample.FuncSample
15
runtime 0.068 wallclock seconds.

関数を Functor として使う

次は、関数を Functor として使ってみます。

Haskell による実装

まず Haskell で実装してみました。 +100 した後 *3 する処理に 1 を与えた結果を出力します。

functor_sample.hs （Haskell 版）

main = do
    let f = fmap (*3) (+100)
    putStrLn $ show $ f 1
    print $ f 1

実行結果（Haskell 版）

> runghc functor_sample.hs
303
303

Frege による実装

それでは本題の Frege による実装です。

Frege には今のところ、関数 "(->) r" に対する Functor のインスタンス宣言が無いようなので自前で行う必要がありました。（見落としているだけかもしれませんが）

インスタンス宣言の仕方は Haskell と同じです。

なお、Haskell の print 関数は改行しますが、Frege の print 関数は改行しないので代わりに println 関数を使います。

functor_sample.fr （Frege 版）

package sample.FunctorSample where

instance Functor ((->) r) where
    fmap = (.)

main args = do
    let f = fmap (*3) (+100)
    putStrLn $ show $ f 1
    println $ f 1

コンパイルと実行結果（Frege 版）

> java -jar fregec.jar functor_sample.fr
・・・
> java -cp .;fregec.jar sample.FunctorSample
303
303
runtime 0.072 wallclock seconds.

ちなみに、"instance Functor ((->) r)・・・" を定義しなかった場合、コンパイル時に下記のようなエラーが出る事になります。

E functor_sample.fr:6: -> Int is not an instance of Functor

関数を Applicative として使う

最後に関数を Applicative として使ってみます。

Haskell による実装

Haskell 版は下記の通りです。 *3 した結果と +10 した結果を合計する処理に 4 を渡して出力します。（ (3 * 4) + (10 + 4) = 26 ）

applicative_sample.hs （Haskell 版）

import Control.Applicative

main = do
    let f = (+) <$> (*3) <*> (+10)
    print $ f 4

実行結果（Haskell 版）

> runghc applicative_sample.hs
26

Frege による実装

それでは Frege 版です。 Functor と同様に関数 "(->) r" に対する Applicative のインスタンス宣言も自前で行う必要があるようです。

applicative_sample.fr （Frege 版）

package sample.ApplicativeSample where

instance Functor ((->) r) where
    fmap = (.)

instance Applicative ((->) r) where
    return x = (\_ -> x)
    f <*> g = \x -> f x (g x)

main args = do
    let f = (+) <$> (*3) <*> (+10)
    println $ f 4

コンパイルと実行結果（Frege 版）

> java -jar fregec.jar applicative_sample.fr
・・・
> java -cp .;fregec.jar sample.ApplicativeSample
26
runtime 0.083 wallclock seconds.

2012-11-11

Haskell と Scalaz でモナドを自作

Haskell Scala Monad Scalaz

今回は、Haskell と Scalaz でモナドを自作してみました。

良い題材を思いつかなかったので、とりあえず以下のような単純なモナド（Counter モナドとする）を自作する事にしました。

カウンターを持たせて、バインドで処理を繋ぐ度にカウンター同士を加算するモナド *1

Haskell・Scalaz のどちらも、概ね以下のようにしてモナドを作成します。

(1) モナドとして扱う型を定義
(2) Monad *2 のインスタンスを定義

なお、Monad のインスタンスを定義する際、以下の関数（もしくはメソッド）を実装する事になります。

種類	Haskell	Scalaz
注入関数	return	point
連鎖関数	>>=	bind

サンプルソースは http://github.com/fits/try_samples/tree/master/blog/20121111/

ちなみに、このブログの最初のサンプルはモナド則を満たしていなかった *3 ので修正しました。

Haskell の場合

それでは、Haskell で Counter モナドを作成してみます。

まず、モナドとする型 Counter を定義します。任意の型の値と Int 型のカウンターをタプルとしてフィールドに持つ型を newtype で定義し、getCount 関数でタプルの内容を取得できるようにしています。(1)

次に、Counter を Monad のインスタンスとして定義し、return と >>= 関数を以下のように実装しています。(2)

注入関数 return は引数 x の値とカウンター値が 0 のタプルを持つ Counter モナドを返す (a)
連鎖関数 >>= は元の Counter モナドが持つ値 x にモナディック関数 f を適用した結果のモナドから取り出した値 y とカウンター d に元の Counter モナドが持つカウンター c を加算したタプルを持つ Counter モナドを返す (b)

最後に、Counter モナドの動作を確認するため、モナディック関数 append を定義し main で return や >>= を試しています。

append は Counter モナドの値 x に指定の文字列 s を連結しカウンターが 1 の Counter モナドを返します。

counter.hs （Haskell版 Counter モナド）

-- (1) モナドとして扱う型を定義
newtype Counter a = Counter { getCount :: (a, Int) }

-- (2) Monad のインスタンスを定義
instance Monad Counter where
    -- (a) 注入関数の実装
    return x = Counter (x, 0)
    -- (b) 連鎖関数の実装
    (Counter (x, c)) >>= f = let (y, d) = getCount(f x) in Counter (y, c + d)

-- モナディック関数
append :: String -> String -> Counter String
append s x = Counter (x ++ s, 1)

-- Counter モナドの利用
main = do
    -- ("a", 0)
    print $ getCount $ return "a"

    -- ("ab", 1) 左恒等性
    print $ getCount $ return "a" >>= append "b"
    print $ getCount $ append "b" "a"

    -- ("abc", 2)
    print $ getCount $ return "a" >>= append "b" >>= append "c"

    -- ("d", 3) 右恒等性
    print $ getCount $ Counter ("d", 3) >>= return

実行結果は以下の通り。>>= で append を繋ぐ度にカウンターが増えている事を確認できます。

実行結果

> runghc counter.hs
("a",0)
("ab",1)
("ab",1)
("abc",2)
("d",3)

Scalaz の場合

今度は、Scalaz で Counter モナドを作成してみます。

まず、モナドとする型 Counter を定義します。任意の値とカウンターのタプルを持つ case class を定義し、count でタプルの内容を取得できるようにしています。(1)

次に、以下のようにして Counter を Monad のインスタンスとしています。(2)

CounterInstances トレイトを定義
CounterInstances トレイト内に counterInstance を定義し Monad トレイトの実装を設定
CounterInstances トレイトを extends するコンパニオンオブジェクトを定義

CounterSample.scala （Scalaz版 Counter モナド）

package fits.sample

import scalaz._
import Scalaz._

// (1) モナドとして扱う型を定義
case class Counter[A](count: (A, Int))

// (2) Monad のインスタンスを定義
trait CounterInstances {
    implicit val counterInstance = new Monad[Counter] {
        // (a) 注入関数の実装
        def point[A](x: => A): Counter[A] = Counter (x, 0)
        /**
         * (b) 連鎖関数の実装
         *
         * b1. Counter モナド fa からタプルの内容を取得
         * b2. x の値に f を適用した結果の Counter モナドからタプルの内容を取得
         * b3. y の値とカウンター値 d に fa のカウンター値 c を加算した値を持つ Counter モナドを返す
         */
        def bind[A, B](fa: Counter[A])(f: (A) => Counter[B]): Counter[B] = {
            val (x, c) = fa.count // b1.
            val (y, d) = f(x).count // b2.
            Counter (y, c + d) // b3.
        }
    }
}
// (2) Monad のインスタンスを定義
case object Counter extends CounterInstances

// Counter モナドの利用
object CounterSample extends App {
    import Counter.counterInstance.point

    // モナディック関数
    val append = (s: String) => (x: String) => Counter (x + s, 1)

    // ("a", 0)
    point("a").count |> println

    // ("ab", 1) 左恒等性
    ( point("a") >>= append("b") ).count |> println
    ( append("b")("a") ).count |> println

    // ("abc", 2)
    ( point("a") >>= append("b") >>= append("c") ).count |> println

    // (d, 3) 右恒等性
    ( Counter ("d", 3) >>= { s => point(s) } ).count |> println
}

sbt 用ビルドファイルの内容は以下の通りです。

build.sbt

scalaVersion := "2.10.0"

libraryDependencies += "org.scalaz" %% "scalaz-core" % "7.0.0-M7"

mainClass in (Compile, run) := Some("fits.sample.CounterSample")

sbt による実行結果は以下の通りです。

実行結果

> sbt run
・・・
[info] Running fits.sample.CounterSample
(a,0)
(ab,1)
(ab,1)
(abc,2)
(d,3)

*1:通常、このような用途には Writer モナドを使います

*2:Haskell は Monad 型クラス、Scalaz は Monad トレイト

*3:つまり、モナドでは無かったという事です

(1) Docker コンテナの実行

(1.1) bridge ネットワークの作成

(1.2) MongoDB コンテナの実行

(1.3) Haskell コンテナの実行

ping 例

(2) Haskell アプリケーションの作成

(2.1) プロジェクトのひな型作成

プロジェクト作成

(2.2) 依存ライブラリの取得

sample1/sample1.cabal

プロジェクトのビルド（依存ライブラリの取得）

(2.3) MongoDB 接続アプリケーションの実装

sample1/src/Lib.hs

(2.4) ビルドと実行

ビルド

実行

はじめに

sample.js

index.html

実行結果

purescript-dom の場合

purescript-dom インストール

src/Main.purs

gulpfile.js

ビルド例 （gulp で pulp browserify を実行）

index.html

実行結果

purescript-simple-dom の場合

purescript-simple-dom インストール

src/Main.purs

index.html

実行結果

pulp インストール

pulp インストール例

pulp を使った開発

プロジェクトの作成

プロジェクト作成例

src/Main.purs

purescript-tuples の追加例

ビルドと実行

src/Main.purs

実行

パッケージング

browserify によるパッケージング

実行結果

index.html

備考 - pulp を使わない場合

ライブラリのインストール例

psc によるビルド例

実行例

Haskell の場合

3手版

move_knight.hs

実行結果

N手版

move_knight_many.hs

実行結果

Frege の場合

3手版

move_knight.fr

実行結果

N手版

move_knight_many.fr

実行結果

Scalaz の場合

3手版

MoveKnight.scala

実行結果

N手版

MoveKnightMany.scala

実行結果

build.gradle

はじめに

Immutable（不変）クラスの場合

bigdecimal_sample.fr

実行結果

Num の型インスタンス

bigdecimal_sample2.fr （Num 型インスタンス宣言版）

実行結果

Mutable（可変）クラスの場合

ビルド例（gulp で pulp browserify を実行）

実行（Windows の場合）

実行結果（Haskell 版）

コンパイルと実行結果（Frege 版）

実行結果（Haskell 版）

コンパイルと実行結果（Frege 版）