第一回 オフラインリアルタイムどう書くの参考問題 http://qiita.com/Nabetani/items/cbc3af152ee3f50a822f

poker.hs

import Data.List (group, sort)
-- import Debug.Trace

-- @see http://qiita.com/Nabetani/items/cbc3af152ee3f50a822f
{-
  一枚のカードは、スートを表す文字＋ランクを表す文字列 で構成される。
  スートを表す文字は、S, H, D, C のいずれか
  ランクを表す文字列は、2, 3, ..., 9, 10, J, Q, K, A のいずれか
  下表の役に対応すること。下表の役に該当しない場合は '--' を出力すること。
  カードはジョーカーを含まない52枚から5枚が選ばれる。
  不正な入力への対応は不要。
  役の判定
  フォーカード : 4K 4つ数字が同じ
  フルハウス : FH スリーカードとワンペア
  スリーカード : 3K 同じ数字のカードが2つ
  ツーペア : 2P ペアが2つ
  ワンペア : 1P ペアがひとつ
 -}


{-| checkItem Test

  >>>let testItem = "SK"
  >>>let testItem2 = "H10"
  >>>let testItem3 = "S2"

  >>> checkItem testItem
  ('S',13)
  >>> checkItem testItem2
  ('H',10)
  >>> checkItem testItem3
  ('S',2)
 -}

checkItem :: String -> (Char, Int)
checkItem (x:xs) = (x, rInt xs)
    where
      rInt xs' = case xs' of
                   "A" -> 1
                   "J" -> 11
                   "Q" -> 12
                   "K" -> 13
                   _   -> read xs' :: Int

checkPair :: String -> [(Char, Int)]
checkPair [] = []
checkPair (_:[]) = error "Wrong hand."
checkPair (x:y:[]) = [checkItem [x, y]]
checkPair (x:y:z:xs) = if checkSuit z
                       then checkItem [x, y] : checkPair (z:xs)
                       else checkItem [x, y, z] : checkPair xs
    where
      checkSuit q = any (\x' -> q == x') "SCDH"

judgeHand :: [(Char, Int)] -> String
judgeHand cards = returnHand
    where
      cardValues = filter (1<) $ map length $ group $ sort $ map snd cards
      returnHand
          | 4  `elem` cardValues                            = "4K"
          | (2 `elem` cardValues) && (3 `elem` cardValues)  = "FH"
          | 3  `elem` cardValues                            = "3K"
          | length cardValues == 2                          = "2P"
          | 2  `elem` cardValues                            = "1P"
          | otherwise = "--"

-- 参考 @see http://qiita.com/rana_kualu/items/35d28d1c7dac8feb7713
test :: [[String]]
test =  [["D3C3C10D10S3"  , "FH"],
         ["S8D10HJS10CJ"  , "2P"],
         ["DASAD10CAHA"   , "4K"],
         ["S10HJDJCJSJ"   , "4K"],
         ["S10HAD10DAC10" , "FH"],
         ["HJDJC3SJS3"    , "FH"],
         ["S3S4H3D3DA"    , "3K"],
         ["S2HADKCKSK"    , "3K"],
         ["SASJDACJS10"   , "2P"],
         ["S2S10H10HKD2"  , "2P"],
         ["CKH10D10H3HJ"  , "1P"],
         ["C3D3S10SKS2"   , "1P"],
         ["S3SJDAC10SQ"   , "--"],
         ["C3C9SAS10D2"   , "--"]]

testInput :: IO String
testInput = return "D3C3C10D10S3"
solve :: String -> String
solve = judgeHand . checkPair

main :: IO ()
main = do
  str1 <- testInput
  print $ judgeHand $ checkPair str1
  print result
  print test'
  where
    result = map (solve . head) test
    test' = and $ zipWith (==) result $ map (!!1) test