From 7d672589b2c54c9d7301c717315a0c623b36524f Mon Sep 17 00:00:00 2001 From: Sasha Date: Wed, 7 Mar 2018 23:22:45 +0100 Subject: [PATCH] Remove unused imports, minor code simplifications --- src/Hanafuda/Card.hs | 1 - src/Hanafuda/Day.hs | 6 +++--- src/Hanafuda/Game.hs | 2 +- src/Hanafuda/Month.hs | 18 +++++++++--------- src/Hanafuda/Yaku.hs | 7 ++++--- src/Hanafuda/Year.hs | 12 ++++-------- 6 files changed, 21 insertions(+), 25 deletions(-) diff --git a/src/Hanafuda/Card.hs b/src/Hanafuda/Card.hs index bb4d528..048bd70 100644 --- a/src/Hanafuda/Card.hs +++ b/src/Hanafuda/Card.hs @@ -8,7 +8,6 @@ import Data.Bits ( , shift , testBit , xor - , Bits , (.&.) , (.|.) , countTrailingZeros diff --git a/src/Hanafuda/Day.hs b/src/Hanafuda/Day.hs index 3183735..44b31fd 100644 --- a/src/Hanafuda/Day.hs +++ b/src/Hanafuda/Day.hs @@ -2,10 +2,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Hanafuda.Day where -import Hanafuda.Card (Card, Pack, Flower(Pine), contains, flower, packOfCards, pair, remove) +import Hanafuda.Card (Card, Pack, Flower(Pine), contains, flower, pair, remove) import Hanafuda.Yaku (rate) -import Hanafuda.Game (Game(..), Move(..), PlayerState, meld, plays, yakus) -import Data.Map (Map, adjust, empty, fromList, insert, union, (!)) +import Hanafuda.Game (Game(..), Move(..), PlayerState(..), plays) +import Data.Map (union) import Control.Monad.Reader (runReader) data Step = ToPlay | Turned Card | Scored | Over Bool diff --git a/src/Hanafuda/Game.hs b/src/Hanafuda/Game.hs index 5c72131..901ee59 100644 --- a/src/Hanafuda/Game.hs +++ b/src/Hanafuda/Game.hs @@ -2,7 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Hanafuda.Game where -import Data.Map (Map, empty, fromList, (!)) +import Data.Map (Map, empty, fromList) import Hanafuda.Card (Card, Pack, contains, packOfCards, remove) import Hanafuda.Yaku (Score, Points) diff --git a/src/Hanafuda/Month.hs b/src/Hanafuda/Month.hs index 786fc84..7d56919 100644 --- a/src/Hanafuda/Month.hs +++ b/src/Hanafuda/Month.hs @@ -4,8 +4,8 @@ module Hanafuda.Month where import Hanafuda.Card (Card, Flower(Pine), cards, shuffle, packOfCards) import Hanafuda.Day (Day(..)) -import qualified Hanafuda.Day as Day (Step(Over), next, new) -import Hanafuda.Game (Game(..), Move, Player, Players, PlayerState(..), initPlayers) +import qualified Hanafuda.Day as Day (Step(Over), new) +import Hanafuda.Game (Game(..), Player, Players, PlayerState(..), initPlayers) import qualified Hanafuda.Game as Game (next) import Data.Map ((!), insert) import Control.Monad.State (replicateM, runState, state) @@ -29,9 +29,11 @@ newtype Month = Month (Either Over On) go :: On -> Month go = Month . Right -new :: Player -> [Card] -> On -new playing shuffled = - On { +new :: Player -> IO On +new playing = do + ([hand1, hand2, river], next:stock) <- fmap (runState (replicateM 3 take8)) $ shuffle cards + let players = initPlayers [hand1, hand2] + return On { flower = Pine , players , day = Day.new (packOfCards river) (players ! playing) next @@ -42,13 +44,11 @@ new playing shuffled = } where take8 = state $ splitAt 8 - ([hand1, hand2, river], next:stock) = runState (replicateM 3 take8) shuffled - players = initPlayers [hand1, hand2] next :: On -> IO On next (On {flower, oyake}) = do - shuffled <- shuffle cards - return $ (new (Game.next oyake) shuffled) {flower = succ flower} + on <- new $ Game.next oyake + return $ on {flower = succ flower} instance Game On Month where play on@(On {flower, day, playing, players, stock = next : moreStock}) move = diff --git a/src/Hanafuda/Yaku.hs b/src/Hanafuda/Yaku.hs index ecbda89..38ff655 100644 --- a/src/Hanafuda/Yaku.hs +++ b/src/Hanafuda/Yaku.hs @@ -1,9 +1,9 @@ {-# LANGUAGE NamedFieldPuns #-} module Hanafuda.Yaku where -import Hanafuda.Card (Card(..), Flower, Monthly, Pack, add, contains, intersection, packOfCards, size) +import Hanafuda.Card (Card(..), Monthly, Pack, add, contains, intersection, packOfCards, size) import qualified Data.Map as M (Map, empty, insert, unionWith, (!)) -import qualified Data.Set as S (Set, empty, insert, singleton, union) +import qualified Data.Set as S (Set, empty, singleton, union) import Control.Monad.Reader (reader) data Yaku = @@ -70,7 +70,7 @@ finders = do , (Akatan, akatan, fixed 5) , (Aotan, aotan, fixed 5) , (Tan, [WisteriaRed, IrisRed, BushCloverRed, WillowRed] ++ aotan ++ akatan, moreThan 4) - , (Kasu, (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand], moreThan 9) + , (Kasu, plains, moreThan 9) , (TsukimiZake, [SakeCup, FullMoon], fixed 3) , (HanamiZake, [SakeCup, CampCurtain], fixed 3) , (TsukiFuda, map (toEnum . monthCardPlus) [0..3], fixed 5) @@ -79,6 +79,7 @@ finders = do inoshikacho = [Butterflies, Boar, Deer] aotan = [PeonyBlue, ChrysanthemumBlue, MapleBlue] akatan = [PinePoetry, PlumPoetry, CherryPoetry] + plains = (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand] rate :: Pack -> [Card] -> Monthly (Score, Pack) rate pack cards = do diff --git a/src/Hanafuda/Year.hs b/src/Hanafuda/Year.hs index eee2f12..81be772 100644 --- a/src/Hanafuda/Year.hs +++ b/src/Hanafuda/Year.hs @@ -3,11 +3,11 @@ {-# LANGUAGE FlexibleInstances #-} module Hanafuda.Year where -import Hanafuda.Card (Flower(Paulownia), cards, shuffle) +import Hanafuda.Card (Flower(Paulownia)) import Hanafuda.Month (Month(..), flower, next, score, winner) import qualified Hanafuda.Month as Month (On(..), Over(..), new) import Hanafuda.Game (Game(..), Player(Player1), Scores, deal) -import Data.Map (Map, insert, (!)) +import Data.Map (insert, (!)) import System.Random (StdGen) data Mode = FirstAt Int | WholeYear @@ -28,12 +28,8 @@ go = return . Year . Right new :: Mode -> IO Year new mode = do - shuffled <- shuffle cards - go $ On { - mode - , month = Month.new Player1 shuffled - , scores = deal $ cycle [0] - } + month <- Month.new Player1 + go $ On {mode , month , scores = deal $ cycle [0]} consolidate :: On -> Player -> Int -> IO Year consolidate on@(On {mode, month, scores}) winner score =