Actually, why name IDs «Key» when that will be needed for encryption ?

hanafuda.cabal

@@ -31,7 +31,7 @@ library
   exposed-modules:     Hanafuda
                      , Hanafuda.KoiKoi
                      , Hanafuda.Player
-                     , Hanafuda.Key
+                     , Hanafuda.ID
   other-modules:       Hanafuda.KoiKoi.Game
                      , Hanafuda.KoiKoi.Round
                      , Hanafuda.KoiKoi.Turn

src/Hanafuda/ID.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Hanafuda.ID (
+      ID(..)
+    , getID
+  ) where
+
+newtype ID a = ID Int deriving (Eq, Ord, Enum, Read, Show)
+
+getID :: ID a -> String
+getID (ID n) = show n

src/Hanafuda/Key.hs

@@ -1,10 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Hanafuda.Key (
-      Key(..)
-    , getKey
-  ) where
-
-newtype Key a = Key Int deriving (Eq, Ord, Enum, Read, Show)
-
-getKey :: Key a -> String
-getKey (Key n) = show n

src/Hanafuda/KoiKoi.hs

@@ -6,10 +6,10 @@ module Hanafuda.KoiKoi (
     , Environment
     , Game
     , GameBlueprint(..)
-    , GameKey
+    , GameID
     , Mode(..)
     , Move(..)
-    , PlayerKey
+    , PlayerID
     , Score
     , Source(..)
     , Step(..)
@@ -22,7 +22,7 @@ import Hanafuda (Card(..), Flower(Pine), contains, flower, match, remove)
 import qualified Hanafuda.Player as Player (players, random, scores)
 import Hanafuda.KoiKoi.Yaku (Yaku(..), Score)
 import Hanafuda.KoiKoi.Game (
-      Action(..), Environment, Game, GameBlueprint(..), GameKey, Mode(..), Move(..), PlayerKey
+      Action(..), Environment, Game, GameBlueprint(..), GameID, Mode(..), Move(..), PlayerID
     , Source(..), Step(..)
   )
 import qualified Hanafuda.KoiKoi.Round as Round (deal, next)
@@ -49,7 +49,7 @@ play move game@(Game {river, step}) =
   where
     canCatch card1 card2 = flower card1 == flower card2 && river `contains` card2
 
-new :: MonadIO m => [PlayerKey] -> Mode -> m Game
+new :: MonadIO m => [PlayerID] -> Mode -> m Game
 new playersList mode = do
   playing <- Player.random players
   Round.deal $ Game {

src/Hanafuda/KoiKoi/Game.hs

@@ -6,11 +6,11 @@ module Hanafuda.KoiKoi.Game (
     , Environment
     , Game
     , GameBlueprint(..)
-    , GameKey
+    , GameID
-    , Key
+    , ID
     , Mode(..)
     , Move(..)
-    , PlayerKey
+    , PlayerID
     , Source(..)
     , Step(..)
     , end
@@ -21,10 +21,10 @@ import Control.Monad.Except (MonadError)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Writer (MonadWriter)
 import Hanafuda (Card, Flower, Pack)
-import Hanafuda.Key (Key)
+import Hanafuda.ID (ID)
 import qualified Hanafuda.KoiKoi.Yaku as KoiKoi (Score)
 import Hanafuda.Player (Players, Player, Scores, set)
-import qualified Hanafuda.Player as Player (Key)
+import qualified Hanafuda.Player as Player (ID)
 
 data Mode = FirstAt Int | WholeYear deriving (Show)
 data Move = Play Card | Capture (Card, Card) | Choose Card | KoiKoi Bool
@@ -37,22 +37,22 @@ data Action = Action {
   } deriving (Show)
 
 type Environment m = (MonadIO m, MonadError String m, MonadWriter [Action] m)
-type PlayerKey = Player.Key KoiKoi.Score
+type PlayerID = Player.ID KoiKoi.Score
-type GameKey = Key Game
+type GameID = ID Game
 
 data GameBlueprint deckType = Game {
       mode :: Mode
     , scores :: Scores KoiKoi.Score
     , month :: Flower
     , players :: Players KoiKoi.Score
-    , playing :: PlayerKey
+    , playing :: PlayerID
-    , winning :: PlayerKey
+    , winning :: PlayerID
-    , oyake :: PlayerKey
+    , oyake :: PlayerID
     , deck :: deckType
     , river :: Pack
     , step :: Step
     , trick :: [Card]
-    , rounds :: [(PlayerKey, KoiKoi.Score)]
+    , rounds :: [(PlayerID, KoiKoi.Score)]
   } deriving (Show)
 type Game = GameBlueprint [Card]
 

src/Hanafuda/Player.hs

@@ -3,23 +3,23 @@
 module Hanafuda.Player where
 
 import Hanafuda (Card, Pack, contains, packOfCards, remove)
-import qualified Hanafuda.Key as Hanafuda (Key)
+import qualified Hanafuda.ID as Hanafuda (ID)
 import Data.Map ((!), Map, adjust, elemAt, empty, findMin, fromList, insert, keys, singleton, size)
 import qualified Data.Map as Map (filter)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Except (MonadError(..))
 import System.Random (Random(..))
 
-type Key yakus = Hanafuda.Key (Player yakus)
+type ID yakus = Hanafuda.ID (Player yakus)
 data Player yakus = Player {
       hand :: Pack
     , meld :: Pack
-    , nextPlayer :: Key yakus
+    , nextPlayer :: ID yakus
     , yakus :: yakus
   } deriving (Show)
-newtype Players yakus = Players (Map (Key yakus) (Player yakus)) deriving (Show)
+newtype Players yakus = Players (Map (ID yakus) (Player yakus)) deriving (Show)
 
-new :: Monoid yakus => (Key yakus) -> Player yakus
+new :: Monoid yakus => (ID yakus) -> Player yakus
 new nextPlayer = Player {
       hand = packOfCards []
     , meld = packOfCards []
@@ -27,37 +27,39 @@ new nextPlayer = Player {
     , yakus = mempty
   }
 
-players :: Monoid yakus => [Key yakus] -> Players yakus
+players :: Monoid yakus => [ID yakus] -> Players yakus
 players [] = Players empty
 players [player] = Players $ singleton player $ new player
 players (alice:others@(bob:_)) =
-  let Players playersByKey = players others in
+  let Players playersByID = players others in
-  let (before, _) = findMin $ Map.filter ((== bob) . nextPlayer) playersByKey in
+  let (before, _) = findMin $ Map.filter ((== bob) . nextPlayer) playersByID in
-  Players $ insert alice (new bob) $ adjust (setNextPlayer alice) before playersByKey
+  Players $ insert alice (new bob) $ adjust (setNextPlayer alice) before playersByID
   where
     setNextPlayer nextPlayer player = player {nextPlayer}
 
-next :: Players yakus -> (Key yakus) -> (Key yakus)
+next :: Players yakus -> (ID yakus) -> (ID yakus)
-next (Players playersByKey) = nextPlayer . (playersByKey !)
+next (Players playersByID) = nextPlayer . (playersByID !)
 
-random :: MonadIO m => Players yakus -> m (Key yakus)
+random :: MonadIO m => Players yakus -> m (ID yakus)
-random (Players playersByKey) =
+random (Players playersByID) =
-  fst . ($ playersByKey) . elemAt <$> randomIndex
+  fst . ($ playersByID) . elemAt <$> randomIndex
   where
-    randomIndex = liftIO $ randomRIO (0, size playersByKey - 1)
+    randomIndex = liftIO $ randomRIO (0, size playersByID - 1)
 
-get :: (Key yakus) -> Players yakus -> Player yakus
+get :: (ID yakus) -> Players yakus -> Player yakus
-get key (Players playersByKey) = playersByKey ! key
+get playerID (Players playersByID) = playersByID ! playerID
 
-set :: (Key yakus) -> Player yakus -> Players yakus -> Players yakus
+set :: (ID yakus) -> Player yakus -> Players yakus -> Players yakus
-set key player (Players playersByKey) = Players $ insert key player playersByKey
+set playerID player (Players playersByID) = Players $ insert playerID player playersByID
 
 deal :: Monoid yakus => Players yakus -> [[Card]] -> Players yakus
-deal (Players playersByKey) hands =
+deal (Players playersByID) hands =
-  Players $ snd $ foldl dealTo (fst $ findMin playersByKey, playersByKey) hands
+  Players $ snd $ foldl dealTo (fst $ findMin playersByID, playersByID) hands
   where
-    setHand cards (Player {nextPlayer}) = (new nextPlayer) {hand = packOfCards cards}
+    setHand cards (Player {nextPlayer}) =
-    dealTo (key, m) hand = (nextPlayer $ m ! key, adjust (setHand hand) key m)
+      (new nextPlayer) {hand = packOfCards cards}
+    dealTo (playerID, m) hand =
+      (nextPlayer $ m ! playerID, adjust (setHand hand) playerID m)
 
 plays :: MonadError String m => Player yakus -> Card -> m (Player yakus)
 plays player@(Player {hand}) card =
@@ -66,7 +68,7 @@ plays player@(Player {hand}) card =
     else throwError "You don't have this card"
 
 type Points = Int
-type Scores yakus = Map (Key yakus) Points
+type Scores yakus = Map (ID yakus) Points
 
 score :: (yakus -> Points) -> Player yakus -> Points
 score rater = rater . yakus