Haskell(wai) による Webアプリケーション開発の実際

2016年12月追記: この記事のDB(MySQL)編はこちら

wai(Haskell製のWebアプリケーション規格)に準拠し、warp(wai準拠のHaskell製Webサーバ)上で動作するWebアプリケーションの開発手順をまとめる。基本性能を際立たせるため、便利なフレームワークはあえて使用しない。

1. サンプルアプリケーションの概要

サーバの現在時刻をクライアント側で装飾して表示するWebアプリケーション。動作サンプルは下記を参照。

http://mitsuji.org:9997/

このアプリケーションは、下記のエンドポイントからなる。

  • /posixtime — GETでサーバの現在のUNIX時間(ミリ秒単位)を返す。
  • /main.html — 画面のHTML。クライアント側のエントリポイント。
  • /main.js — main.html で読み込まれる JavaScript。posixtime をGETして装飾してから画面に表示する。

2. 開発環境(stack) の準備

下記から stack をダウンロードしてインストールする。解凍してPATHを通すだけでよい。

http://docs.haskellstack.org/en/stable/README.html

下記のようにバージョンが表示できれば準備完了。

$ stack --version
Version 1.0.2, Git revision fa09a980d8bb3df88b2a9193cd9bf84cc6c419b3 (3084 commits) x86_64

3. サンプルアプリケーションのコードの取得

コードは下記に置いてある。

https://github.com/mitsuji/wai-example

ソースコードを clone して、

$ git clone https://github.com/mitsuji/wai-example.git
Cloning into 'wai-example'...
remote: Counting objects: 12, done.
remote: Compressing objects: 100% (10/10), done.
remote: Total 12 (delta 0), reused 12 (delta 0), pack-reused 0
Unpacking objects: 100% (12/12), done.
Checking connectivity... done.

ディレクトリに cd してから、

$ cd wai-example/

下記のコマンドを叩くとghc(Haskellのコンパイラ)などの環境が自動的に準備される。いろいろとダウンロードされるため、初めての時は少し時間がかかるかもしれない。

$ stack setup

ディレクトリ内のファイルのうち、開発に直接関係があるのは下記の三つだけである。

  • app/Main.hs — Webアプリケーション本体のソースコード。
  • static/main.html — Webアプリケーション動作時にアクセス可能となる main.html そのもの。
  • static/main.js — Webアプリケーション動作時にアクセス可能となる main.js そのもの。

4. REPL(ghci) を使用した動作確認

下記のコマンドでHaskell の REPL である ghci に入ることが出来る。

$ stack ghci
The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
Using main module: 1. Package `wai-example' component exe:wai-example-exe with main-is file: /home/mitsuji/Downloads/hoge/wai-example/app/Main.hs
Configuring GHCi with the following packages: wai-example
GHCi, version 7.10.2: http://www.haskell.org/ghc/  😕 for help
[1 of 1] Compiling Main             ( /home/mitsuji/Downloads/hoge/wai-example/app/Main.hs, interpreted )
Ok, modules loaded: Main.
*Main>

REPLを使用すると、ソースコード内の関数を直接評価することが出来る。例えば、Main.hs内のこの関数は

getPOSIXTime' :: IO Int
getPOSIXTime' = do
  pt_seconds <- getPOSIXTime
  return $ truncate $ pt_seconds * 1000

このようにして直接評価してみることが出来る。

*Main> getPOSIXTime'
1455622245689

ソースコードを書き換えたときは、下記のようにしてリロードすれば変更が反映される。

*Main> :l app/Main.hs
[1 of 1] Compiling Main             ( app/Main.hs, interpreted )
Ok, modules loaded: Main.

また、下記のようにしてコマンドラインパラメータ付きでmain関数を評価することもできる。この場合はWebサーバが実際に起動する。

*Main> :main 0.0.0.0 9999

ここで、Main.hs 内の関数を見てみよう。

main は Haskell のプログラムのエントリポイントとなる関数であり、プロセス起動時に最初に評価される。ここでは、コマンドラインパラメータからWebサーバの待ち受けIPアドレスとポート番号を取得して、warp を起動している。HTTPリクエスト発生時に評価される関数には routerApp が指定されている。

main :: IO ()
main = do
  host:port:_ <- getArgs
  Warp.runSettings (
    Warp.setHost (fromString host) $
    Warp.setPort (read port) $
    Warp.defaultSettings
    ) $ routerApp

routerApp ではリクエストされたURLを元に評価する関数を振り分けている。/posixtime がリクエストされれば dateAppが、それ以外がリクエストされれば staticApp が評価される。

routerApp :: Wai.Application
routerApp req respond
  | (["posixtime"] == path) = dateApp   req respond
  | otherwise               = staticApp req respond -- static html/js/css files
  where
    path = Wai.pathInfo req

dateApp は リクエスト毎にその時点でのサーバーの時刻をレスポンスとして返している。Int型で得られるUNIX時間をレスポンスとして返すため、Int => String => Text => ByteString(strict) => ByteString(lazy) の変換が行われている。

dateApp :: Wai.Application
dateApp req respond = do
  pt_milliseconds <- getPOSIXTime'
  let pt_lbs = LBS.fromStrict $ encodeUtf8 $ T.pack $ show $ pt_milliseconds
  respond $ Wai.responseLBS H.status200 [("Content-Type","text/plain")] pt_lbs

staticApp は main.html や main.js を レスポンスとして返すための、通常のWebファイルサーバである。ここでは、staticディレクトリ以下のファイルを処理対象としている。

staticApp :: Wai.Application
staticApp = Static.staticApp $ settings { Static.ssIndices = indices }
  where
    settings = Static.defaultWebAppSettings "static"
    indices = fromJust $ toPieces ["main.html"] -- default content

通常のWebファイルサーバであるため、Webアプリケーション動作中はコンパイルや再起動を行わなくても main.html や main.js を編集すれば次回リクエスト時に変更が反映される。

5. runghc を使用した動作確認

REPLに入らずに動作確認したいときは、下記のようにしてmain関数を評価することもできる。Haskellでは、スクリプト的な使い方も可能となっているのである。

$ stack runghc app/Main.hs 0.0.0.0 9999

6. ghc を使用した実行形式バイナリのビルド

下記のコマンドで実行形式バイナリがビルド(コンパイル)され、

$ stack build

下記のコマンドでインストールされ

$ stack install

~/.local/bin/wai-example-exe が生成される。実行形式バイナリの動作確認は下記のようにして行うことができるだろう。

 $ ~/.local/bin/wai-example-exe 0.0.0.0 9999

wai(Webアプリケーションライブラリ)やwarp(Webサーバ)を含むすべてのライブラリがwai-example-exeに静的にリンクされるため、wai-example-exe と staticディレクトリ を ビルド環境と同一アーキテクチャ、同一OSのマシンにコピーすればそのまま動作する。

この時、カレントディレクトリ配下の static ディレクトリ内のファイルが静的Webコンテンツとして参照されるが、ビルド時に settings を下記のように書き換えると、staticディレクトリ内のファイルを実行形式バイナリにすべて埋め込むことができる。静的Webコンテンツも含め、Webアプリケーションを一つのファイルにまとめることができるので、場合によってはとても便利である。

staticApp :: Wai.Application
staticApp = Static.staticApp $ settings { Static.ssIndices = indices }
  where
    settings = Static.embeddedSettings $(embedDir "static")
    indices = fromJust $ toPieces ["main.html"] -- default content

7. まとめ

  • Haskell の 環境構築は stack を使えば超簡単。
  • 一つのソースコードをまったく書き換えることなく REPL、スクリプト、実行形式バイナリの三態から利用可能。
  • WebアプリケーションとWebサーバが一体のため、実行形式バイナリをフロントエンドエンジニア や Webデザイナー に渡せばそのまま開発環境として使ってもらえる。
  • 実行形式バイナリでデプロイすれば、本番に必要な依存環境を最小化できるため、Vagrant や Docker などの環境構築ツールに頼らなくてよい。
  • 静的Webコンテンツを実行形式バイナリに埋め込めば、より安全確実なバージョン管理とデプロイが可能に。

8. おまけ

筆者の利用実績はないが、IDE とか欲しい人向けの情報。

  • Leksah -- Haskell で作られた Haskell用 IDE。
  • Haskell for Mac -- Mac向け。本格的な開発ができるかは不明だけど楽しそう。
  • haskell-idea-plugin -- IntelliJ用 のプラグイン。

Eitherモナドの使い道 部分的な失敗を全体的な失敗とする計算(2)

※この記事のMaybe編はこちら

idと名前のデータベースと、順位とidのデータベースからなる、下記のようなフレームワークを考えてみよう。

2位の名前を取り出すには、idFromRank で 2位のidを取り出し、その id を nameFromId に渡して名前を得るものとする。
idFromRank も nameFromId も要求された順位やidのデータがなければ Left に評価されるものとする。


type Err = String
type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Either Err ID
idFromRank db rk =
  case lookup rk db of
    Nothing -> Left $ "id of rank " ++ (show rk) ++ " was not found."
    Just id -> Right id

nameFromId :: NameDB -> ID -> Either Err Name
nameFromId db id =
  case lookup id db of
    Nothing   -> Left $ "name of id " ++ (show id) ++ " was not found."
    Just name -> Right name

このフレームワークを使って、上位3位の名前を取得する関数を作成してみよう。
ポイントは、idFromRank も nameFromId も Left に評価されることがあるため、この関数もEither型に評価されるものとし、1位から3位までのidがすべて存在し、それらの名前がすべて存在する場合のみRightに評価され、それ以外のときはLeftに評価されるようにすることだ。

下記のように呼び出されるようになればよいだろう。

main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]

式を使ったプログラミングで素直に記述する場合、筆者の能力では下記の記述が限界である。
これはどう考えても地獄である。我々が関数プログラミングに求めていたものはこんなものではなかったはずだ。

topThree :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThree rdb ndb =
  let eitherId1 = idFromRank rdb 1
  in
   if isLeft eitherId1 then Left $ fromLeft eitherId1
   else
     let eitherName1 = nameFromId ndb $ fromRight eitherId1
     in
      if isLeft eitherName1 then Left $ fromLeft eitherName1
      else
        let eitherId2 = idFromRank rdb 2
        in
         if isLeft eitherId2 then Left $ fromLeft eitherId2
         else
           let eitherName2 = nameFromId ndb $ fromRight eitherId2
           in
            if isLeft eitherName2 then Left $ fromLeft eitherName2
            else
              let eitherId3 = idFromRank rdb 3
              in
               if isLeft eitherId3 then Left $ fromLeft eitherId3
               else
                 let eitherName3 = nameFromId ndb $ fromRight eitherId3
                 in
                  if isLeft eitherName3 then Left $ fromLeft eitherName3
                  else Right (
                    fromRight eitherName1,
                    fromRight eitherName2,
                    fromRight eitherName3
                    )
  where
    fromLeft (Left x) = x 
    fromRight (Right x) = x

Haskell には case 文があるので、効果的に使えば下記のように改善することができる。
しかし case 文の入れ子も本質的には地獄である。こんなことなら手続き型言語を使えばよいのではないか。

topThreeC :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Left e -> Left e
    Right id1 -> case nameFromId ndb id1 of
      Left e -> Left e
      Right n1 -> case idFromRank rdb 2 of
        Left e -> Left e
        Right id2 -> case nameFromId ndb id2 of
          Left e -> Left e
          Right n2 -> case idFromRank rdb 3 of
            Left e -> Left e
            Right id3 -> case nameFromId ndb id3 of
              Left e -> Left e
              Right n3 -> Right (n1,n2,n3)

そこで Eitherモナド登場。
Either型のモナドとしての性質を使うと、上記とまったく同じ意味の関数を下記の内容だけで記述することができる。
モナドとしてのEither型には、失敗するかもしれない計算どうしを組み合わせるときは、一部でも失敗したらすべてが失敗したことにする
という性質が最初から組み込まれているためである。

topThreeM :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)

全部のせておく。

import Data.Either (isLeft)

type Err = String
type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Either Err ID
idFromRank db rk =
  case lookup rk db of
    Nothing -> Left $ "id of rank " ++ (show rk) ++ " was not found."
    Just id -> Right id

nameFromId :: NameDB -> ID -> Either Err Name
nameFromId db id =
  case lookup id db of
    Nothing   -> Left $ "name of id " ++ (show id) ++ " was not found."
    Just name -> Right name




topThree :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThree rdb ndb =
  let eitherId1 = idFromRank rdb 1
  in
   if isLeft eitherId1 then Left $ fromLeft eitherId1
   else
     let eitherName1 = nameFromId ndb $ fromRight eitherId1
     in
      if isLeft eitherName1 then Left $ fromLeft eitherName1
      else
        let eitherId2 = idFromRank rdb 2
        in
         if isLeft eitherId2 then Left $ fromLeft eitherId2
         else
           let eitherName2 = nameFromId ndb $ fromRight eitherId2
           in
            if isLeft eitherName2 then Left $ fromLeft eitherName2
            else
              let eitherId3 = idFromRank rdb 3
              in
               if isLeft eitherId3 then Left $ fromLeft eitherId3
               else
                 let eitherName3 = nameFromId ndb $ fromRight eitherId3
                 in
                  if isLeft eitherName3 then Left $ fromLeft eitherName3
                  else Right (
                    fromRight eitherName1,
                    fromRight eitherName2,
                    fromRight eitherName3
                    )
  where
    fromLeft (Left x) = x 
    fromRight (Right x) = x



topThreeC :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Left e -> Left e
    Right id1 -> case nameFromId ndb id1 of
      Left e -> Left e
      Right n1 -> case idFromRank rdb 2 of
        Left e -> Left e
        Right id2 -> case nameFromId ndb id2 of
          Left e -> Left e
          Right n2 -> case idFromRank rdb 3 of
            Left e -> Left e
            Right id3 -> case nameFromId ndb id3 of
              Left e -> Left e
              Right n3 -> Right (n1,n2,n3)



topThreeM :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)




main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]

Maybeモナドの使い道 部分的な失敗を全体的な失敗とする計算(1)

※この記事のEither編はこちら

idと名前のデータベースと、順位とidのデータベースからなる、下記のようなフレームワークを考えてみよう。

2位の名前を取り出すには、idFromRank で 2位のidを取り出し、その id を nameFromId に渡して名前を得るものとする。
idFromRank も nameFromId も要求された順位やidのデータがなければ Nothing に評価されるものとする。

type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Maybe ID
idFromRank db rk = lookup rk db

nameFromId :: NameDB -> ID -> Maybe Name
nameFromId db id = lookup id db

このフレームワークを使って、上位3位の名前を取得する関数を作成してみよう。
ポイントは、idFromRank も nameFromId も Nothing に評価されることがあるため、この関数もMaybe型に評価されるものとし、1位から3位までのidがすべて存在し、それらの名前がすべて存在する場合のみJustに評価され、それ以外のときはNothingに評価されるようにすることだ。

下記のように呼び出されるようになればよいだろう。

main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]

式を使ったプログラミングで素直に記述する場合、筆者の能力では下記の記述が限界である。
これはどう考えても地獄である。我々が関数プログラミングに求めていたものはこんなものではなかったはずだ。

topThree :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThree rdb ndb =
  let maybeId1 = idFromRank rdb 1
  in
   if isNothing maybeId1 then Nothing
   else
     let maybeName1 = nameFromId ndb $ fromJust maybeId1
     in
      if isNothing maybeName1 then Nothing
      else
        let maybeId2 = idFromRank rdb 2
        in
         if isNothing maybeId2 then Nothing
         else
           let maybeName2 = nameFromId ndb $ fromJust maybeId2
           in
            if isNothing maybeName2 then Nothing
            else
              let maybeId3 = idFromRank rdb 3
              in
               if isNothing maybeId3 then Nothing
               else
                 let maybeName3 = nameFromId ndb $ fromJust maybeId3
                 in
                  if isNothing maybeName3 then Nothing
                  else Just (
                    fromJust maybeName1,
                    fromJust maybeName2,
                    fromJust maybeName3
                    )

Haskell には case 文があるので、効果的に使えば下記のように改善することができる。
しかし case 文の入れ子も本質的には地獄である。こんなことなら手続き型言語を使えばよいのではないか。

topThreeC :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Nothing -> Nothing
    Just id1 -> case nameFromId ndb id1 of
      Nothing -> Nothing
      Just n1 -> case idFromRank rdb 2 of
        Nothing -> Nothing
        Just id2 -> case nameFromId ndb id2 of
          Nothing -> Nothing
          Just n2 -> case idFromRank rdb 3 of
            Nothing -> Nothing
            Just id3 -> case nameFromId ndb id3 of
              Nothing -> Nothing
              Just n3 -> Just (n1,n2,n3)


そこで Maybeモナド登場。
Maybe型のモナドとしての性質を使うと、上記とまったく同じ意味の関数を下記の内容だけで記述することができる。
モナドとしてのMaybe型には、失敗するかもしれない計算どうしを組み合わせるときは、一部でも失敗したらすべてが失敗したことにする
という性質が最初から組み込まれているためである。

topThreeM :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)

全部のせておく。

import Data.Maybe (isNothing,fromJust)

type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Maybe ID
idFromRank db rk = lookup rk db

nameFromId :: NameDB -> ID -> Maybe Name
nameFromId db id = lookup id db




topThree :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThree rdb ndb =
  let maybeId1 = idFromRank rdb 1
  in
   if isNothing maybeId1 then Nothing
   else
     let maybeName1 = nameFromId ndb $ fromJust maybeId1
     in
      if isNothing maybeName1 then Nothing
      else
        let maybeId2 = idFromRank rdb 2
        in
         if isNothing maybeId2 then Nothing
         else
           let maybeName2 = nameFromId ndb $ fromJust maybeId2
           in
            if isNothing maybeName2 then Nothing
            else
              let maybeId3 = idFromRank rdb 3
              in
               if isNothing maybeId3 then Nothing
               else
                 let maybeName3 = nameFromId ndb $ fromJust maybeId3
                 in
                  if isNothing maybeName3 then Nothing
                  else Just (
                    fromJust maybeName1,
                    fromJust maybeName2,
                    fromJust maybeName3
                    )
                                   


topThreeC :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Nothing -> Nothing
    Just id1 -> case nameFromId ndb id1 of
      Nothing -> Nothing
      Just n1 -> case idFromRank rdb 2 of
        Nothing -> Nothing
        Just id2 -> case nameFromId ndb id2 of
          Nothing -> Nothing
          Just n2 -> case idFromRank rdb 3 of
            Nothing -> Nothing
            Just id3 -> case nameFromId ndb id3 of
              Nothing -> Nothing
              Just n3 -> Just (n1,n2,n3)



topThreeM :: RankDB -> NameDB -> Maybe (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)




main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]



Readerモナドの使い道 仮想グローバル変数

現実的かどうかはさておき、税込み価格の商品と税抜き価格の商品が混在している店を考えてみよう。
会計の都合上、購入金額の合計を計算するときは、一旦すべての単価を税抜きに揃えてから集計し、まとめて税額を計算する必要があるものとする。

合計を計算するコードは下記のようになりそうだ。
このコードを眺めていると、toTaxIncluded と fromTaxIncluded の 引数 taxRate を消したくなってくるだろう。
ほぼ定数のようなものであり、合計の計算とは本質的に関係のない要素であるためだ。

main = do
  print $ total  0.08 [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]


toTaxIncluded :: Float -> Float -> Float
toTaxIncluded taxRate price = price * (1.00 + taxRate)

fromTaxIncluded :: Float -> Float -> Float
fromTaxIncluded taxRate tiPrice = tiPrice / (1.00 + taxRate)

total :: Float -> [(Float,Bool,Int)] -> Float
total taxRate xs =
  let subTotal = foldl' step 0.0 xs
  in toTaxIncluded taxRate subTotal
  where
    step acc (price,taxin,quan) = acc + (unitPrice taxin price) * (fromIntegral quan)
    unitPrice taxin = if taxin
                      then fromTaxIncluded taxRate
                      else id


そこでコードを下記のように改善してみよう。taxRate が引数から消えてすっきりした。
Haskell のコードをスクリプトとして使用している場合はこれで十分だろう。
ただ、一旦コンパイルされてしまうと、toTaxIncludedG と fromTaxIncludedG が使用する税率は固定されてしまう。

main = do
  print $ totalG      [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]


taxRateG :: Float
taxRateG = 0.08

toTaxIncludedG :: Float -> Float
toTaxIncludedG price = price * (1.00 + taxRateG)

fromTaxIncludedG :: Float -> Float
fromTaxIncludedG tiPrice = tiPrice / (1.00 + taxRateG)

totalG :: [(Float,Bool,Int)] -> Float
totalG xs =
  let subTotal = foldl' step 0.0 xs
  in toTaxIncludedG subTotal
  where
    step acc (price,taxin,quan) = acc + (unitPrice taxin price) * (fromIntegral quan)
    unitPrice taxin = if taxin
                      then fromTaxIncludedG
                      else id


そこでReaderモナド登場。Readerモナドを使用すると、手続き型プログラミングでグローバル変数として保持したいような要素を、自然に保持することができる。
runReader関数 の 第2引数で指定した値を、モナド内の任意の関数内で ask 関数を使用して取り出すことができる。

main = do
  print $ totalR 0.08 [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]



toTaxIncludedR :: Float -> Reader Float Float
toTaxIncludedR price = do
  taxRate <- ask
  return $ price * (1.00 + taxRate)

fromTaxIncludedR :: Float -> Reader Float Float
fromTaxIncludedR tiPrice = do
  taxRate <- ask
  return $ tiPrice / (1.00 + taxRate)
  
totalR :: Float -> [(Float,Bool,Int)] -> Float
totalR taxRate xs = (`runReader` taxRate) $ do
  subTotal <- foldM step 0.0 xs
  toTaxIncludedR subTotal
  where
    step :: Float -> (Float,Bool,Int) -> Reader Float Float
    step acc (price,taxin,quan) = do
      up <- unitPrice taxin price
      return $ acc + up * (fromIntegral quan)
  
    unitPrice taxin = if taxin
                      then fromTaxIncludedR
                      else return


全部のせておく。

import Data.List (foldl')
import Control.Monad.Reader (Reader,runReader,ask)
import Control.Monad (foldM)


main = do
  print $ total  0.08 [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]
  print $ totalG      [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]
  print $ totalR 0.08 [(108,True,2),(200,False,1),(324,True,2),(400,False,1)]



toTaxIncluded :: Float -> Float -> Float
toTaxIncluded taxRate price = price * (1.00 + taxRate)

fromTaxIncluded :: Float -> Float -> Float
fromTaxIncluded taxRate tiPrice = tiPrice / (1.00 + taxRate)

total :: Float -> [(Float,Bool,Int)] -> Float
total taxRate xs =
  let subTotal = foldl' step 0.0 xs
  in toTaxIncluded taxRate subTotal
  where
    step acc (price,taxin,quan) = acc + (unitPrice taxin price) * (fromIntegral quan)
    unitPrice taxin = if taxin
                      then fromTaxIncluded taxRate
                      else id



taxRateG :: Float
taxRateG = 0.08

toTaxIncludedG :: Float -> Float
toTaxIncludedG price = price * (1.00 + taxRateG)

fromTaxIncludedG :: Float -> Float
fromTaxIncludedG tiPrice = tiPrice / (1.00 + taxRateG)

totalG :: [(Float,Bool,Int)] -> Float
totalG xs =
  let subTotal = foldl' step 0.0 xs
  in toTaxIncludedG subTotal
  where
    step acc (price,taxin,quan) = acc + (unitPrice taxin price) * (fromIntegral quan)
    unitPrice taxin = if taxin
                      then fromTaxIncludedG
                      else id



toTaxIncludedR :: Float -> Reader Float Float
toTaxIncludedR price = do
  taxRate <- ask
  return $ price * (1.00 + taxRate)

fromTaxIncludedR :: Float -> Reader Float Float
fromTaxIncludedR tiPrice = do
  taxRate <- ask
  return $ tiPrice / (1.00 + taxRate)
  
totalR :: Float -> [(Float,Bool,Int)] -> Float
totalR taxRate xs = (`runReader` taxRate) $ do
  subTotal <- foldM step 0.0 xs
  toTaxIncludedR subTotal
  where
    step :: Float -> (Float,Bool,Int) -> Reader Float Float
    step acc (price,taxin,quan) = do
      up <- unitPrice taxin price
      return $ acc + up * (fromIntegral quan)
  
    unitPrice taxin = if taxin
                      then fromTaxIncludedR
                      else return


Stateモナドの使い道 純粋関数内で状態を扱う

System.Random について調べるコードを考えてみよう。
0から9までのランダムな整数を繰り返し生成するとき、最初に5が現れるのが何回目か知りたいとする。

System.Random には randomRs という関数があり、型と範囲と乱数生成器を指定すると、ランダムな値の無限リストに評価される。
この関数とリストを操作する関数を使えば、下記のようにすっきり記述できる。

場合によってはこれで十分だろう。ただ、処理効率や可読性の面で、より手続き型に近い記述にしたい場面がありそうだ。

count :: R.RandomGen g => g -> Int -> Int
count g n = length $ takeWhile (/=n) $ R.randomRs (0::Int,9) g

--
-- trace version
--
count' :: R.RandomGen g => g -> Int -> Int
count' g n = length $ takeWhile (\x -> trace ("x: " ++ show x) (x/=n)) $ R.randomRs (0::Int,9) g


方法1. Stateモナドを使う

System.Random には randomR という関数があり、型と範囲と乱数生成器を指定すると、ランダムな値と新しい乱数生成器の組に評価される。randomRs の単発版である。

execState は初期状態と Stateモナドを使用する関数を指定すると、終了状態に評価される関数だ。
Stateモナドは、副作用を扱うという点ではIOモナドと似ているが、純粋関数内に閉じ込められる点が異なる。
Stateモナド内で現在の状態を得るにはgetを、状態を更新するにはputを使用する。


countState :: R.RandomGen g => g -> Int -> Int
countState g n = snd $ execState loop (g,0)
  where
    loop :: R.RandomGen g => State (g,Int) ()
    loop = do
      (g,i) <- get
      let (x,g') = R.randomR (0::Int,9) g
      when (x/=n) $ put (g',i+1) >> loop -- n と同じ値が出るまで、状態を書き換えて繰り返す

--
-- trace version
--
countState' :: R.RandomGen g => g -> Int -> Int
countState' g n = snd $ execState loop (g,0)
  where
    loop :: R.RandomGen g => State (g,Int) ()
    loop = do
      (g,i) <- get
      let (x,g') = R.randomR (0::Int,9) g
      when (trace ("x: " ++ show x) (x/=n)) $ put (g',i+1) >> loop

方法2. STモナドを使う

また、IOモナドから入出力に関する機能を取り除き、純粋関数内で評価できるようにした、STモナドも使用できる。
IOモナド内で IORef を使用する感覚で STモナド内で使用できる STRefという型があり、状態を保持することができる。
STRef は 複数作成しても良いので状態の管理が複雑なときは便利かもしれない。


countST :: R.RandomGen g => g -> Int -> Int
countST g n = runST $ do
  ref <- newSTRef (g,0)
  loop ref
  (_,i) <- readSTRef ref -- 繰り返した回数を取り出して報告
  return i
    where
      loop :: R.RandomGen g => STRef s (g,Int) -> ST s ()
      loop ref = do
        (g,i) <- readSTRef ref
        let (x,g') = R.randomR (0::Int,9) g
        when (x/=n) $ writeSTRef ref (g',i+1) >> loop ref -- n と同じ値が出るまで、状態を書き換えて繰り返す

--
-- trace version
--
countST' :: R.RandomGen g => g -> Int -> Int
countST' g n = runST $ do
  ref <- newSTRef (g,0)
  loop ref
  (_,i) <- readSTRef ref
  return i
    where
      loop :: R.RandomGen g => STRef s (g,Int) -> ST s ()
      loop ref = do
        (g,i) <- readSTRef ref
        let (x,g') = R.randomR (0::Int,9) g
        when (trace ("x: " ++ show x) (x/=n)) $ writeSTRef ref (g',i+1) >> loop ref

全部のせておく。

import qualified System.Random as R
import Debug.Trace (trace)

import Control.Monad (when)
import Control.Monad.State(State,execState,get,put)
import Control.Monad.ST(ST,runST)
import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)


main = do
  g <- R.newStdGen
  print $ count g 5
  print $ countState g 5
  print $ countST g 5
  print $ count' g 5
  print $ countState' g 5
  print $ countST' g 5



count :: R.RandomGen g => g -> Int -> Int
count g n = length $ takeWhile (/=n) $ R.randomRs (0::Int,9) g

--
-- trace version
--
count' :: R.RandomGen g => g -> Int -> Int
count' g n = length $ takeWhile (\x -> trace ("x: " ++ show x) (x/=n)) $ R.randomRs (0::Int,9) g



countState :: R.RandomGen g => g -> Int -> Int
countState g n = snd $ execState loop (g,0)
  where
    loop :: R.RandomGen g => State (g,Int) ()
    loop = do
      (g,i) <- get
      let (x,g') = R.randomR (0::Int,9) g
      when (x/=n) $ put (g',i+1) >> loop

--
-- trace version
--
countState' :: R.RandomGen g => g -> Int -> Int
countState' g n = snd $ execState loop (g,0)
  where
    loop :: R.RandomGen g => State (g,Int) ()
    loop = do
      (g,i) <- get
      let (x,g') = R.randomR (0::Int,9) g
      when (trace ("x: " ++ show x) (x/=n)) $ put (g',i+1) >> loop
      


countST :: R.RandomGen g => g -> Int -> Int
countST g n = runST $ do
  ref <- newSTRef (g,0)
  loop ref
  (_,i) <- readSTRef ref
  return i
    where
      loop :: R.RandomGen g => STRef s (g,Int) -> ST s ()
      loop ref = do
        (g,i) <- readSTRef ref
        let (x,g') = R.randomR (0::Int,9) g
        when (x/=n) $ writeSTRef ref (g',i+1) >> loop ref

--
-- trace version
--
countST' :: R.RandomGen g => g -> Int -> Int
countST' g n = runST $ do
  ref <- newSTRef (g,0)
  loop ref
  (_,i) <- readSTRef ref
  return i
    where
      loop :: R.RandomGen g => STRef s (g,Int) -> ST s ()
      loop ref = do
        (g,i) <- readSTRef ref
        let (x,g') = R.randomR (0::Int,9) g
        when (trace ("x: " ++ show x) (x/=n)) $ writeSTRef ref (g',i+1) >> loop ref

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