Build yaku dictionary a bit more efficiently

KoiKoi.hs

@@ -1,8 +1,9 @@
+{-# LANGUAGE NamedFieldPuns #-}
 module KoiKoi where
 
 import CCard
-import Data.Bits (popCount, (.&.), shift, testBit)
+import Data.Bits (popCount, (.|.), (.&.), shift, xor)
-import Data.Map (Map, empty, insert, unionWith)
+import Data.Map (Map, empty, insert, unionWith, (!))
 
 data Yaku =
     Goko
@@ -18,14 +19,15 @@ data Yaku =
   | TsukimiZake
   | HanamiZake
   | TsukiFuda
-  deriving (Show)
+  deriving (Eq, Ord, Show)
 type Points = Int
-type Score = Pack -> Maybe (Yaku, Points)
+type YakuFinder = Pack -> Maybe (Yaku, Points)
+type Score = Map Yaku Points
 
 data Player = Player {
       hand :: Pack
     , captured :: Pack
-    , scored :: Map Yaku Points
+    , scored :: Score
   }
 
 data State = State {
@@ -36,39 +38,57 @@ data State = State {
     , turn :: Bool
   }
 
-has :: Pack -> (Yaku, Points) -> (Pack, Score)
+fixed :: (Yaku, Points) -> Pack -> YakuFinder
-has pack points =
+fixed points indicatorSet pack = if pack == indicatorSet then Just points else Nothing
-  (pack, \p -> if p == pack then Just points else Nothing)
 
-moreThan :: Int -> Pack -> Yaku -> (Pack, Score)
+moreThan :: Int -> Yaku -> (Pack -> YakuFinder)
-moreThan count pack yaku =
+moreThan count yaku _ =
-  (pack, (\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount)
+  (\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount
 
-hikari :: (Pack, Score)
+lights :: [Card]
-hikari = (lights, \p -> rate (popCount p) (p `contains` RainMan))
+lights = [Crane, CampCurtain, FullMoon, RainMan, Phoenix]
+
+hikari :: Pack -> YakuFinder
+hikari _ pack = rate (popCount pack) (pack `contains` RainMan)
   where
     rate 5 _ = Just (Goko, 10)
     rate 4 hasRainMan = if hasRainMan then Just (AmeShiko, 7) else Just (Shiko, 8)
     rate n hasRainMan = if not hasRainMan && n > 2 then Just (Sanko, 5) else Nothing
 
-tsukiFuda :: Flower -> (Pack, Score)
+tsukiFuda :: Flower -> ([Card], Pack -> YakuFinder)
-tsukiFuda flower = has (0xf `shift` (fromEnum flower * 4)) (TsukiFuda, 8)
+tsukiFuda flower = (map toEnum $ map (fromEnum flower * 4 +) [0..3], fixed (TsukiFuda, 8))
 
-index :: (Pack, Score) -> Map Card [Score]
+index :: ([Card], Pack -> YakuFinder) -> Map Card [YakuFinder]
-index (pack, score) =
+index (cards, scorer) =
-  foldl (\map card ->
+  let pack = packOfCards cards in
-    if testBit pack $ fromEnum card then insert card [score . (.&.) pack] map else map
+  foldl (\map card -> insert card [scorer pack . (.&.) pack] map) empty cards
-  ) empty cards
 
-yakus :: Map Card [Score]
+inoshikacho :: [Card]
+inoshikacho = [Butterflies, Boar, Deer]
+
+animals :: [Card]
+animals = [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] ++ inoshikacho
+
+blue :: [Card]
+blue = [PeonyBlue, ChrysanthemumBlue, MapleBlue]
+
+poetry :: [Card]
+poetry = [PinePoetry, PlumPoetry, CherryPoetry]
+
+ribbons = [WisteriaRed, IrisRed, BushCloverRed, WillowRed] ++ blue ++ poetry
+
+plain :: [Card]
+plain = (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand]
+
+yakus :: Map Card [YakuFinder]
 yakus = foldl (\map -> unionWith (++) map . index) empty [
-      hikari
+      (lights, hikari)
-    , has inoshikacho (InoShikaCho, 5)
+    , (inoshikacho, fixed (InoShikaCho, 5))
-    , moreThan 4 animals Tane
+    , (animals, moreThan 4 Tane)
-    , has poetry (Akatan, 5)
+    , (poetry, fixed (Akatan, 5))
-    , has blue (Aotan, 5)
+    , (blue, fixed (Aotan, 5))
-    , moreThan 4 ribbons Tan
+    , (ribbons, moreThan 4 Tan)
-    , moreThan 9 plain Kasu
+    , (plain, moreThan 9 Kasu)
-    , has (set [SakeCup, FullMoon]) (TsukimiZake, 5)
+    , ([SakeCup, FullMoon], fixed (TsukimiZake, 5))
-    , has (set [SakeCup, CampCurtain]) (HanamiZake, 5)
+    , ([SakeCup, CampCurtain], fixed (HanamiZake, 5))
   ]