diplomacy 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+68/−39 lines, 6 filesdep ~TypeNatdep ~basedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: TypeNat, base, transformers

API changes (from Hackage documentation)

Files

• Data/AtLeast.hs +1/−1
• Diplomacy/Game.hs +23/−9
• Diplomacy/OrderValidation.hs +22/−17
• Diplomacy/Province.hs +10/−2
• Diplomacy/Unit.hs +2/−2
• diplomacy.cabal +10/−8

@@ -38,7 +38,7 @@ import Data.TypeNat.Nat import Data.TypeNat.Vect -data AtLeast (n :: Nat) (t :: *) = AtLeast (Vect t n) [t]+data AtLeast (n :: Nat) (t :: *) = AtLeast (Vect n t) [t]  -- Equality ignores order of elements. instance Eq t => Eq (AtLeast n t) where

@@ -42,6 +42,7 @@   , gameRound   , gameSeason   , issueOrders+  , removeBuildOrders   , resolve   , continue   , newGame@@ -456,9 +457,13 @@  -- | The game given as the second component of the return value will differ --   from the input game only if all orders are valid.---   NB for adjust phase we wipe all build orders; that's because there's+--+--   NB for adjust phase we wipe all build orders for every great power with+--   at least one order appearing in the input order set; that's because there's --   no way to explicitly remove a build order by overwriting it with some---   other order.+--   other order. This is due to the way we represent build orders: they are+--   in the game map alongside a unit which doesn't really exist yet. Removing+--   this order involves removing that entry in the map. issueOrders     :: forall round .        M.Map Zone (Aligned Unit, SomeOrderObject (RoundPhase round))@@ -466,7 +471,13 @@     -> (ValidateOrdersOutput (RoundPhase round), Game round RoundUnresolved) issueOrders orders game =     let nextGame = case game of-            AdjustGame AdjustRound _ _ _ _ -> issueOrdersUnsafe orders (removeBuildOrders game)+            AdjustGame AdjustRound _ _ _ _ -> issueOrdersUnsafe orders (removeBuildOrders greatPowers game)+              where+                -- All great powers who have an order in the orders set.+                greatPowers :: S.Set GreatPower+                greatPowers = M.fold pickGreatPower S.empty orders+                pickGreatPower :: (Aligned Unit, t) -> S.Set GreatPower -> S.Set GreatPower+                pickGreatPower (aunit, _) = S.insert (alignedGreatPower aunit)             _ -> issueOrdersUnsafe orders game         validation :: ValidateOrdersOutput (RoundPhase round)         allValid :: Bool@@ -671,17 +682,20 @@  removeBuildOrders     :: (RoundPhase round ~ Adjust)-    => Game round RoundUnresolved+    => S.Set GreatPower     -> Game round RoundUnresolved-removeBuildOrders game = case game of+    -> Game round RoundUnresolved+removeBuildOrders greatPowers game = case game of     AdjustGame AdjustRound s t zonedOrders c ->-        let zonedOrders' = M.filter (not . isBuild) zonedOrders+        let zonedOrders' = M.filter (not . shouldRemove) zonedOrders         in  AdjustGame AdjustRound s t zonedOrders' c   where-    isBuild :: (Aligned Unit, SomeOrderObject Adjust) -> Bool-    isBuild (_, SomeOrderObject object) = case object of-        BuildObject -> True+    shouldRemove :: (Aligned Unit, SomeOrderObject Adjust) -> Bool+    shouldRemove (aunit, SomeOrderObject object) = case (S.member greatPower greatPowers, object) of+        (True, BuildObject) -> True         _ -> False+      where+        greatPower = alignedGreatPower aunit  resolve     :: Game round RoundUnresolved

@@ -237,24 +237,29 @@     -> S.Set ProvinceTarget validSupportTargets subject = S.fromList $ do     x <- S.toList $ validMoveAdjacency Nothing subject+    guard (S.member x (unitCanOccupy (subjectUnit subject)))     provinceTargetCluster x --- | Valid support targets depend upon the support subject AND its chosen---   target! For example, if we choose to support into Brest, then a fleet---   in the Tyrrhenian Sea cannot be the support subject.+-- | Given two ProvinceTargets--the place from which support comes, and the+--   place to which support is directed--we can use an Occupation to discover+--   every subject which could be supported by this hypothetical supporter. validSupportSubjects     :: Occupation-    -> Subject-    -> ProvinceTarget+    -> ProvinceTarget -- ^ Source+    -> ProvinceTarget -- ^ Target     -> S.Set Subject-validSupportSubjects occupation subject target = M.foldWithKey f S.empty occupation+validSupportSubjects occupation source target = M.foldWithKey f S.empty occupation   where-    pt = subjectProvinceTarget subject     f zone aunit =-        -- validMoveTargets will give us non-hold targets, so we explicitly-        -- handle the case of a hold.-        if    target == zoneProvinceTarget zone-           || S.member target (validMoveTargets (Just occupation) subject')+        if    Zone source /= zone+           -- validMoveTargets will give us non-hold targets, so we explicitly+           -- handle the case of a hold.+           && (Zone target == zone+           -- If the subject here could move to the target, then it's a valid+           -- support target. We are careful *not* to use Zone-equality here,+           -- because in the case of supporting fleets into coastal territories,+           -- we want to rule out supporting to an unreachable coast.+           || S.member target (validMoveTargets (Just occupation) subject'))         then S.insert subject'         else id       where@@ -830,14 +835,14 @@     vc = -- Given a subject for the supporter, and a target for the support, we          -- characterize every valid subject which can be supported.          VCCons (\(ALCons (Identity (Identity pt)) (ALCons (Identity (Identity subject1)) ALNil)) -> Intersection [-              (SupportedCanDoMove, Union [S.filter (/= subject1) (validSupportSubjects occupation subject1 pt)])+              (SupportedCanDoMove, Union [S.filter (/= subject1) (validSupportSubjects occupation (subjectProvinceTarget subject1) pt)])             ])-        -- Given a subject for the supporter, we check every place into which-        -- that supporter could offer support; that's every place where it-        -- could move without a convoy.+        -- Given a subject (the one who offers support), we check every place+        -- into which that supporter could offer support; that's every place+        -- where it could move without a convoy (or one of the special coasts+        -- of that place).         . VCCons (\(ALCons (Identity (Identity subject)) ALNil) -> Intersection [-              (SupporterCanOccupy, Union [unitCanOccupy (subjectUnit subject)])-            , (SupporterAdjacent, Union [validSupportTargets subject])+              (SupporterAdjacent, Union [validSupportTargets subject])             ])         . VCCons (\ALNil -> Intersection [(SupportValidSubject, Union [S.fromList (allSubjects (Just greatPower) occupation)])])         $ VCNil

@@ -72,6 +72,7 @@ import qualified Data.Set as S import Data.String (fromString, IsString) import Data.List (sort)+import Data.Char (toUpper, toLower) import Diplomacy.GreatPower import Text.Parsec hiding ((<|>)) import Text.Parsec.Text@@ -741,7 +742,7 @@     reps pr = let (s, ss) = provinceStringRepresentations pr               in  (pr, s, ss)     makeParser :: (Province, String) -> Parser Province-    makeParser (p, s) = try (string s) *> pure p+    makeParser (p, s) = try (ciString s) *> pure p  provinceCoastStringRepresentations :: ProvinceCoast -> [String] provinceCoastStringRepresentations pc = provinceReps >>= addSuffix@@ -774,7 +775,7 @@     bundleReps pc = let ss = provinceCoastStringRepresentations pc                     in  (pc, ss)     makeParser :: (ProvinceCoast, [String]) -> Parser ProvinceCoast-    makeParser (pc, ss) = choice (fmap (try . string) ss) *> pure pc+    makeParser (pc, ss) = choice (fmap (try . ciString) ss) *> pure pc  parseProvinceTarget :: Parser ProvinceTarget parseProvinceTarget = try parseSpecial <|> parseNormal@@ -857,3 +858,10 @@         case indicator x of             Just y -> return (y, first, rest)             Nothing -> empty++-- case-insensitive string parser.+ciString :: String -> Parser String+ciString = mapM ciChar++ciChar :: Char -> Parser Char+ciChar c = char (toLower c) <|> char (toUpper c)

@@ -41,9 +41,9 @@ parseUnit = parseFleet <|> parseArmy   where     parseFleet :: Parser Unit-    parseFleet = char 'F' *> pure Fleet+    parseFleet = (char 'F' <|> char 'f') *> pure Fleet     parseArmy :: Parser Unit-    parseArmy = char 'A' *> pure Army+    parseArmy = (char 'A' <|> char 'a') *> pure Army  printUnit :: IsString a => Unit -> a printUnit unit = case unit of

@@ -2,20 +2,23 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                diplomacy-version:             0.1.0.0-synopsis:            The board game Diplomacy, spoken in Haskell--- description:         +version:             0.2.0.0+synopsis:            Diplomacy board game+description:         The board game Diplomacy, spoken in Haskell homepage:            https://github.com/avieth/diplomacy license:             BSD3 license-file:        LICENSE author:              Alexander Vieth maintainer:          aovieth@gmail.com -- copyright:           --- category:            +category:            Games build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10 +source-repository head+  type: git+  location: http://github.com/avieth/diplomacy.git  library   exposed-modules:     Diplomacy.OrderObject@@ -59,12 +62,11 @@                      , RankNTypes                      , PatternSynonyms -  build-depends:       base >=4.7 && <4.8+  build-depends:       base >=4.7 && <4.11                      , containers >=0.5 && <0.6-                     , transformers >=0.3 && <0.4+                     , transformers >=0.3 && <0.6                      , HUnit >=1.2 && <1.3-                     , TypeNat >=0.4 && <0.5+                     , TypeNat >=0.5 && <0.6                      , parsec >= 3.1 && <3.2   -- hs-source-dirs:         default-language:    Haskell2010-