[ネタ] TransformListComp (generalized list comprehension) の勉強とか

Main.hs

{-# LANGUAGE ViewPatterns, TransformListComp #-}
-- 元ネタはいつもどおり route150 の日記
-- <http://d.hatena.ne.jp/route150/20120622/1340338820>

import GHC.Exts
import Control.Arrow
import Data.List
import Test.QuickCheck

-- GHC拡張(TransformListComp)使うと楽だったりする...
solve3 :: [String] -> [(Integer, [String])]
solve3 xs = [ (the l, sort x)
  | x <- xs
  , let l = genericLength x
  , then group by l -- using groupWith
  ]

-- 結局こういうこと
solve4 :: [String] -> [(Integer, [String])]
solve4 = map (unzip >>> the *** sort)
  . groupWith fst
  . map (genericLength &&& id)

-- 複数回 の genericLength が気にならなければ、、、、 
solve5 :: [String] -> [(Integer, [String])]
solve5 = map (glength . head &&& sort) . groupWith glength
  where glength = genericLength -- 型を一致させる

-- 私にはこれが明快に見えるが、おそらく、お行儀が悪いコードと思われる。
solve5' :: [String] -> [(Integer, [String])]
solve5' = map (genericLength . head &&& sort) . groupWith genericLength
-- お行儀が悪いと思った理由：
-- 最初の genericLength の戻り値の型は solve5' の型宣言から Integer と決まるのに対して、
-- 2回目の genericLength の戻り値の型 はデフォルトとして Integer になっているに過ぎないため。
-- 潜在的に内部計算の型が不一致になる恐れがある。


-- テスト
solve :: [String] -> [[(Integer, [String])]]
solve = sequence [solve3, solve4, solve5, solve5']

check :: IO ()
check = quickCheckWith modifiedArgs $
  forAll arbitrary $ \(solve -> xs) ->
    and $ zipWith (==) xs (drop 1 xs)
 where
  modifiedArgs  = stdArgs {
        maxSuccess = 1000
      , maxSize    = 25
    }