愛しの Lazy I/O
という問題がとりあげられていました．この問題文だけなら，grade :: Score -> Maybe Gradeという関数を書けばよさそうです．
code:haskell
type Score = Int
data Grade = A | B | C | D
instance Show Grade where
show A = "優"
show B = "良"
show C = "可"
show D = "不可"
grade :: Score -> Maybe Grade
grade x
| outRange x = Nothing
| x < 60 = Just D
| x < 70 = Just C
| x < 80 = Just B
| otherwise = Just A
outRange :: Score -> Bool
outRange = not. inRange
inRange :: Score -> Bool
inRange x = 0 <= x && x <= 100
以っ上っ！
もちろん，そんなシンプルな問題ではないのです．
点数は1つずつ標準入力から得る
点数の入力ごとに成績判定を標準出力に置く
範囲外の点数が入力されたらそれまでの成績判定毎の累積表示してプログラムを終了する
という仕様のようです．
標準入出力を使って、大域変数をループで回しながら状態を更新して最後に計算結果を出すという手続き型でよくあるタイプの問題をHaskell でどう書くか？
であり，ポイントは
I/O
成績判定の累積
をどう組み合わせるかということになっているかと思います．
ループ
I/O の反復はインペラあんちゃん風に命令プログラミング流にループを考えるのが簡単です．
まずは，素直になって(:p)ループとして書いてみましょう．ループは成績判定のカウントを持ち回すことにします．
この持ち回すデータ構造と各フィールドの増加関数を定義しておきましょう．カウントはShowのインスタンスにしておきましょう．printfを使うためには，Text.Printfをインポートする必要があります．
code:haskell
data Count = Count { nA, nB, nC, nD :: Int }
instance Show Count where
show (Count a b c d) = printf "優:%4d名 良:%4d名 可:%4d名 不可:%4d名" a b c d
zero :: Count
zero = Count 0 0 0 0
incA, incB, incC, incD :: Count -> Count
incA c = c { nA = nA c + 1 }
incB c = c { nB = nB c + 1 }
incC c = c { nC = nC c + 1 }
incD c = c { nD = nD c + 1 }
カウントの初期値はzero :: Countとしておきます．I/O の反復は loop :: Count -> IO ()でやることにしてみましょう．そうするとプログラム全体はloop zeroとなるでしょう．
code:haskell
main :: IO ()
main = loop zero
loop 以下のような反復になるでしょう．
1. プロンプトを出す
2. 入力行を読む
3. 整数に変換する
4. 成績判定する
5. 範囲外入力だったときは累積カウントを表示して，終了
6. 範囲内入力だったときは成績判定を表示する
7. カウントアップしたカウントを持って 1. へ
これをそのまま実装すると，
code:haskell
loop :: Count -> IO ()
loop c = do
{ prompt "得点？ "
; input <- getLine
; let score = read input
; let judge = grade score
; maybe (print c)
(printCountUpLoop c)
judge
}
printCountUpLoop :: Count -> Grade -> IO ()
printCountUpLoop c g = print g >> loop (countUp g c)
countUp :: Grade -> (Count -> Count)
countUp A = incA
countUp B = incB
countUp C = incC
countUp D = incD
prompt :: String -> IO ()
prompt s = putStr s >> hFlush stdout
hFulshおよびstdoutを使うにはSystem.IOをインポートしましょう．
I/O の分離
IO と条件分岐と状態の更新をなんとか分離できないもんか？
I/O をとことん分離しましょう．
I/O を含まないとすれば，まずデータは与えられているものとして，肝になるのは「得点リスト → 成績判定カウントと判定結果リストの対」の関数です．countAndGrades :: [Score] -> (Count, [Grade])というわけです．この手のカウンタのようなある種の蓄積を行うにはData.ListにあるmapAccumL :: (acc -> a -> (acc, b)) -> acc -> [a] -> (acc, [b])を使うのが便利です．
code:haskell
countAndGrades = mapAccumL countGrade zero . unfoldr phi
where
phi [] = Nothing
phi (x:xs) = bool Nothing (Just (x,xs)) (inRange x)
countGrade c s = case grade s of
Just g -> (countUp g c, g)
I/O はinteract :: (String -> String) -> IO () を使えばよさそうですね．
入力文字列を出力文字列に換える関数を作ればよいということです．
countAndGradesの結果から出力文字列を作る関数serialize :: (Count, [Grade]) -> Stringを書くことにしましょう．
code:haskell
serialize :: (Count, Grade) -> String serialize ~(c,gs)
= promptStr ++ concatMap (followedByPrompt . shows) gs ++ shows c "\n\n"
followedByPrompt :: ShowS -> String
followedByPrompt ss = ss promptStr
promptStr :: String
promptStr = "\n得点？ "
出力文字列にはプロンプトも含まれています．~(c,gs)`は遅延パターンで入力文字列を読む前にプロンプトを出すために反駁不可パターンになっています．
code:haskell
main :: IO ()
main = hSetBuffering stdout NoBuffering
> interact (serialize . countAndGrades . map read . lines)
最初のプロンプトには改行が含まれていないので，標準出力はバッファリングしないように設定しないと最初のプロンプトが出ません．
このように I/O を分離し，モジュラリティを確保できるのは，Lazy I/O のお陰です．最近ではすっかりLazy I/O は悪者あつかいでいじめられっこになっていますが，こういう良いところもあるんです．
嗚呼，愛しのLazy I/O
全体のコード
code:separatedIO.hs
module Main where
import Data.Bool
import Data.List
import System.IO
import Text.Printf
type Score = Int
data Grade = A | B | C | D
instance Show Grade where
show A = "優"
show B = "良"
show C = "可"
show D = "不可"
grade :: Score -> Maybe Grade
grade x
| outRange x = Nothing
| x < 60 = Just D
| x < 70 = Just C
| x < 80 = Just B
| otherwise = Just A
outRange :: Score -> Bool
outRange = not . inRange
inRange :: Score -> Bool
inRange x = 0 <= x && x <= 100
data Count = Count { nA, nB, nC, nD :: Int }
instance Show Count where
show (Count a b c d) = printf "｜ 優:%4d名 ｜ 良:%4d名 ｜ 可:%4d名 ｜ 不可:%4d名 ｜" a b c d
zero :: Count
zero = Count 0 0 0 0
incA, incB, incC, incD :: Count -> Count
incA c = c { nA = nA c + 1 }
incB c = c { nB = nB c + 1 }
incC c = c { nC = nC c + 1 }
incD c = c { nD = nD c + 1 }
countUp :: Grade -> (Count -> Count)
countUp A = incA
countUp B = incB
countUp C = incC
countUp D = incD
countAndGrades = mapAccumL countGrade zero . unfoldr phi
where
phi [] = Nothing
phi (x:xs) = bool Nothing (Just (x,xs)) (inRange x)
countGrade c s = case grade s of Just g -> (countUp g c, g)
selialize :: (Count, Grade) -> String selialize ~(c,gs) = promptStr ++ concatMap (followedByPrompt . shows) gs ++ shows c "\n\n"
followedByPrompt :: ShowS -> String
followedByPrompt ss = ss promptStr
promptStr :: String
promptStr = "\n得点？ "
main :: IO ()
main = hSetBuffering stdout NoBuffering
> interact (serialize . countAndGrades . map read . lines)