diplomacy-0.1.0.0: Diplomacy/Occupation.hs

{-|
Module      : Diplomacy.Occupation
Description : Definition of Zone/ProvinceTarget occupation.
Copyright   : (c) Alexander Vieth, 2015
Licence     : BSD3
Maintainer  : aovieth@gmail.com
Stability   : experimental
Portability : non-portable (GHC only)
-}

{-# LANGUAGE AutoDeriveTypeable #-}

module Diplomacy.Occupation (

    Occupation

  , emptyOccupation
  , occupy
  , occupier
  , provinceOccupier
  , occupies
  , unitOccupies
  , occupied
  , zoneOccupied
  , allSubjects

  ) where

import qualified Data.Map as M
import Data.MapUtil
import Data.Maybe (isJust)
import Diplomacy.Aligned
import Diplomacy.Unit
import Diplomacy.Province
import Diplomacy.Zone
import Diplomacy.Subject
import Diplomacy.GreatPower

-- | Each Zone is occupied by at most one Aligned Unit, but the functions on
--   Occupation work with ProvinceTarget; the use of Zone as a key here is just
--   to guarantee that we don't have, for instance, units on both of Spain's
--   coasts simultaneously.
type Occupation = M.Map Zone (Aligned Unit)

emptyOccupation :: Occupation
emptyOccupation = M.empty

occupy :: ProvinceTarget -> Maybe (Aligned Unit) -> Occupation -> Occupation
occupy pt maunit = M.alter (const maunit) (Zone pt)

-- | Must be careful with this one! We can't just lookup the Zone corresponding
--   to the ProvinceTarget; we must also check that the key matching that Zone,
--   if there is one in the map, is also ProvinceTarget-equal.
occupier :: ProvinceTarget -> Occupation -> Maybe (Aligned Unit)
occupier pt occupation = case lookupWithKey (Zone pt) occupation of
    Just (zone, value) ->
        if zoneProvinceTarget zone == pt
        then Just value
        else Nothing
    _ -> Nothing

provinceOccupier :: Province -> Occupation -> Maybe (Aligned Unit)
provinceOccupier pr occupation = case lookupWithKey (Zone (Normal pr)) occupation of
    Just (zone, value) ->
        if zoneProvinceTarget zone == Normal pr
        then Just value
        else Nothing
    _ -> Nothing

occupies :: Aligned Unit -> ProvinceTarget -> Occupation -> Bool
occupies aunit pt = (==) (Just aunit) . occupier pt

unitOccupies :: Unit -> ProvinceTarget -> Occupation -> Bool
unitOccupies unit pt = (==) (Just unit) . fmap alignedThing . occupier pt

occupied :: ProvinceTarget -> Occupation -> Bool
occupied pt = isJust . occupier pt

zoneOccupied :: Zone -> Occupation -> Bool
zoneOccupied zone = isJust . M.lookup zone

allSubjects :: Maybe GreatPower -> Occupation -> [Subject]
allSubjects maybeGreatPower = M.foldWithKey f []
  where
    f zone aunit =
        let subject = (alignedThing aunit, zoneProvinceTarget zone)
        in  if maybeGreatPower == Nothing || Just (alignedGreatPower aunit) == maybeGreatPower
            then (:) subject
            else id