CODE:

import Prelude hiding (lookup)
import System.Random
import Control.Monad
import Control.Monad.State
import Data.Map hiding (filter,map)
import Control.Applicative hiding (empty)
import Debug.Trace
import Data.List
import Data.Char

data Hand = High_card | One_pair | Two_pair | Three_of_a_kind |
	Straight | Flush | Full_house | Four_of_a_kind | Straight_flush
	|Royal_straight_flush deriving (Eq,Enum,Ord)
instance Show Hand where
	show High_card 				= "ハイカード"
	show One_pair 				= "ワンペア"
	show Two_pair 				= "ツーペア"
	show Three_of_a_kind 		= "スリーカード"
	show Straight 				= "ストレート"
	show Flush					= "フラッシュ"
	show Full_house 			= "フルハウス"
	show Four_of_a_kind 		= "フォーカード"
	show Straight_flush			= "ストレートフラッシュ"
	show Royal_straight_flush	= "ロイヤルストレートフラッシュ"
data Suit = Diamonds | Hearts | Clubs | Spades deriving (Eq,Show,Enum)
data Card = Card {suit::Suit,number::Int} deriving (Eq,Show)
instance Ord Card where
	compare (Card _ v1) (Card _ v2)
		| v1  g = \v -> f v && g v
f  g = \v -> f v || g v
rand :: (Int,Int) -> IO Int
rand = getStdRandom.randomR

random_list :: Int -> (Int,Int) -> IO [Int]
random_list 0 _ = return []
random_list n range= do
	list IO [a]
shuffle [] = return []
shuffle xs = do
    n  [k] -> Map k a
count_dict [] = empty
count_dict (x:xs) = 
  let s = count_dict xs in
      insertWithKey (\k x y ->x+y)  x 1 s
	  
recurrence::(a->a->Bool)->[a]->Bool
recurrence f (x:xs) = recurrence_ xs x
	where
		recurrence_ [] _= True
		recurrence_ (x:xs) back = (f back x) && (recurrence_ xs x)
		
changeList::[a]->[Int]->[a]->[a]
changeList base [] [] = base
changeList base (x:xs) (v:vs) = 
	let newList= take x base++ [v] ++ drop (x+1) base
	in changeList newList xs vs
straight = recurrence check
	where
		check (Card _ v) (Card _ v1)=v+1==v1

flush = recurrence check
	where
		check (Card s _) (Card s1 _)=s==s1
		
straight_flush=straightflush

royal_straight_flush=front2back4
	where
		front2=((==[1,10]).(take 2).(map number))
		back4=straight_flush.(drop 1)

check :: (b -> Bool) -> a -> b -> Either a b
check f a v=if f v then Left a else Right v

getLeft (Left v)=v

hand::[Card]->Hand
hand cards = getLeft $
	return cards										>>=
	check royal_straight_flush	Royal_straight_flush	>>=
	check straight_flush 		Straight_flush			>>=
	check (\_->pair==[4])		Four_of_a_kind			>>=
	check (\_->pair==[2,3])		Full_house				>>=
	check flush 				Flush					>>=
	check straight 				Straight				>>=
	check (\_->pair==[3])		Three_of_a_kind			>>=
	check (\_->pair==[2,2])		Two_pair				>>=
	check (\_->pair==[2])		One_pair				>>=
	\_->Left High_card
	where
		pair=(sort.(filter ((/=)1)).elems.count_dict) cards
		
showSuit Hearts 	= "H"
showSuit Diamonds 	= "D"
showSuit Clubs 		= "C"
showSuit Spades 	= "S"

showNumber v = space++str
	where
		str=show v
		len=3-length str
		space=take len$repeat ' '

showCard cards =
	concatMap (\_->"  ___  ") cards++"\n"++
	concatMap (\(Card s _)->" | "++showSuit s++" | ") cards++"\n"++
	concatMap (\(Card _ v)->" |"++showNumber v++"| ") cards++"\n"++
	concatMap (\(Card _ v)->" |---| ") cards++"\n"++
	concatMap (\v->"   "++show v++"   ") list
	where
		list=[1..length cards]
		
play cards=do
	putStrLn "---------------------------"
	(putStrLn.show.hand) cards
	putStrLn $showCard cards
	putStrLn "\n"
	
getCard n =do
	cardstake nget
	modify (drop n)
	return cards

getInput f=do
	inputreadreturninput::[Int]
	let new_player_cards=changeList cards change new
	return$sort new_player_cards
	
game::[Card]->IO [Card]
game xs = (`execStateT` xs) $ do
	player_cards(>'0')(enemy_hand then
		lift$putStrLn "WIN"
	else if player_hand==enemy_hand then
		lift$putStrLn "DRAW"
	else
		lift$putStrLn "LOSE"
gameloop = do
	let cards=[Card s v| s (==no)).(map toLower)
	if map toLower is_next==yes then gameloop else return ""
	
main = do
	gameloop