1日1個 @nabetani さんの作った問題を解く、どう書くAdventCalendarの4日目です。

今日の問題は http://qiita.com/Nabetani/items/9d80de41903775296ca6 にあります。

{-# LANGUAGE Rank2Types #-}
module Doukaku.TwoTone  where
import Data.Bits.Lens (bitAt)
import Numeric.Lens (hex)
import Control.Lens (Lens', view, set, preview, review)

solve :: String -> String
solve input = (n' ++) . (':' :) . fill . pack . turnRight l n . unpack $ tile'
  where
    (n', _:tile') = break (== ':') input
    n = read n'
    l = length tile'
    fill x = replicate (l - length x) '0' ++ x

unpack :: String -> Integer
unpack = maybe 0 id . preview hex

pack :: Integer -> String
pack = review hex

point :: Int -> Int -> Int -> Int -> Lens' Integer Bool
point l n x y = bitAt index
  where
    bitLength = l * 4
    index = (bitLength - 1) - (y * n + x)

turnRight :: Int -> Int -> Integer -> Integer
turnRight l n tile = foldr set' 0 points
  where
    points = [(x, y) | x <- [0 .. n - 1], y <- [0 .. n - 1]]
    set' (x, y) = set (point' x y) (view (point' y (n - 1 - x)) tile)
    point' :: Int -> Int -> Lens' Integer Bool
    point' = point l n

どう書くの鬼門であるビット演算。Lensを使ってやってみようと思って始めたのですが、かなり苦労しました。整数に起こして、各ビットへのレンズpoint l n x yを定義して後はセット、ゲットしているだけです。

一辺の長さとビット列を一組にして、そいつのレンズを_1とかと組み合わせようと思ったもののうまく行かず泥臭い感じになっています。さらにPrismとLensを効果的に組み合わせる方法がわからず、pack、unpackとturnRightが完全に独立してしまっています。また、この問題のいやらしいところは64ビット整数だと収まらないようにできていることで、Integer型を使う羽目になりました。

問題ページに他の方の回答もありますので、見ると参考になるでしょう。