Fix warnings

This commit is contained in:
Sasha 2018-03-19 12:28:15 +01:00
parent 8f8d5afc28
commit 091e0e5c55
5 changed files with 15 additions and 18 deletions

View file

@ -25,7 +25,6 @@ import Data.Bits (
, testBit
, xor
, (.&.)
, (.|.)
, countTrailingZeros
)
import System.Random (randomRIO)
@ -104,9 +103,6 @@ remove p = Pack . portEnum clearBit p
portBinary :: (Word64 -> Word64 -> Word64) -> Pack -> Pack -> Pack
portBinary operator (Pack a) (Pack b) = Pack $ operator a b
union :: Pack -> Pack -> Pack
union = portBinary (.|.)
intersection :: Pack -> Pack -> Pack
intersection = portBinary (.&.)
@ -123,7 +119,7 @@ shuffle :: [a] -> IO [a]
shuffle l =
aux (length l) l
where
aux n [] = return []
aux _ [] = return []
aux n (h:t) = do
cut <- randomRIO (0, n-1)
shuffled <- shuffle t

View file

@ -18,7 +18,7 @@ import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
import System.Random (randomIO)
play :: Move -> On -> IO Game
play move on@(On_ {river, step, trick}) =
play move on@(On_ {river, step}) =
case (step, move) of
(ToPlay, Play card) ->
either raise (Turn.catch on card) $ match card river

View file

@ -26,7 +26,7 @@ next :: On -> IO Game
next on@(On_ {mode, scores, month, players, oyake, winning}) =
case mode of
FirstAt n | n <= newScore -> end scored
FirstAt n -> continue
FirstAt _ -> continue
WholeYear | month == Paulownia -> end scored
WholeYear -> continue
where

View file

@ -7,7 +7,7 @@ module Hanafuda.KoiKoi.Turn (
) where
import Hanafuda (Card, Pack, empty, match)
import Hanafuda.Player (Players, Player(..), plays)
import Hanafuda.Player (Player(..), plays)
import qualified Hanafuda.Player as Player (next)
import Hanafuda.KoiKoi.Yaku (meldInto)
import Hanafuda.KoiKoi.Game (Game, On(..), Step(..), raise, setPlayer, stop)
@ -22,11 +22,12 @@ catch on@(On_ {players, playing}) card (river, trick) =
played = (players ! playing) `plays` card
popNextCard :: On -> IO Game
popNextCard on@(On_ {river, stock = next : others, trick}) =
popNextCard (On_ {stock = []}) = raise "No more cards in the stack"
popNextCard on@(On_ {river, stock = turned : others}) =
let pop = on {stock = others} in
case match next river of
case match turned river of
Right (newRiver, newCaptured) -> end pop (newRiver, newCaptured)
Left _ -> stop $ pop {step = Turned next}
Left _ -> stop $ pop {step = Turned turned}
end :: On -> (Pack, [Card]) -> IO Game
end on@(On_ {month, trick, playing, players}) (river, newCaptured) = do

View file

@ -2,7 +2,7 @@
module Hanafuda.KoiKoi.Yaku where
import Hanafuda (Card(..), Monthly, Pack, add, contains, intersection, packOfCards, size)
import qualified Data.Map as M (Map, empty, insert, null, union, unionWith, (!))
import qualified Data.Map as M (Map, empty, insert, unionWith, (!))
import qualified Data.Set as S (Set, empty, singleton, union)
import Control.Monad.Reader (reader)
@ -33,7 +33,7 @@ instance Eq YakuFinder where
instance Ord YakuFinder where
compare a b = compare (yaku a) (yaku b)
type YakuByCard = M.Map Card (S.Set YakuFinder)
type YakusByCard = M.Map Card (S.Set YakuFinder)
lights :: Pack -> YakuRater
lights _ pack = rate (size pack) (pack `contains` RainMan)
@ -54,16 +54,16 @@ moreThan count _ pack =
let n = size pack - count in
if n > 0 then Just n else Nothing
index :: (Yaku, [Card], (Pack -> YakuRater)) -> YakuByCard
index :: (Yaku, [Card], (Pack -> YakuRater)) -> YakusByCard
index (yaku, cards, scorer) =
let pack = packOfCards cards in
let yakuFinder = YakuFinder {yaku, rater = scorer pack . intersection pack} in
foldl (\map card -> M.insert card (S.singleton yakuFinder) map) M.empty cards
foldl (\yakusByCard card -> M.insert card (S.singleton yakuFinder) yakusByCard) M.empty cards
finders :: Monthly YakuByCard
finders :: Monthly YakusByCard
finders = do
monthCardPlus <- reader $ (+) . (4*) . fromEnum
return $ foldl (\map -> M.unionWith S.union map . index) M.empty [
return $ foldl (\yakusByCard -> M.unionWith S.union yakusByCard . index) M.empty [
(Lights, [Crane, CampCurtain, FullMoon, RainMan, Phoenix], lights)
, (InoShikaCho, inoshikacho, fixed 5)
, (Tane, [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] ++ inoshikacho, moreThan 4)
@ -87,7 +87,7 @@ meldInto cards pack = do
return (foldl scored M.empty yakusToCheck, newPack)
where
newPack = foldl add pack cards
toCheck map = foldl (\set key -> S.union set (map M.! key)) S.empty cards
toCheck yakusByCard = foldl (\set key -> S.union set (yakusByCard M.! key)) S.empty cards
scored score (YakuFinder {yaku, rater}) = foldr (M.insert yaku) score $ rater newPack
sumYakus :: Score -> Points