Writerモナドの使い道 計算の経過を得る

1から10まで足し算するコードを考えてみよう。関数型言語では高階関数を使ってすっきり表現できる。
ただ、このコードには欠点がある。最後の結果求めるには十分だが、足し算の経過を見たいときどうしてよいか分からない。

import Data.List(foldl')

main = do
  print $ sum' [1..10]

sum' :: Num a => [a] -> a
sum' xs = foldl' (+) 0 xs

手続き型言語で書かれたコードだったら、一行追加するだけで良いかもしれない。
では関数型言語ではどうするのか?

function sum2 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    console.log("r: " + r) // この行を追加すればOK
    }
    return r;
}

方法1. IOモナドを使う

(+) の IOモナド対応版(addIO)を作り、foldl を foldM に変えれば、addIO内でputStrLnが使えるようになる。ただ、これだと純粋な関数ではなくなり、IOを引きずっている箇所でしか利用できない。

main = do
  print =<< sumIO [1..10]

sumIO :: (Num a, Show a) => [a] -> IO a
sumIO xs = foldM addIO 0 xs

addIO :: (Num a, Show a) =>  a -> a -> IO a
addIO p1 p2 = putStrLn ("r: " ++ show r) >> return r
  where
    r = p1 + p2

方法2. trace を使う

Haskell には純粋な関数内での計算をデバッグ出力する関数が用意されている。trace は 第一引数を標準出力に表示し、第二引数と同じものに評価される関数だ。場合によってはこれで十分だろう。ただ、経過の値を他の計算でも利用したいとき、標準出力に表示されてしまったものを利用することはできない。

import Data.List(foldl')
import Debug.Trace

main = do
  print $ sumT [1..10]
  
sumT :: (Num a, Show a) => [a] -> a
sumT xs = foldl' addT 0 xs

addT :: (Num a, Show a) => a -> a -> a
addT p1 p2 = trace ("r: " ++ show r) r
  where
    r = p1 + p2
  

方法3. Writerモナド を使う

そこでWriterモナド登場。WriterモナドはIOモナドと違い純粋関数内で実行でき、コードに下記のように手を加えることで、結果にいたるまでの過程の値を最後にリストとして得ることが出来る。

import Control.Monad.Writer

main = do
  print $ sumW [1..10]

sumW :: (Num a) => [a] -> (a,[a])
sumW xs = runWriter $ foldM addW 0 xs
          
-- 戻り値の型に細工をするとWriterモナド対応の関数になる
addW :: (Num a) => a -> a -> Writer [a] a
-- tell で経過を保存、returnで次の計算に結果を渡す
addW p1 p2 = tell [r] >> return r
  where
    r = p1 + p2

全部のせておく。

import Data.List(foldl')
import Debug.Trace
import Control.Monad.Writer

main = do
  print $ sum' [1..10]
  print $ sumW [1..10]
  print $ sumT [1..10]
  print =<< sumIO [1..10]


sum' :: Num a => [a] -> a
sum' xs = foldl' (+) 0 xs



sumIO :: (Num a, Show a) => [a] -> IO a
sumIO xs = foldM addIO 0 xs

addIO :: (Num a, Show a) =>  a -> a -> IO a
addIO p1 p2 = putStrLn ("r: " ++ show r) >> return r
  where
    r = p1 + p2



sumT :: (Num a, Show a) => [a] -> a
sumT xs = foldl' addT 0 xs

addT :: (Num a, Show a) => a -> a -> a
addT p1 p2 = trace ("r: " ++ show r) r
  where
    r = p1 + p2
  


sumW :: (Num a) => [a] -> (a,[a])
sumW xs = runWriter $ foldM addW 0 xs
          
addW :: (Num a) => a -> a -> Writer [a] a
addW p1 p2 = tell [r] >> return r
  where
    r = p1 + p2

window.onload = function() {
    console.log(sum1([1,2,3,4,5,6,7,8,9,10]));
    console.log(sum2([1,2,3,4,5,6,7,8,9,10]));
}

function sum1 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    }
    return r;
}

function sum2 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    console.log("r: " + r)
    }
    return r;
}

継続モナドの使い道 早期リターン

引数をチェックして、問題があれば Left に包んだエラーメッセージに、問題がなければ Right に包んだ計算結果に評価される関数を考えてみよう。
純粋な関数でもロジックを表現することは可能だが、if文のネストが深くなればなるほど地獄である。手続き型言語であれば早期リターンで書きたいところだが、関数型言語ではどうするのか。

checkName :: String -> String -> Either String String
checkName fstname famname =
  if ( length fstname == 0 )
  then Left "error: fstname is empty"
  else
    if not (isValidFirstName fstname)
    then Left "error: fstname is invalid"
    else
      if ( length famname == 0 )
      then Left "error: famname is empty"
      else
        if not (isValidFamilyName famname)
        then Left "error: famname is invalid"
        else Right $ fstname ++ " " ++ famname
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)

方法1. Eitherモナドを使う

※某所で指摘を受けたので追記。
Either モナド自体の性質を利用すれば、無尽蔵にネストが深くなっていく状況は避けることができる。場合によってはこれで十分だろう。ただ、より早期リターン風に表現したいときどうしたらよいか?

checkNameEM :: String -> String -> Either String String
checkNameEM fstname famname = do
  -- fstname 単体でチェック
  fstname' <- if ( length fstname == 0 )
              then Left "error: fstname is empty"
              else
                if not (isValidFirstName fstname)
                then Left "error: fstname is invalid"
                else Right fstname

  -- famname 単体でチェック
  famname' <- if ( length famname == 0 )
              then Left "error: famname is empty"
              else
                if not (isValidFamilyName famname)
                then Left "error: famname is invalid"
                else Right famname

  -- fstname' famname' の両方が Right の時だけ関数が評価される
  return $ fstname' ++ famname'
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)

ついでにApplicativeスタイルでの記述も載せておく。

checkNameEA :: String -> String -> Either String String
checkNameEA fstname famname = do
  -- fstname 単体でチェックした結果をEither(Left or Right)で包む
  let fstname' = if ( length fstname == 0 )
                 then Left "error: fstname is empty"
                 else
                   if not (isValidFirstName fstname)
                   then Left "error: fstname is invalid"
                   else Right fstname

  -- famname 単体でチェックした結果をEither(Left or Right)で包む
  let famname' = if ( length famname == 0 )
                 then Left "error: famname is empty"
                 else
                   if not (isValidFamilyName famname)
                   then Left "error: famname is invalid"
                   else Right famname

  -- Applicativeスタイル
  -- fstname' famname' の両方が Right の時だけ関数が評価される
  (\fst fam -> fst ++ " " ++ fam) <$> fstname' <*> famname'
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)

方法2. 継続モナドを使う

そこで継続モナド登場。純粋関数内で、早期リターンのような記述が可能となる。

checkNameC :: String -> String -> Either String String
checkNameC fstname famname = (`runCont` id) $ callCC $ \exit -> do
  when ( length fstname == 0 )
    $ exit $ Left "error: fstname is empty"

  when ( not (isValidFirstName fstname))
    $ exit $ Left "error: fstname is invalid"

  when ( length famname == 0 )
    $ exit $ Left "error: famname is empty"

  when ( not (isValidFamilyName famname))
    $ exit $ Left "error: famname is invalid"

  return $ Right $ fstname ++ " " ++ famname
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)

全部のせておく。

import Data.Char(isLower,isUpper)
import Control.Monad.Cont


checkName :: String -> String -> Either String String
checkName fstname famname =
  if ( length fstname == 0 )
  then Left "error: fstname is empty"
  else
    if not (isValidFirstName fstname)
    then Left "error: fstname is invalid"
    else
      if ( length famname == 0 )
      then Left "error: famname is empty"
      else
        if not (isValidFamilyName famname)
        then Left "error: famname is invalid"
        else Right $ fstname ++ " " ++ famname
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)



checkNameEM :: String -> String -> Either String String
checkNameEM fstname famname = do
  -- fstname 単体でチェック
  fstname' <- if ( length fstname == 0 )
              then Left "error: fstname is empty"
              else
                if not (isValidFirstName fstname)
                then Left "error: fstname is invalid"
                else Right fstname

  -- famname 単体でチェック
  famname' <- if ( length famname == 0 )
              then Left "error: famname is empty"
              else
                if not (isValidFamilyName famname)
                then Left "error: famname is invalid"
                else Right famname

  -- fstname' famname' の両方が Right の時だけ関数が評価される
  return $ fstname' ++ famname'
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)



checkNameEA :: String -> String -> Either String String
checkNameEA fstname famname = do
  -- fstname 単体でチェックした結果をEither(Left or Right)で包む
  let fstname' = if ( length fstname == 0 )
                 then Left "error: fstname is empty"
                 else
                   if not (isValidFirstName fstname)
                   then Left "error: fstname is invalid"
                   else Right fstname

  -- famname 単体でチェックした結果をEither(Left or Right)で包む
  let famname' = if ( length famname == 0 )
                 then Left "error: famname is empty"
                 else
                   if not (isValidFamilyName famname)
                   then Left "error: famname is invalid"
                   else Right famname

  -- Applicativeスタイル
  -- fstname' famname' の両方が Right の時だけ関数が評価される
  (\fst fam -> fst ++ " " ++ fam) <$> fstname' <*> famname'
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)



checkNameC :: String -> String -> Either String String
checkNameC fstname famname = (`runCont` id) $ callCC $ \exit -> do
  when ( length fstname == 0 )
    $ exit $ Left "error: fstname is empty"

  when ( not (isValidFirstName fstname))
    $ exit $ Left "error: fstname is invalid"

  when ( length famname == 0 )
    $ exit $ Left "error: famname is empty"

  when ( not (isValidFamilyName famname))
    $ exit $ Left "error: famname is invalid"

  return $ Right $ fstname ++ " " ++ famname
  where
    isValidFirstName ca = (all isLower ca)
                          && ( 4 <= length ca && length ca <= 10)
    isValidFamilyName ca = (all isUpper ca)
                           && ( 2 <= length ca && length ca <= 8)
 

自作のHaskellアプリ(AHA & Bingo)を stack 対応した話

巷で話題の Haskell のビルドツール stack だが、自作のアプリも stack でのビルドに対応してみた。

https://github.com/mitsuji/aha
https://github.com/mitsuji/bingo

stack の便利さをどう表現しようか。筆者の場合は git に出会ったときと状況が似ていると感じている。

ソースコード管理の重要さを知りながらも、cvs や subversion を「どうしても使わなければ」と思うことはなかったが、git に出会ってからは git というツールとともにソースコード管理そのものも、ちょっとしたものを作るときでもあたりまえのこととして受け入れるようになった。

stack の場合は、自分のソースをパッケージとして組むことをあたりまえのこととしてくれるツールという感じがする。

stack は 依存ライブラリと依存コンパイラ(ghc)のバージョンをまとめて解決してくれるので、とてもありがたい。 scala の sbt に 影響を受けているようだが、sbtはさすがに jdk のバージョンも管理してくれるわけではないので stack の方が上を行っていると思う。

下記のコマンドで最新のghcが入る。

$ stack setup

プロジェクトに cd して下記のコマンドでプロジェクトがビルドできる。

$ stack build

プロジェクトに cd して下記のコマンドでプロジェクト内のソースを参照しつつREPL。

$ stack ghci

プロジェクトに cd して下記のコマンドで ~/.local/bin に 実効形式がインストールされる。

$ stack install

Haskell 入門の敷居がまた下がった。

Haskell is ready for industry !

Haskell Platform や パッケージ管理システムを使わずに GHC と Cabal をインストールする – CentOS 7 編

[モチベーション]

Haskell のコンパイラのデファクトスタンダードである GHC は、わりと頻繁に新しいバージョンがリリースされている。

開発が活発なのは利用者としてはうれしいことだが、Haskell Platform や 各ディストリビューションのパッケージ管理システムを使って環境を構築していると、各バージョンのGHCを切り替えて使うことが難しく、それが作業の妨げになることがある。

GHCのバイナリパッケージを自分でインストールしてPATHの設定も自分で行っておくと各バージョンの切り替えが可能となる。

自前構築は面倒なイメージがあるが、ポイントを押さえれば意外と簡単なのでここで共有する。

今回は “CentOS 7 編”だ。x86_64版が最小構成でインストールされていると仮定する。

Haskell Platform や パッケージ管理システムを使わずに GHC と Cabal をインストールする – Debian 8 (Jessie) 編

[概要]

下記を行うための手順を示す。

1. GHCのバイナリパッケージのインストール

GHCのバイナリパッケージを /usr/local/apps/ にインストールする。
下記のように複数バージョンを保持する前提。

/usr/local/apps/ghc-7.6.3
/usr/local/apps/ghc-7.8.4
/usr/local/apps/ghc-7.10.1
/usr/local/apps/ghc-7.10.2

2. cabalコマンドのビルド

公式サイトから落としてきた cabal コマンドを使用して自前のcabalコマンドをビルドする。

[1. GHCのバイナリパッケージのインストール]

GHCのバイナリパッケージは下記のサイトで公開されている。
https://www.haskell.org/ghc/

Debian版 と CentOS版があるが、依存しているGMPライブラリのバージョンがキモとなるため、CentOS 7 では Debian版を使用する。
https://www.haskell.org/ghc/download_ghc_7_10_2#x86_64linux

gcc と perl が必要なのでインストールしておく。
gmp-devel は ghci の実行時に必要となるので一緒に入れておく。
*.tar.bz2 を解凍するために、bzip2もここでいれておく。

$ sudo yum install gcc perl gmp-devel bzip2

バイナリパッケージをダウンロードする。

$ curl -O http://downloads.haskell.org/~ghc/7.10.2/ghc-7.10.2-x86_64-unknown-linux-deb7.tar.bz2

tar ボールを解凍して、解凍先に cd する。
bzip2がないと、このときエラーになる。

$ tar jxf ghc-7.10.2-x86_64-unknown-linux-deb7.tar.bz2
$ cd ghc-7.10.2

インストール先を指定して configure する。
gcc や perl がないと、このときエラーになる。

$ ./configure --prefix=/usr/local/apps/ghc-7.10.2

管理者権限で make install

$ sudo make install

下記のように、PATHを追加する。

$ cat ~/.bash_profile
# .bash_profile

# Get the aliases and functions
if [ -f ~/.bashrc ]; then
. ~/.bashrc
fi

# User specific environment and startup programs

PATH=$PATH:$HOME/.local/bin:$HOME/bin
PATH=$PATH:/usr/local/apps/ghc-7.10.2/bin

export PATH

PATHの追加を反映。(ログインしなおしてもよい)

$ source ~/.bash_profile

ghci を起動して下記のように動作すれば成功。

$ ghci
GHCi, version 7.10.2: http://www.haskell.org/ghc/ :? for help
Prelude> 1 + 2 + 3
6
Prelude> :q
Leaving GHCi.

[2. cabalコマンドのビルド]

パッケージ名としてはCabalのライブラリがcabal、cabalコマンドがcabal-installとなっている。

cabal-installのバイナリビルドは下記のサイトで公開されているが、Linux版は32bit版のみの為、64bit環境で動作させるには、少し工夫が必要になる。
https://www.haskell.org/cabal/download.html

glibc.i686、zlib.i686、gmp.i686 は 32bit版のcabalの動作に必要なパッケージ。
zlib-devel は自前の64bit版のcabalをビルドするときに必要なのでここで入れておく。

$ sudo yum install glibc.i686 zlib.i686 gmp.i686 zlib-devel

バイナリビルドをダウンロードする。

$ curl -O https://www.haskell.org/cabal/release/cabal-install-1.22.0.0/cabal-1.22.0.0-i386-unknown-linux.tar.gz

tar ボールを解凍すると cabal という名前のファイルが生成される。これが32bit版 cabalコマンド。

$ tar zxf cabal-1.22.0.0-i386-unknown-linux.tar.gz

cabal のパッケージ情報を更新(ダウンロード)する。

$ ./cabal update

自分の cabal コマンドをビルドする。~/.cabal/bin にインストールされる。

$ ./cabal install cabal-install

下記のように、PATHを追加する。

$ cat ~/.bash_profile
# .bash_profile

# Get the aliases and functions
if [ -f ~/.bashrc ]; then
. ~/.bashrc
fi

# User specific environment and startup programs

PATH=$PATH:$HOME/.local/bin:$HOME/bin
PATH=$PATH:/usr/local/apps/ghc-7.10.2/bin
PATH=$PATH:~/.cabal/bin

export PATH

PATHの追加を反映。(ログインしなおしてもよい)

$ source ~/.bash_profile

自分の cabal が参照されれば成功。

$ which cabal
/home/administrator/.cabal/bin/cabal

Haskell Platform や パッケージ管理システムを使わずに GHC と Cabal をインストールする – Debian 8 (Jessie) 編

[モチベーション]

Haskell のコンパイラのデファクトスタンダードである GHC は、わりと頻繁に新しいバージョンがリリースされている。

開発が活発なのは利用者としてはうれしいことだが、Haskell Platform や 各ディストリビューションのパッケージ管理システムを使って環境を構築していると、各バージョンのGHCを切り替えて使うことが難しく、それが作業の妨げになることがある。

GHCのバイナリパッケージを自分でインストールしてPATHの設定も自分で行っておくと各バージョンの切り替えが可能となる。

自前構築は面倒なイメージがあるが、ポイントを押さえれば意外と簡単なのでここで共有する。

今回は “Debian 8 (Jessie) 編”だ。amd64版が最小構成でインストールされていると仮定する。

Haskell Platform や パッケージ管理システムを使わずに GHC と Cabal をインストールする – CentOS 7 編

[概要]

下記を行うための手順を示す。

1. GHCのバイナリパッケージのインストール

GHCのバイナリパッケージを /usr/local/apps/ にインストールする。
下記のように複数バージョンを保持する前提。

/usr/local/apps/ghc-7.6.3
/usr/local/apps/ghc-7.8.4
/usr/local/apps/ghc-7.10.1
/usr/local/apps/ghc-7.10.2

2. cabalコマンドのビルド

公式サイトから落としてきた cabal コマンドを使用して自前のcabalコマンドをビルドする。

[1. GHCのバイナリパッケージのインストール]

GHCのバイナリパッケージは下記のサイトで公開されている。
https://www.haskell.org/ghc/

Debian 7 (wheezy) でビルドされたものが jessie でも使える。
https://www.haskell.org/ghc/download_ghc_7_10_2#x86_64linux

gcc と make が必要なのでインストールしておく。
libgmp-dev は ghci の実行時に必要となるので一緒に入れておく。

$ sudo apt-get install gcc make libgmp-dev

バイナリパッケージをダウンロードする。

$ wget http://downloads.haskell.org/~ghc/7.10.2/ghc-7.10.2-x86_64-unknown-linux-deb7.tar.bz2

tar ボールを解凍して、解凍先に cd する。

$ tar jxf ghc-7.10.2-x86_64-unknown-linux-deb7.tar.bz2
$ cd ghc-7.10.2/

インストール先を指定して configure する。
gcc や make がないと、このときエラーになる。

$ ./configure --prefix=/usr/local/apps/ghc-7.10.2

管理者権限で make install

$ sudo make install

下記のように、PATHを追加する。

$ cat ~/.bash_profile
PATH=$PATH:/usr/local/apps/ghc-7.10.2/bin

export PATH

PATHの追加を反映。(ログインしなおしてもよい)

$ source ~/.bash_profile

ghci を起動して下記のように動作すれば成功。

$ ghci
GHCi, version 7.10.2: http://www.haskell.org/ghc/ :? for help
Prelude> 1 + 2 + 3
6
Prelude> :q
Leaving GHCi.

[2. cabalコマンドのビルド]

パッケージ名としてはCabalのライブラリがcabal、cabalコマンドがcabal-installとなっている。

cabal-installのバイナリビルドは下記のサイトで公開されているが、Linux版は32bit版のみの為、64bit環境で動作させるには、少し工夫が必要になる。
https://www.haskell.org/cabal/download.html

32bitアーキテクチャを dpkg の対象に追加してからaptを更新する。
libc6:i386、zlib1g:i386、libgmp10:i386 は32bit版のcabalの動作に必要なパッケージ。
zlib1g-dev は自前の64bit版のcabalをビルドするときに必要なのでここで入れておく。

$ sudo dpkg --add-architecture i386
$ sudo apt-get update
$ sudo apt-get install libc6:i386 zlib1g:i386 libgmp10:i386 zlib1g-dev

32bitバイナリの動作についての詳細はこちらを参照。
http://askubuntu.com/questions/454253/how-to-run-32-bit-app-in-ubuntu-64-bit

バイナリビルドをダウンロードする。

$ wget https://www.haskell.org/cabal/release/cabal-install-1.22.0.0/cabal-1.22.0.0-i386-unknown-linux.tar.gz

tar ボールを解凍すると cabal という名前のファイルが生成される。これが32bit版 cabalコマンド。

$ tar zxf cabal-1.22.0.0-i386-unknown-linux.tar.gz

cabal のパッケージ情報を更新(ダウンロード)する。

$ ./cabal update

自分の cabal コマンドをビルドする。~/.cabal/bin にインストールされる。

$ ./cabal install cabal-install

下記のように、PATHを追加する。

$ cat ~/.bash_profile

PATH=$PATH:/usr/local/apps/ghc-7.10.2/bin
PATH=$PATH:~/.cabal/bin

export PATH

PATHの追加を反映。(ログインしなおしてもよい)

$ source ~/.bash_profile

自分の cabal が参照されれば成功。

$ which cabal
/home/administrator/.cabal/bin/cabal