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

View file

@ -18,7 +18,7 @@ import qualified Hanafuda.KoiKoi.Turn as Turn (catch, end, next)
import System.Random (randomIO) import System.Random (randomIO)
play :: Move -> On -> IO Game play :: Move -> On -> IO Game
play move on@(On_ {river, step, trick}) = play move on@(On_ {river, step}) =
case (step, move) of case (step, move) of
(ToPlay, Play card) -> (ToPlay, Play card) ->
either raise (Turn.catch on card) $ match card river 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}) = next on@(On_ {mode, scores, month, players, oyake, winning}) =
case mode of case mode of
FirstAt n | n <= newScore -> end scored FirstAt n | n <= newScore -> end scored
FirstAt n -> continue FirstAt _ -> continue
WholeYear | month == Paulownia -> end scored WholeYear | month == Paulownia -> end scored
WholeYear -> continue WholeYear -> continue
where where

View file

@ -7,7 +7,7 @@ module Hanafuda.KoiKoi.Turn (
) where ) where
import Hanafuda (Card, Pack, empty, match) 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 qualified Hanafuda.Player as Player (next)
import Hanafuda.KoiKoi.Yaku (meldInto) import Hanafuda.KoiKoi.Yaku (meldInto)
import Hanafuda.KoiKoi.Game (Game, On(..), Step(..), raise, setPlayer, stop) 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 played = (players ! playing) `plays` card
popNextCard :: On -> IO Game 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 let pop = on {stock = others} in
case match next river of case match turned river of
Right (newRiver, newCaptured) -> end pop (newRiver, newCaptured) 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 -> (Pack, [Card]) -> IO Game
end on@(On_ {month, trick, playing, players}) (river, newCaptured) = do end on@(On_ {month, trick, playing, players}) (river, newCaptured) = do

View file

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