Haskellで同じ曜日の日付を何週分も生成する

こういう感じのことがやりたい.

> DateCreate.exe -f 2015-07-06 14
2015.04.06 01
2015.04.13 02
2015.04.20 03
2015.04.27 04
2015.05.04 05
2015.05.11 06
2015.05.18 07
2015.05.25 08
2015.06.01 09
2015.06.08 10
2015.06.15 11
2015.06.22 12
2015.06.29 13
2015.07.06 14

とりあえずコード.

import Data.Time.Calendar (Day, addDays)
import Data.Time.Format (formatTime, readTime)
import Text.Printf (printf)
import System.Locale (defaultTimeLocale)
import System.Environment (getArgs)


help :: IO ()
help = do
  mapM_ putStrLn
    [ "The available commands are as follows:"
    , "-f   [Final Date (YYYY-MM-DD)] [Number of Weeks]"
    , "-i [Initial Date (YYYY-MM-DD)] [Number of Weeks]"
    ]

dispatch :: String -> [String] -> IO ()
dispatch command = case command of
         "-f" -> dateCreate command
         "-i" -> dateCreate command
         _    -> help'
  where help' _ = help

main :: IO ()
main = do
  args <- getArgs
  case args of
    command:argList -> dispatch command argList
    []              -> help

dateCreate :: String -> [String] -> IO ()
dateCreate command (date':weekNum':_) = do
  let weekNum = read weekNum'
      initDate = if command == "-f"
        then finalDateToInitDate givenDate weekNum
        else givenDate
          where givenDate = formatInput date'
  putStr $ unlines $ zipDateAndNum initDate weekNum
dateCreate _ _ = help

-- time-1.5以降はreadTimeじゃなくてparseTimeOrError True 推奨らしい
formatInput :: String -> Day
formatInput = readTime defaultTimeLocale "%F"

formatOutput :: Day -> String
formatOutput = formatTime defaultTimeLocale "%Y.%m.%d"

-- リストの構築を昇順でやりたいので, 古い日付を直接生成する
finalDateToInitDate :: Day -> Int -> Day
finalDateToInitDate date num = addDays ((-7) * (toInteger num -1)) date

zipDateAndNum :: Day -> Int -> [String]
zipDateAndNum initDate weekNum
  = zipWith (\d n -> concat [d, " ", n])
  ( map formatOutput $ generateDates initDate weekNum)
  ( map (showZeroPadding $ digit weekNum) [1..weekNum])

showZeroPadding :: Int -> Int -> String
showZeroPadding fieldWidth num = printf "%0*d" fieldWidth num

generateDates :: Day -> Int -> [Day]
generateDates initDate num = take num $ iterate nextWeek initDate
  where nextWeek = addDays 7

digit :: (Integral a) => a -> a
digit n
  | n <  0 = digit $ (-1)*n
  | n == 0 = 1
  | n >  0 = (1+) . floor . (logBase 10)
           . (fromIntegral :: (Integral a) => a -> Float) $ n
  | otherwise = error "Should not be here."

2015.07.08 追記

上記のdigit関数はdateCreateの中で使う分には問題ないが,
汎用に使おうと思うとバグがあるので修正記事を書いた.

コメント的な

コード冒頭はコマンドラインオプションの制御.
すごいHaskell本のP.195あたりのdispatchパターンを参考にしてみた.

メインの処理はdateCreate関数とzipDateAndNum関数で他はその補助.
dateCreate関数はオプションと日付と週数を受け取る.
オプションが"-f"なら受け取った日付を最後(最新)のものとして,
オプションが"-i"なら最初の日付として扱い, 週数の分だけ日付を生成する.
日付の計算はDay型がよしなにやってくれる.

digitは数の桁数計算. length . show でもいいんだろうけど.
ちなみにこの定義でotherwiseを入れないと
「パターンマッチが網羅的でない」とコンパイラに怒られる.
ちゃんと全部のnに対して定義してると思うんだけどな…
負数のnに対して再帰で折り返し呼び出ししてるのがいけないのだろうか.

showZeroPaddingはText.Printf.printfを使ったゼロフィル.
%dやら*やらの指定によりprintf関数の型が
引数の個数まで変わるという変態的な挙動に最初戸惑った.
ちなみにprintfの活用に気付く前に自前で実装したのはこんな感じ.

showZeroFill :: Int -> Int -> String
showZeroFill m n
  | n <  0 = concat ["-", showZeroFill (m-1) $ (-1)*n]
  | n == 0 = zeroFill m
  | d <= m = concat [zeroFill (m - d), show n]
  | d >  m = show n
  | otherwise = error "Should not be here."
  where d = digit n

zeroFill :: Int -> String
zeroFill k = take k $ repeat '0'

これもotherwise入れないと「網羅的でない」と怒られる.
digit関数は上で定義したやつ.

雑感

1個前のHaskellの記事でもそうだけど,
「変数・関数の名前に気持ちを込める」ことを最近心がけてみている.
無名関数やポイントフリー教もかっこいいと思うしそれで十分なときもあるけど,
変数に(適切な)名前を付けたくなることも結構あるなあと.
頻出する場合はTypeで型に別名を与えるのもひとつの手か.

Hackageとかを漁ってドキュメントを読むのもそこそこ慣れてきたが,
型と説明を読んでも具体的な引数の与え方がよくわからないってことも結構ある.
上級者の方による解説記事も意外となかったりして(英語ならあるのかもだけど),
そういうときに初級者さんの練習記事でも出てきたりすると
地味にありがたかったりする.
というわけで, 自分のコードも誰かにとってのexampleに
なるやもしれぬと思いつつなるべくアウトプットしていきたい.

ネギのメモ帳

Twitterに書ききれないことをたまに書いたりするかもしれないスペース

Haskellで同じ曜日の日付を何週分も生成する

2015.07.08 追記

コメント的な

雑感