-- hsdip -- a diplomacy parser/renderer.
-- Copyright (C) 2006 Evan Martin <martine@danga.com>

module Diplomacy where

data Power = Austria | England | France | Germany
           | Italy | Russia | Turkey deriving (Eq, Show, Read)

powerNames :: [[Char]]
powerNames = ["Austria", "England", "France", "Germany",
              "Italy", "Russia", "Turkey"]

data Unit = Army | Fleet deriving (Eq, Show)
type Location = String
type UnitLoc = (Unit, Location)

data Move = Hold
          | Attack Location
          | Support UnitMove
          | Convoy  UnitMove deriving (Eq, Show)
data UnitMove = UnitMove UnitLoc Move deriving (Eq, Show)

type UnitMoveTry = (UnitMove, Bool)

type Ownership = (Maybe Power, [Location])
type PowerPos = (Power, [UnitLoc])
type PowerMove = (Power, [UnitMoveTry])

type Year = Int
data Season = Spring | Fall deriving (Eq, Show, Ord)
data TurnType = Movement | Adjustment | Retreat deriving (Eq, Show, Ord)
type Time = (Year, Season, TurnType)
data Turn = Turn {
  turnName :: String,
  turnTime :: Time,
  turnUnits :: [PowerPos],
  turnMoves :: [PowerMove],
  turnOwnership :: [Ownership]
}
emptyTurn :: Turn
emptyTurn = Turn "" (1901, Spring, Movement) [] [] []

showTurn :: Turn -> String -> String
showTurn (Turn name time units moves _) =
  lline "Turn" (showString name)
  . lline "Time" (shows time)
  . lline "Units" (showUnits units)
  . lline "Moves" (showMoves moves)
  -- . lline "Ownership" (showOwnership ownership)
    where
      newline :: ShowS
      newline = showChar '\n'
      lline :: String -> ShowS -> ShowS
      lline label s = showString label . showString ": " . s . newline
      indented :: ShowS -> ShowS
      indented s = showString "  " . s . newline
      showPowers :: (a -> ShowS) -> [(Power, [a])] -> ShowS
      showPowers f = mapShowS (\(power,d) ->
                                shows power . newline .
                                mapShowS (indented . f) d)
      showUnits :: [(Power, [UnitLoc])] -> ShowS
      showUnits = showPowers $ showUnitLoc
      showMoves = showPowers $ showMoveTry
      showMoveTry (UnitMove uloc move, failed) =
        showUnitLoc uloc . showChar ' ' . shows move .
        if failed then showString " (*failed*)" else id
      showUnitLoc :: UnitLoc -> ShowS
      showUnitLoc (unit, loc) = shows unit . showChar ' ' . showString loc
      mapShowS :: (a -> ShowS) -> [a] -> ShowS
      mapShowS f = foldl (\a b -> a . f b) id

instance Show Turn where
  showsPrec _ = showTurn

-- vim: set ts=2 sw=2 et :