100マス計算のシートを生成する

haskell

パズル教室にて娘の数学的センスをベタ褒めされたものの、計算速度が遅いので100マス計算を家族でやるようにと指示を受けた。
早速、Python で100マス計算シートを HTML 形式で出力するコマンドを作成したのだが、身近に Haskeller が居るのだから Haskell で書いて添削してもらおうと思い立った。ケーキ一切れで請け負ってくれるだろうか？w;
とりあえず、添削前のコードを晒しておく。添削後には、もっと美しく高機能(例えば HTML で出力する機能が加わったり…)になる予定。

import System.Random
import System.IO
import Data.List

gen_cells :: Integer -> Integer -> IO [String]
gen_cells min max = do
    gen <- newStdGen
    return $ take 10 $ map (\n -> show n) $ randomRs (min, max) gen

i2path :: Integer -> String
i2path i = "./" ++ show i ++ ".txt"

print_table :: String -> String -> [String] -> [String] -> IO ()
print_table path method x_cells y_cells = do
    let head = concat $ intersperse " " x_cells
    let head_line = method ++ " " ++ head
    let lines = head_line : y_cells
    withFile path WriteMode $ \handle -> do
        sequence_ $ map (hPutStrLn handle) lines

mk_html' :: Integer -> String -> (Integer, Integer) -> (Integer, Integer) -> IO ()
mk_html' n method (x_min, x_max) (y_min, y_max) = do
    x_cells <- gen_cells x_min x_max
    y_cells <- gen_cells y_min y_max
    print_table (i2path n) method x_cells y_cells

mk_html :: Integer -> IO ()
mk_html n
    | n `rem` 4 == 1 = mk_html' n "＋" (1, 99) (1, 99)
    | n `rem` 4 == 2 = mk_html' n "−" (50, 99) (0, 49)
    | n `rem` 4 == 3 = mk_html' n "×" (1, 99) (0, 9)
    | otherwise      = mk_html' n "÷" (1, 99) (1, 9)

main = sequence_ $ map mk_html [1..20]

早速、リファクタして頂いたのでコードを公開

{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
import System.Random
import System.FilePath
import System.IO
import Data.List
import Control.Applicative
import Text.Hamlet
import Text.Blaze.Html.Renderer.String
import Text.Blaze

data Method = Plus | Minus | Mult | Div
type Range = (Integer, Integer)
type Cells = [Integer]
type Answers a = [[a]]

get_calc_fun :: Method -> Integer -> Integer -> Integer
get_calc_fun Plus  = (+)
get_calc_fun Minus = (-)
get_calc_fun Mult  = (*)
get_calc_fun Div   = div

method2str :: Method -> String
method2str Plus  = "＋"
method2str Minus = "−"
method2str Mult  = "×"
method2str Div   = "÷"

gen_cells :: Range -> IO Cells
gen_cells range = (take 10 . randomRs range) <$> newStdGen

calc_answer :: Method -> Cells -> Cells -> Answers Integer
calc_answer method x_cells y_cells = let f = get_calc_fun method in
    [[f x y | x <- x_cells] | y <- y_cells]

null_answer :: Answers Integer -> Answers String
null_answer answers = map (map (const "")) answers

i2path :: String -> Integer -> FilePath
i2path p i = "." </> (p ++ show i) <.> "html"

-- Integer や String は ToMarkup のインスタンス
print_table :: ToMarkup a => FilePath -> Method -> Cells -> Cells -> Answers a -> IO ()
print_table path method x_cells y_cells answers = do
    let rows = zip y_cells answers
    writeFile path $ renderHtml [shamlet|
!!!
<head>
  <title>100cells
<body>
  <table>
    <tr>
      <th>#{method2str method}
      $forall x <- x_cells
        <th>#{x}
    $forall (y, zs) <- rows
      <tr>
        <th>#{y}
        $forall z <- zs
          <td>#{z}
    |]

mk_html' :: Integer -> Method -> Range -> Range-> IO ()
mk_html' n method x_range y_range = do
    x_cells <- gen_cells x_range
    y_cells <- gen_cells y_range
    let answers = calc_answer method x_cells y_cells
    print_table (i2path "a" n) method x_cells y_cells answers
    print_table (i2path "p" n) method x_cells y_cells $ null_answer answers

mk_html :: Integer -> IO ()
mk_html n
    | n `rem` 4 == 1 = mk_html' n Plus  ( 1, 99) (1, 99)
    | n `rem` 4 == 2 = mk_html' n Minus (50, 99) (0, 49)
    | n `rem` 4 == 3 = mk_html' n Mult  ( 1, 99) (0,  9)
    | otherwise      = mk_html' n Div   ( 1, 99) (1,  9)

main = mapM_ mk_html [1..20]