■ [Q3] 各種アクション

ViewScrollMessagePageUpアクションとViewScrollMessagePageDownアクションを追加しました。keymap.xmlで適当なキーに割り当てると、リストビューにフォーカスがあるときでもプレビューをスクロールできるので便利かもしれません。

ついでに、以下のアクションをエディットウィンドウでも使えるようにしました。

• ViewScrollLineUp
• ViewScrollLineDown
• ViewScrollPageUp
• ViewScrollPageDown
• ViewScrollTop
• ViewScrollBottom

■ [Haskell] 列挙型

data Color = RED | BLUE

のような型があるときに、この値と整数をマッピングするにはEnumを使うのが楽です。

data Color = RED | BLUE deriving Enum
intToColor = toEnum
colorToInt = fromEnum

ところが、intToColorに範囲外の整数を渡されると例外になってしまってうれしくありません。適当なデフォルト値にフォールバックしたいところです。とりあえず、例外を捕まえるには、

import Foreign
import Control.Exception
import Prelude hiding (catch)

intToColor n = unsafePerformIO $ catch (execute $ (toEnum n :: Color)) (const $ return RED)

のようにすれば良さそうです。executeの代わりにreturnにすると、評価順序によってはcatchブロックの外側で例外が発生してしまうので、executeするか、return $!を使う必要があるようです。

もっと素直にやるには、Boundedを使うのが良さそうです。

data Color = RED | BLUE deriving (Enum, Bounded)

intToColor n | fromEnum (minBound :: Color) <= n && n <= fromEnum (maxBound :: Color) = toEnum n
             | otherwise = RED

これを一般化するとこんな感じ。

safeToEnum :: forall a. (Enum a, Bounded a) -> a -> Int -> a
safeToEnum d n | fromEnum (minBound :: a) <= n && n <= fromEnum (maxBound :: a) = toEnum n
               | otherwise = d

intToColor = safeToEnum RED

■ [Haskell] カレンダーっぽいものを表示

指定した年・月を以下のような感じでカレンダーっぽく表示。

|              1  2  3
|  4  5  6  7  8  9 10
| 11 12 13 14 15 16 17
| 18 19 20 21 22 23 24
| 25 26 27 28 29 30 31

なんとなく考えると、具体的な方法を考えなくても書けてしまうのが良い感じです。

import Data.List (dropWhile, intersperse, takeWhile, unfoldr)
import Data.Time (Day, addDays, fromGregorian, gregorianMonthLength, toGregorian)
import Data.Time.Calendar.OrdinalDate (sundayStartWeek)
import Data.Time.Calendar.WeekDate (toWeekDate)

daysOfMonth :: Integer -> Int -> [[Day]]
daysOfMonth year month =
    takeWhile ((<= lastDay) . head)                 -- 日曜日が月の最終日より前の週だけ取得
        $ unfoldr (Just . splitAt 7)                -- 7日ごとに切り分ける
        $ dropWhile ((/=0) . snd . sundayStartWeek) -- 最初の日曜日より前を削除
        $ iterate (addDays 1)                       -- 無限リストを作成
        $ addDays (-6) $ fromGregorian year month 1 -- 月の最初の日の6日前を取得
 where
     lastDay = fromGregorian year month $ gregorianMonthLength year month

printMonth :: Integer -> Int -> IO ()
printMonth year month = mapM_ putStrLn $ formatDays month $ daysOfMonth year month

formatDays :: Int -> [[Day]] -> [String]
formatDays month = map $ (concat . intersperse " " . map (formatDay . toGregorian))
 where
     formatDay (_, m, d) | m == month = show2 d
                         | otherwise  = "  "

show2 :: (Num a, Ord a, Show a) => a -> String
show2 n | n < 10 = ' ':show n
        | True   = show n