riichi-scoring 0.4.0.0 → 0.4.0.1
raw patch · 5 files changed
+38/−28 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- riichi-scoring.cabal +1/−1
- src/Riichi/Display.hs +2/−2
- src/Riichi/Meld.hs +5/−3
- src/Riichi/Scoring.hs +0/−16
- test/Test.hs +30/−6
riichi-scoring.cabal view
@@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.0.0+version: 0.4.0.1 -- A short (one-line) description of the package. synopsis: A CLI tool for interpreting and scoring Riichi Mahjong hands. -- A longer description of the package.
src/Riichi/Display.hs view
@@ -19,7 +19,7 @@ import Riichi.Waits import Riichi.Yaku --- | Implements the "yaku" command for the CLI. In need of a refactor.+-- | Implements the "yaku" command for the CLI. displayHandYaku :: Hand -> IO () displayHandYaku hand = do if length hand < 14@@ -89,7 +89,7 @@ let waits = getWaits hand putStrLn $ "Waits are: " ++ (waits & map show & intersperse ", " & concat) --- | Implements the "score" command for the CLI. In need of a refactor, logic is rather serpentine at the moment.+-- | Implements the "score" command for the CLI. displayHandScore :: Hand -> IO () displayHandScore hand = do if length hand < 14
src/Riichi/Meld.hs view
@@ -184,9 +184,11 @@ & group & (map head) in- if possible_melds == []- then formMelds (tail hand)- else possible_melds+ possible_melds ++ (formMelds $ tail hand)++-- if possible_melds == []+-- then formMelds (tail hand)+-- else possible_melds -- | Count the tiles in a list of melds meldsLength :: [Meld] -> Int
src/Riichi/Scoring.hs view
@@ -38,22 +38,6 @@ -- | Get fu for a standard hand. Seven pairs and thirteen orphans, as ever, are handled separately type Fu = Int --- getFu :: InterpretedHand -> Wind -> Wind -> Bool -> Bool -> Bool -> Fu--- getFu (Pair tile, melds) seatWind roundWind goodWait tsumo closedHand =--- -- Perhaps a writer monad over the sum int monoid would be more elegant here but I think this more--- -- descriptive method is fine too.--- let meldsFu = melds & map getMeldFu & sum--- waitFu = if goodWait then 2 else 0--- yakuhaiFu =--- (if (tile & isDragon) then 2 else 0)--- + (if (tile == (Honour (Wind roundWind) 0)) then 2 else 0)--- + (if (tile == (Honour (Wind seatWind) 0)) then 2 else 0)--- ronClosedFu = if (not tsumo) && closedHand then 10 else 0--- tsumoFu = if tsumo then 2 else 0--- in roundUp (20 + meldsFu + waitFu + yakuhaiFu + ronClosedFu + tsumoFu)--- where--- roundUp n = last ([120, 110 .. 10] & filter (>= n))- -- | Given the han and fu, together with dealer and tsumo info, return the score of a hand getScore :: Han -> Fu -> Bool -> Bool -> Integer getScore han fu dealer tsumo =
test/Test.hs view
@@ -1,6 +1,7 @@ import Test.Tasty import Test.Tasty.HUnit +import Data.Maybe import Data.Set qualified as Set import Riichi.Context import Riichi.Meld@@ -16,7 +17,8 @@ "All tests" [ tileTests , meldsTests- , scoringTest+ , scoringTests+ , showTests ] tileTests :: TestTree@@ -61,8 +63,8 @@ (length ihs) @?= 3 ] -scoringTest :: TestTree-scoringTest =+scoringTests :: TestTree+scoringTests = testGroup "Scoring test group" [ testCase "Scoring test 1" $@@ -77,8 +79,30 @@ testHanHandScore "22221345663p NNN" "r" False False False False False North South False @?= (3, 40, 5200) , testCase "Scoring test 6" $ testHanHandScore "234m 7p 567s 34p 66p 66p 57p" "5s w" False False False False True North South False @?= (2, 40, 3900)+ , testCase "Scoring test 7" $+ testHanHandScore "22p 55m 33s 88p rr NN EE" "N" False False False False True North South True @?= (4, 25, 9600) ] +showTests :: TestTree+showTests =+ testGroup+ "Show test group"+ [ testCase "Tile show test 1" $ (show $ (read $ "1p" :: Tile)) @?= "1p"+ , testCase "Tile show test 2" $ (show $ (read $ "2m" :: Tile)) @?= "2m"+ , testCase "Tile show test 3" $ (show $ (read $ "3s" :: Tile)) @?= "3s"+ , testCase "Tile show test 4" $ (show $ (read $ "r" :: Tile)) @?= "r"+ , testCase "Tile show test 5" $ (show $ (read $ "g" :: Tile)) @?= "g"+ , testCase "Tile show test 6" $ (show $ (read $ "w" :: Tile)) @?= "w"+ , testCase "Tile show test 7" $ (show $ (read $ "N" :: Tile)) @?= "N"+ , testCase "Tile show test 8" $ (show $ (read $ "S" :: Tile)) @?= "S"+ , testCase "Tile show test 9" $ (show $ (read $ "E" :: Tile)) @?= "E"+ , testCase "Tile show test 10" $ (show $ (read $ "W" :: Tile)) @?= "W"+ , testCase "Tile show test 11" $ (show $ (read $ "0p" :: Tile)) @?= "5p*"+ , testCase "Hand show test" $+ (showInterpretedHand $ (head $ interpretHand $ (mkHand "123p 456m 789s NNN rr")))+ @?= "Pair r, Closed chi: 456 Man, Closed chi: 123 Pin, Closed chi: 789 Sou, Closed pon: NNN"+ ]+ testHanHandScore handString doraString riichi ippatsu tsumo closed dealer sw rw sevenPairs = let hand = mkHand handString@@ -100,9 +124,9 @@ , roundWind = rw } }- ih = head $ interpretHand hand'- yakuContext = mkYakuContext hand' (Just ih) handContext'- context = Context (Just ih) handContext' (Left yakuContext)+ ih = listToMaybe $ interpretHand hand'+ yakuContext = mkYakuContext hand' ih handContext'+ context = Context ih handContext' (Left yakuContext) (Left han) = getContextHanOrYakumans context fu = getContextFu context score = getScore han fu dealer tsumo