java-poker (empty) → 0.1.0.0
raw patch · 8 files changed
+840/−0 lines, 8 filesdep +basedep +java-pokerdep +random-shufflesetup-changed
Dependencies added: base, java-poker, random-shuffle
Files
- LICENSE +21/−0
- README.md +23/−0
- Setup.hs +2/−0
- app/Main.hs +5/−0
- java-poker.cabal +32/−0
- src/Game/Poker.hs +291/−0
- src/Game/Poker/Cards.hs +119/−0
- src/Game/Poker/Hands.hs +347/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 tobynet++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,23 @@+# Syakyo of Poker in Haskell++* For `Syakyo`, refer to https://en.wikipedia.org/wiki/Sutra_copying+* For `Poker in Haskell`, refer to http://tune.hateblo.jp/entry/2015/05/12/023112++## Requirements++* Haskell compiler(ghc 7.8.3 or lator)+* `random-shuffle` package++ ex.++ ```shell+ $ cabal install random-shuffle+ ```++## Todos++* todo: module化+* todo: Web App化+* todo: Deploy to PaaS+* todo: 出力 using IO+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,5 @@+module Main where+import Game.Poker++main :: IO ()+main = simpleGame
+ java-poker.cabal view
@@ -0,0 +1,32 @@+name: java-poker+version: 0.1.0.0+synopsis: The etude of the Haskell programming+description: poker like a JAVA+-- description: +homepage: https://github.com/tobynet/java-poker#readme+license: MIT+license-file: LICENSE+author: tobynet+maintainer: toby.net.info+git@gmail.com+-- copyright: +category: Game+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Game.Poker+ , Game.Poker.Hands+ , Game.Poker.Cards+ build-depends: base >=4.7 && <5+ , random-shuffle >=0.0 && <0.1+ default-language: Haskell2010++executable java-poker+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , java-poker+ default-language: Haskell2010
+ src/Game/Poker.hs view
@@ -0,0 +1,291 @@+module Game.Poker+ ( module Game.Poker.Hands+ , module Game.Poker.Cards+ , simpleGame+ ) where++import System.Random.Shuffle+import Control.Monad+import Control.Applicative+import Data.List+import Data.Char+import Data.Maybe+import Game.Poker.Cards -- Fuda+import Game.Poker.Hands -- Tefuda++type DiscardList = [Card] -- Sutefuda+type Deck = [Card] -- Yamafuda+++-- | Draw cards to make new hand from Deck+-- Return a new Hand and Deck if its possible.+--+-- >>> +drawHand :: Deck -> DiscardList -> Hand -> Maybe (Hand, Deck)+drawHand deck dis h = let + nl = filter (`notElem` dis) (fromHand h)+ nr = drop (5 - length nl) deck+ in (,) <$> toHand (take 5 $ nl ++ deck) <*> Just nr++ -- in do+ -- hand <- toHand . take 5 $ nl ++ deck+ -- return (hand, nr)++-- | Get hand from deck(Yamafuda)+--+-- >>> let Just (hand, newDeck) = getHand allCards+-- >>> hand+-- Hand {fromHand = [H2_,H3_,H4_,H5_,H6_]}+-- +-- >>> let Just (_, newDeck') = getHand newDeck+-- >>> take 8 newDeck'+-- [HQ_,HK_,HA_,D2_,D3_,D4_,D5_,D6_]+--+-- >>> getHand allCards >>= return . snd >>= getHand >>= return . take 8 . snd+-- Just [HQ_,HK_,HA_,D2_,D3_,D4_,D5_,D6_]+getHand :: Deck -> Maybe (Hand, Deck)+getHand deck = do+ hand <- toHand . take 5 $ deck+ return (hand, drop 5 deck)++-- | Get discardList(Sutefuda) from hand+getDiscardList :: Hand -> IO (Maybe DiscardList)+getDiscardList h = do+ input <- getLine+ return $ do+ xs <- toIntList input+ selectByIndexes (fromHand h) xs++-- | String to [Int] for parse user inputs+-- +-- >>> toIntList "1234"+-- Just [1,2,3,4]+--+-- >>> toIntList "4019"+-- Just [4,0,1,9]+--+-- >>> toIntList "z4q01"+-- Nothing+--+-- >>> toIntList ""+-- Just []+toIntList :: String -> Maybe [Int]+toIntList cs =+ if isDigits cs+ then Just $ toInts cs+ else Nothing+ where+ isDigits :: String -> Bool+ isDigits = all isDigit++ toInts :: String -> [Int]+ toInts = map digitToInt+++-- | Get cards by indexes+--+-- >>> selectByIndexes "12345" [1..3]+-- Just "123"+--+-- >>> selectByIndexes "12345" [10]+-- Nothing+--+selectByIndexes :: [a] -> [Int] -> Maybe [a]+selectByIndexes xs = + mapM (atMay xs . subtract 1)++ where+ atMay :: [a] -> Int -> Maybe a+ atMay ys i =+ if (0 <= i) && (i < length xs)+ then Just (ys !! i)+ else Nothing+++simpleGame :: IO ()+simpleGame = do+ -- Ogre font+ putStrLn " __ ___ _ "+ putStrLn " \\ \\ __ ___ ____ _ / _ \\___ | | _____ _ __ "+ putStrLn " \\ \\/ _` \\ \\ / / _` |/ /_)/ _ \\| |/ / _ \\ '__|"+ putStrLn " /\\_/ / (_| |\\ V / (_| / ___/ (_) | < __/ | "+ putStrLn " \\___/ \\__,_| \\_/ \\__,_\\/ \\___/|_|\\_\\___|_| "+ putStrLn " "++ deck <- shuffleM allCards+ case getHand deck of+ Nothing -> error "Unexpected error"+ Just res -> matchPoker res+ ynQuestion "-- replay?" simpleGame (putStrLn "-- bye.")+++data Player = Player | Enemy deriving Eq++showPlayerName :: Player -> String+showPlayerName Player = "You"+showPlayerName Enemy = "Java"++matchPoker :: (Hand, Deck) -> IO ()+matchPoker (mhand, deck) = do+ (mres, ndeck, nmhand) <- playPoker mhand deck Player+ case getHand ndeck of+ Nothing -> error "Unexpected error"+ Just (ehand, odeck) -> do+ (eres, _,nehand) <- playPoker ehand odeck Enemy+ printResult nmhand nehand mres eres+++-- | Play poker+playPoker :: Hand -> Deck -> Player -> IO ((PokerHand, Card), Deck, Hand)+playPoker hand deck player = do+ discards <- if player == Player+ then inputDisuse hand+ else aiDisuse hand++ case drawHand deck discards hand of+ Nothing -> error "Unexpected error"+ Just (nhand, ndeck) -> do+ let res = pokerHand nhand+ return (res, ndeck, nhand)+++-- | Input suteru cards+inputDisuse :: Hand -> IO DiscardList+inputDisuse hand = do+ printHand [] hand Player+ putStrLn "-- Select discardable cards" + gotDisuse <- getDiscardList hand+ case gotDisuse of+ Nothing -> do+ putStrLn "-- Input 1 or .. 5" + inputDisuse hand+ Just disuses -> do+ printHand disuses hand Player+ ynQuestion "-- You: OK?" (return disuses) (inputDisuse hand)+++-- | aiDisuse :: Hand -> IO DiscardList+aiDisuse :: Hand -> IO DiscardList+aiDisuse hand = do+ let res = aiSelectDiscards hand+ printHand res hand Enemy+ putStrLn "-- Java: OK!"+ return res+++-- | print Yaku+printResult :: Hand -> Hand -> (PokerHand, Card) -> (PokerHand, Card) -> IO()+printResult mhand ehand mres@(mph, mcard) eres@(eph, ecard) = do+ putStrLn "***** Result *****"+ printHand [] mhand Player+ printHand [] ehand Enemy++ putStrLn $ concat ["Your hand is ", show mph, ", greatest card is ", show mcard]+ putStrLn $ concat ["Java's hand is ", show eph, ", greatest card is ", show ecard]++ putStrLn $ concat + [ "\n"+ , " +----------------------------+\n"+ , " || ||\n"+ , " || " , winLossMessage, " ||\n"+ , " || ||\n"+ , " +----------------------------+\n" + ]+ where + winLossMessage = case judgeVictory mres eres of + LT -> " Java win! "+ EQ -> "It's a tie!"+ GT -> " You win!! "+++-- | print Tefuda+printHand :: DiscardList -> Hand -> Player -> IO ()+printHand dis hand player = do+ putStrLn $ "-- " ++ showPlayerName player ++ "'s Hand : "+ forM_ [0..4] $ \x ->+ putStrLn $ " " ++ showChangeHand dis hand x+++-- | Repeat y/n question+ynQuestion :: String -> IO a -> IO a -> IO a+ynQuestion s yes no = do+ putStrLn $ s ++ "(y/n)"+ input <- getLine+ case input of+ "y" -> yes+ "n" -> no+ _ -> do+ putStrLn "-- Input `y` or `n`"+ ynQuestion s yes no+++-- | Hand with Sutefuda to String+showChangeHand :: DiscardList -> Hand -> Int -> String+showChangeHand dis hand row = let+ judge x = if x `elem` dis + then+ [ " "+ , " "+ , " " ++ show x ++ " "+ , " "+ , " "] !! row+ + else+ [ " -----+ "+ , "| | "+ , "| " ++ show x ++ " | "+ , "| | "+ , "+----- "] !! row++ in concatMap judge (fromHand hand)+++-- | Sutefuda = Hand - allYaku+--+-- >>> let Just (x) = toHand $ take 5 $ (filter (\x -> (cardNumber x == 10)) $ allCards) ++ allCards+-- >>> fromHand x+-- [H2_,H10,D10,C10,S10]+-- >>> nOfKindDiscards x +-- [H2_]+nOfKindDiscards :: Hand -> DiscardList+nOfKindDiscards hand = fromHand hand \\ allNOfKinds hand+ where+ -- | all Yaku+ --+ -- >>> let Just (x) = toHand $ take 5 $ (filter (\x -> (cardNumber x == 10)) $ allCards) ++ allCards+ -- >>> allNOfKinds x+ -- [H10,D10,C10,S10]+ allNOfKinds :: Hand -> [Card]+ allNOfKinds h = concat . concat $ catMaybes [nOfKindHint 2 h, nOfKindHint 3 h, nOfKindHint 4 h]+++-- | Sutefuda by AI+--+-- >>> let Just straightFlush = toHand $ take 5 $ allCards+-- >>> aiSelectDiscards straightFlush+-- []+--+-- >>> let Just fourCard = toHand $ take 5 $ (filter ((==10) . cardNumber) allCards) ++ allCards+-- >>> aiSelectDiscards fourCard+-- [H2_]+--+-- >>> let Just buta = toHand $ take 5 $ (take 2 allCards) ++ (take 2 $ drop (13+5) allCards) ++ (drop (13*2+9) allCards)+-- >>> aiSelectDiscards buta+-- [H2_,H3_,D7_,D8_,CJ_]+--+aiSelectDiscards :: Hand -> DiscardList+aiSelectDiscards hand =+ fromMaybe (nOfKindDiscards hand)+ ((straightHint hand <|> flushHint hand) *> Just [])+++-- | Judge victory you and AI+--+-- >>>+judgeVictory :: (PokerHand, Card) -> (PokerHand, Card) -> Ordering+judgeVictory l r = compare (pullStrength l) (pullStrength r)+ where+ pullStrength :: (PokerHand, Card) -> (PokerHand, Int)+ pullStrength = fmap cardStrength++
+ src/Game/Poker/Cards.hs view
@@ -0,0 +1,119 @@+module Game.Poker.Cards + ( Suit(..)+ , Card+ , allCards+ , cardSuit+ , cardNumber+ , cardStrength+ ) where++-- | 4 types of card+--+-- >>> Hearts -- Show+-- Hearts+-- +-- >>> read "Hearts" :: Suit -- Read+-- Hearts+--+-- >>> Hearts == Hearts -- Eq+-- True+--+-- >>> Hearts == Spades -- Eq+-- False+--+-- >>> Hearts < Diamonds -- Ord+-- True+--+-- >>> succ Hearts -- Enum+-- Diamonds+--+data Suit = Hearts | Diamonds | Clubs | Spades + deriving (Show, Read, Eq, Ord, Enum)+++-- | One playing card+--+-- >>> Card 1 Hearts == Card 2 Hearts -- Eq+-- False+--+-- >>> Card 1 Hearts < Card 2 Hearts -- Ord+-- True+data Card = Card Int Suit+ deriving (Eq, Ord)+++-- | For instance of show typeclass+--+-- In order that "K < A" equals True,+-- consider 14 as the ace+--+-- >>> showCardNumber 14+-- "A_"+-- +-- >>> showCardNumber 4+-- "4_"+showCardNumber :: Int -> String+showCardNumber 14 = "A_"+showCardNumber 13 = "K_"+showCardNumber 12 = "Q_"+showCardNumber 11 = "J_"+showCardNumber 10 = "10"+showCardNumber x = show x ++ "_"+++-- | Show typeclass of Card+-- +-- >>> show $ Card 1 Hearts+-- "H1_"+--+-- >>> show $ Card 14 Diamonds+-- "DA_"+--+-- >>> show $ Card 11 Clubs+-- "CJ_"+--+-- >>> show $ Card 10 Spades+-- "S10"+instance Show Card where+ show (Card i Hearts) = "H" ++ showCardNumber i+ show (Card i Diamonds) = "D" ++ showCardNumber i+ show (Card i Clubs) = "C" ++ showCardNumber i+ show (Card i Spades) = "S" ++ showCardNumber i+++-- | All cards+-- +-- >>> length allCards+-- 52+--+-- >>> take 13 $ allCards+-- [H2_,H3_,H4_,H5_,H6_,H7_,H8_,H9_,H10,HJ_,HQ_,HK_,HA_]+--+-- >>> reverse $ take 13 $ reverse allCards+-- [S2_,S3_,S4_,S5_,S6_,S7_,S8_,S9_,S10,SJ_,SQ_,SK_,SA_]+--+allCards :: [Card]+allCards = [ Card num suit | suit <- [Hearts ..], num <- [2..14] ]+++-- | Get Suit from card+--+-- >>> cardSuit $ Card 10 Hearts+-- Hearts+cardSuit :: Card -> Suit+cardSuit (Card _ card) = card++-- | Get Suit from card+--+-- >>> cardNumber $ Card 10 Hearts+-- 10+cardNumber :: Card -> Int+cardNumber (Card num _) = num++-- | Stregnth of card+-- +-- >>> cardStrength . head $ allCards+-- 2+cardStrength :: Card -> Int+cardStrength (Card n _) = n+
+ src/Game/Poker/Hands.hs view
@@ -0,0 +1,347 @@+module Game.Poker.Hands+ ( Hand+ , toHand, fromHand+ , pokerHand+ , PokerHand+ + -- hint+ , straightHint+ , flushHint+ , nOfKindHint++ -- hand+ , straightFlush+ , fourOfAKind+ , fullHouse+ , flush+ , straight+ , threeOfAKind+ , twoPair+ , onePair+ ) where+++import Data.List+import Data.Function+import Data.Maybe+import Control.Applicative+import Control.Monad+import Game.Poker.Cards++-- | Constrained cards in hand+--+-- >>> :type fromHand+-- fromHand :: Hand -> [Card]+--+newtype Hand = Hand { fromHand :: [Card] }+ deriving (Show, Eq, Ord)++-- | Cards to Hard+--+-- >>> toHand allCards+-- Nothing+--+-- >>> fmap (length . fromHand) (toHand $ take 5 allCards)+-- Just 5+--+toHand :: [Card] -> Maybe Hand+toHand xs = + if length xs == 5+ then Just $ Hand (sort xs)+ else Nothing+++-- +data PokerHand+ = HighCards -- Buta+ | OnePair -- ^+ | TwoPair -- |+ | ThreeOfAKind+ | Straight+ | Flush+ | FullHouse -- |+ | FourOfAKind -- V+ | StraightFlush -- Sugoi+ deriving (Show, Read, Eq, Ord, Enum)+++-- | Detect poker hand and return strength Card+-- +-- >>> let sameNum = filter ((==14) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Hearts) . cardSuit) allCards+--+-- >>> pokerHand (Hand $ take 5 sameSuit)+-- (StraightFlush,H6_)+--+-- >>> let buta = take 2 allCards ++ (take 2 $ drop 17 allCards) ++ [last allCards]+-- >>> pokerHand (Hand buta)+-- (HighCards,SA_)+--+pokerHand :: Hand -> (PokerHand, Card)+pokerHand h@(Hand xs) = + fromMaybe (HighCards, last xs)+ (foldl mplus Nothing $ fmap ($h) hands)+ + where+ hands :: [Hand -> Maybe (PokerHand, Card)]+ hands = + [ straightFlush+ , fourOfAKind+ , fullHouse+ , flush+ , straight+ , threeOfAKind+ , twoPair+ , onePair+ ]+++-- Implement every Hand!!!!++-- | Detect onePair and return strongest Card+--+-- >>> let sameNum = filter ((==9) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Spades) . cardSuit) allCards+-- >>> onePair $ Hand (take 2 sameNum ++ take 3 sameSuit)+-- Just (OnePair,D9_)+-- +-- >>> onePair $ Hand (take 5 sameSuit)+-- Nothing+onePair :: Hand -> Maybe (PokerHand, Card)+onePair x = do+ cs <- nOfKindHint 2 x+ return (OnePair, last . concat $ cs)++ -- same as+ -- fmap (((,) OnePair) . last . join) . nOfKindHint 2++-- | Detect TwoPair and return strongest Card+--+-- >>> let sameNum = filter ((==9) . cardNumber) allCards+-- >>> let sameNum' = filter ((==10) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Spades) . cardSuit) allCards+-- >>> twoPair $ Hand (take 2 sameNum ++ take 2 sameNum' ++ take 1 sameSuit)+-- Just (TwoPair,D10)+--+-- >>> twoPair $ Hand (take 2 sameNum ++ take 3 sameSuit)+-- Nothing+-- +-- >>> twoPair $ Hand (take 5 sameSuit)+-- Nothing+twoPair :: Hand -> Maybe (PokerHand, Card)+twoPair x = do+ cs <- nOfKindHint 2 x+ guard (length cs == 2)+ return (TwoPair, last . concat $ cs)++-- | Detect ThreeOfAKind and return strongest Card+--+-- >>> let sameNum = filter ((==4) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Spades) . cardSuit) allCards+-- >>> threeOfAKind $ Hand (take 3 sameNum ++ take 2 sameSuit)+-- Just (ThreeOfAKind,C4_)+-- +-- >>> threeOfAKind $ Hand (take 5 sameSuit)+-- Nothing+threeOfAKind :: Hand -> Maybe (PokerHand, Card)+threeOfAKind x = do+ cs <- nOfKindHint 3 x+ return (ThreeOfAKind, maximum . concat $ cs)+++-- | Detect Straight and return strongest Card+--+-- >>> straight $ Hand (take 5 $ filter ((==Hearts) . cardSuit) allCards)+-- Just (Straight,H6_)+--+-- >>> straight $ Hand (take 5 $ filter (even . cardNumber) allCards)+-- Nothing+straight :: Hand -> Maybe (PokerHand, Card)+straight x = do+ c <- straightHint x+ return (Straight, c)+ + -- Same as followings+ -- straightHint x >>= (\y -> return (Straight, y))+ -- fmap (\y -> (Straight, y)) (straightHint x)+++-- | Detect Flush and return strongest Card+--+-- >>> flush $ Hand (take 5 $ filter ((==Hearts) . cardSuit ) allCards)+-- Just (Flush,H6_)+--+-- >>> flush $ Hand (take 5 $ filter ((<= 3) . cardNumber) allCards)+-- Nothing+flush :: Hand -> Maybe (PokerHand, Card)+flush x = do+ c <- flushHint x+ return (Flush, c)++ -- Same as followings+ -- flushHint x >>= (\y -> return (Straight, y))+ -- fmap (\y -> (Flush, y)) (flushHint x)+++-- | Detect fullHouse and return strongest Card+--+-- >>> let sameNum = filter ((==9) . cardNumber) allCards+-- >>> let sameNum' = filter ((==10) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Spades) . cardSuit) allCards+-- >>> fullHouse $ Hand (take 2 sameNum ++ take 3 sameNum')+-- Just (FullHouse,C10)+--+-- >>> fullHouse $ Hand (take 3 sameNum ++ take 2 sameNum')+-- Just (FullHouse,C9_)+--+-- >>> fullHouse $ Hand (take 2 sameNum ++ take 3 sameSuit)+-- Nothing+-- +-- >>> fullHouse $ Hand (take 5 sameSuit)+-- Nothing+fullHouse :: Hand -> Maybe (PokerHand, Card)+fullHouse x = do+ cs <- nOfKindHint 3 x+ ds <- nOfKindHint 2 x+ guard (length cs == 1 && length ds == 1)+ return (FullHouse, last $ concat cs )++-- | Detect FourOfAKind and return strongest Card+--+-- >>> let sameNum = filter ((==4) . cardNumber) allCards+-- >>> let sameSuit = filter ((==Spades) . cardSuit) allCards+-- >>> fourOfAKind $ Hand (take 4 sameNum ++ take 1 sameSuit)+-- Just (FourOfAKind,S4_)+-- +-- >>> fourOfAKind $ Hand (take 5 sameSuit)+-- Nothing+fourOfAKind :: Hand -> Maybe (PokerHand, Card)+fourOfAKind x = do+ cs <- nOfKindHint 4 x+ return (FourOfAKind, maximum . concat $ cs)+++-- | Detect StraightFlush and return strongest Card+--+-- >>> straightFlush $ Hand (take 5 $ filter ((==Hearts) . cardSuit) allCards)+-- Just (StraightFlush,H6_)+--+-- >>> straightFlush $ Hand (take 5 $ filter (\x -> cardSuit x == Hearts && even (cardNumber x)) allCards)+-- Nothing+--+-- >>> let sameSuit = filter ((==Hearts) . cardSuit) allCards+-- >>> let sameSuit' = filter ((==Spades) . cardSuit) allCards+-- >>> straightFlush $ Hand (take 3 sameSuit ++ take 2 (drop 3 sameSuit'))+-- Nothing+--+-- >>> straightFlush $ Hand (take 5 $ filter (even . cardNumber) allCards)+-- Nothing+straightFlush :: Hand -> Maybe (PokerHand, Card)+straightFlush x = do+ c <- flushHint x+ d <- straightHint x+ return (StraightFlush, max c d)+++-- | Check straight in Hand+--+-- >>> straightHint $ Hand (take 5 allCards)+-- Just H6_+--+-- >>> straightHint $ Hand (take 5 $ drop 8 allCards)+-- Just HA_+--+-- >>> straightHint $ Hand (take 2 $ allCards)+-- Nothing+straightHint :: Hand -> Maybe Card+straightHint (Hand xs) = + (judgeStraight . extract cardStrength $ xs)+ <|> (judgeStraight . sort . extract cardNumber $ xs)+ where+ -- | Check Straight with Numbers+ --+ -- >>> isStraight [1..5]+ -- True+ --+ -- >>> isStraight [1,3,4,5,6]+ -- False+ --+ -- >>> isStraight [1]+ -- False+ --+ -- >>> isStraight []+ -- False+ isStraight :: [Int] -> Bool+ isStraight [] = False+ isStraight ys@(y:_) = ys == [y..y+4]++ -- | Check Straight and return strongest card+ --+ -- >>> judgeStraight . extract cardNumber . sort . take 5 $ allCards+ -- Just H6_+ --+ -- >>> judgeStraight []+ -- Nothing+ judgeStraight :: [(Int, Card)] -> Maybe Card+ judgeStraight ys = + if isStraight $ map fst ys+ then Just . snd . last $ ys+ else Nothing+++-- | Check flush in Hand+--+-- >>> flushHint $ Hand (take 5 $ filter (\x -> cardSuit x == Hearts) allCards )+-- Just H6_+--+-- >>> flushHint $ Hand (take 5 $ filter (\x -> cardNumber x == 2) allCards )+-- Nothing+flushHint :: Hand -> Maybe Card+flushHint (Hand (x:xs)) =+ if all (== suit) suits+ then Just (last xs)+ else Nothing+ where+ suit = cardSuit x+ suits = map cardSuit xs++flushHint (Hand []) = Nothing+++-- | n of Kind in Hand+--+-- >>> let treeCards = take 3 $ filter ((==2) . cardNumber) $ allCards+-- >>> let twoCards = take 2 $ filter ((==10) . cardNumber) $ allCards+-- >>> let fullhouse = toHand $ treeCards ++ twoCards+--+-- >>> fullhouse >>= nOfKindHint 2+-- Just [[H10,D10]]+--+-- >>> fullhouse >>= nOfKindHint 3+-- Just [[H2_,D2_,C2_]]+--+-- >>> fullhouse >>= nOfKindHint 4+-- Nothing+--+nOfKindHint :: Int -> Hand -> Maybe [[Card]]+nOfKindHint n (Hand xs) = + if cards /= [] then Just cards else Nothing+ where+ cards :: [[Card]]+ cards = filter ((==n) . length) $+ groupBy ((==) `on` cardNumber) xs+ -- cards = groupBy (\x y -> cardNumber x == cardNumber y) xs+++-- | +--+-- >>> extract cardNumber $ take 5 $ allCards+-- [(2,H2_),(3,H3_),(4,H4_),(5,H5_),(6,H6_)]+--+-- >>> extract cardStrength $ take 5 $ allCards+-- [(2,H2_),(3,H3_),(4,H4_),(5,H5_),(6,H6_)]+extract :: (a -> b) -> [a] -> [(b, a)]+extract f cs = [ (f c, c) | c <- cs ]+++