{-# LANGUAGE ViewPatterns, LambdaCase, RankNTypes #-}

module Main (main) where

import System.IO
import Control.Applicative
import Control.Arrow (first, second, (>>>))
import Control.Monad
import Control.Monad.Writer
import Data.Either
import Data.Foldable
import Data.Function
import Data.Functor.Identity
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid

import qualified Data.Map as M

type EntityId  = Int
type FactoryId = Int

data PlayerId = ThisPlayer | Neutral | Opponent deriving (Eq, Ord, Show)

data Factory = Factory { factoryId         :: EntityId
                       , factoryOwner      :: PlayerId
                       , factoryCyborgs    :: Int
                       , factoryProduction :: Int
                       , factoryTurnsLeft  :: Int
                       } deriving (Eq, Show)

data Troop   = Troop   { troopId           :: EntityId
                       , troopOwner        :: PlayerId
                       , troopOrigin       :: FactoryId
                       , troopTarget       :: FactoryId
                       , troopCyborgs      :: Int
                       , troopTurnsLeft    :: Int
                       } deriving (Eq, Show)

data Bomb    = Bomb    { bombId            :: EntityId
                       , bombOwner         :: PlayerId
                       , bombOrigin        :: FactoryId
                       , bombTarget        :: FactoryId
                       , bombTurnsLeft     :: Int
                       } deriving (Eq, Show)

data Action  = Move FactoryId FactoryId Int
             | SendBomb FactoryId FactoryId
             | Increase FactoryId
             | Wait
             deriving (Eq, Show)

data GameState =
   GameState
      { gsLinks      :: M.Map (FactoryId, FactoryId) Int
      , gsFactories  :: [Factory]
      , gsTroops     :: [Troop]
      , gsBombs      :: [Bomb]
      , gsBombsLeft  :: M.Map PlayerId Int
      , gsNextEntity :: EntityId
      , gsTurnCount  :: Int
      } deriving (Show)

main :: IO ()
main = do
   hSetBuffering stdout NoBuffering -- DO NOT REMOVE

   factoryCount <- readLn :: IO Int -- the number of factories (not used)
   linkCount    <- readLn :: IO Int -- the number of links between factories

   links <- fmap (M.fromList . concat) $ replicateM linkCount $ do
      [f1, f2, dist] <- map read . words <$> getLine
      pure ([((f1, f2), dist), ((f2, f1), dist)] :: [((FactoryId, FactoryId), Int)])

   turnCountRef <- newIORef 1
   bombsLeftRef <- newIORef $ M.fromList [(ThisPlayer, 2), (Opponent, 2)]

   forever $ do
      entityCount <- readLn :: IO Int
      (second partitionEithers . partitionEithers ->
            (factoryList, (troopList, bombList))) <- replicateM entityCount $ do
         ((read -> eId):eType:(parsePlayerId . read -> a1)
            :(map read -> [a2,a3,a4,a5])) <- words <$> getLine
         pure $ case eType of
               "FACTORY" -> Left          $ Factory eId a1 a2 a3 a4
               "TROOP"   -> Right . Left  $ Troop   eId a1 a2 a3 a4 a5
               "BOMB"    -> Right . Right $ Bomb    eId a1 a2 a3 a4

      let nextEntity = (+1) $ maximum $ 0 : map (view entityId) factoryList
                                         ++ map (view entityId) troopList
                                         ++ map (view entityId) bombList

      turnCount <- readIORef turnCountRef
      bombsLeft <- readIORef bombsLeftRef

      let gs = GameState { gsLinks      = links
                         , gsFactories  = factoryList
                         , gsTroops     = troopList
                         , gsBombs      = bombList
                         , gsNextEntity = nextEntity
                         , gsTurnCount  = turnCount
                         , gsBombsLeft  = bombsLeft
                         }

      let oppActions    = [] -- chooseActions (flipSides gs) []
      let chosenActions = chooseActions gs [(Opponent, oppActions)]

      case chosenActions of
         [] -> putStrLn $ actionString Wait
         xs -> putStrLn $ intercalate "; " $ map actionString xs

      forM_ chosenActions $ \case
         SendBomb _ _ -> modifyIORef bombsLeftRef (M.update (Just . max 0 . subtract 1) ThisPlayer)
         _            -> pure ()

      modifyIORef turnCountRef (+1)

awareness, foresight :: Int
awareness = 10  -- number of actions to consider
foresight = 20  -- number of moves to look ahead (>10)

scoreGame :: GameState -> Double
scoreGame gs = (playerScore ThisPlayer :: Double)
             / (playerScore Opponent + 100)
   where
      playerScore p = fromIntegral
                    $   1 * numCyborgs
                    +  15 * produced
                    +  50 * factories
                    +  60 * bombsLeft
         where
            numCyborgs = sum [ f^.cyborgs | f <- gsFactories gs, ownedBy p f ]
                       + sum [ (30 * t^.cyborgs) `div` (30 + t^.turnsLeft)
                             | t <- gsTroops gs, ownedBy p t ]
            produced   = sum [ f^.production | f <- gsFactories gs, ownedBy p f, f^.turnsLeft == 0 ]
            factories  = count (ownedBy p) (gsFactories gs)
            bombsLeft  = fromMaybe 0 $ M.lookup p (gsBombsLeft gs)

chooseActions :: GameState -> [(PlayerId, [Action])] -> [Action]
chooseActions gs acts = loop [] (scoreGame (simulate acts foresight gs)) (allFactoryActions ++ bombActions)
   where
      loop cs sc as = case best awareness $ map (\a -> (scoreActions (cs ++ [a]), a)) as of
         (sc',a):rs | sc' > sc -> loop (cs ++ [a]) sc' (map snd rs)
         _                     -> cs

      scoreActions as = 3 * scoreGame (simulate (acts++[(ThisPlayer, as)])  5 gs)
                      + 2 * scoreGame (simulate (acts++[(ThisPlayer, as)]) 10 gs)
                      + 1 * scoreGame (simulate (acts++[(ThisPlayer, as)]) foresight gs)

      myFactories = filter (ownedBy ThisPlayer) (gsFactories gs)

      transitMap = M.fromList $ do
         to <- map (view entityId) (gsFactories gs)
         let troops = filter ((== to) . view target) (gsTroops gs)
         let (myTroops, theirTroops) = partition (ownedBy ThisPlayer) troops
         let mine   = sum $ map (view cyborgs) myTroops
         let theirs = sum $ map (view cyborgs) theirTroops
         pure (to, (mine, theirs))
      inTransitTo dst = fromMaybe (0, 0) $ M.lookup dst transitMap

      distributeScores src = do
         dst <- myFactories
         guard $ dst^.entityId /= src^.entityId
         let amount' = src^.cyborgs
         amount <- nub [amount', amount' `div` 3, src^.production]
         guard $ amount > 0 && amount <= src^.cyborgs
         dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
         pure $ Move (src^.entityId) (dst^.entityId) amount

      attackScores src = do
         dst <- filter (not . ownedBy ThisPlayer) (gsFactories gs)
         dist <- toList $ M.lookup (src^.entityId, dst^.entityId) (gsLinks gs)
         let (mineDefending, theirsAttacking) = inTransitTo (src^.entityId)
         let (mineAttacking, theirsDefending) = inTransitTo (dst^.entityId)
         let myTotal    = src^.cyborgs - theirsAttacking
         let theirTotal = dst^.cyborgs + theirsDefending - mineAttacking
         let theirEstimate
               | ownedBy Neutral dst = theirTotal
               | otherwise = theirTotal + dst^.production * (1 + dist)
         let amount' = theirEstimate + 1
         amount <- nub [2 * amount', amount', amount' `div` 2, src^.production]
         guard $ amount > 0 && amount <= src^.cyborgs
         pure $ Move (src^.entityId) (dst^.entityId) amount

      increaseScores src = do
         guard $ src^.production < 3
         guard $ src^.cyborgs >= 10
         pure $ Increase (src^.entityId)

      factoryActions src = concatMap ($ src) [ distributeScores
                                             , attackScores
                                             , increaseScores
                                             ]

      allFactoryActions = concatMap factoryActions myFactories

      bombActions = do
         guard $ fromMaybe 0 (M.lookup ThisPlayer $ gsBombsLeft gs) > 0
         dst <- gsFactories gs
         src <- toList $ fmap snd $ safeMinimumBy (compare `on` fst) $ do
               src' <- myFactories
               guard $ src'^.entityId /= dst^.entityId
               dist <- toList $ M.lookup (src'^.entityId, dst^.entityId) (gsLinks gs)
               pure (dist, src')
         pure $ SendBomb (src^.entityId) (dst^.entityId)

simulate :: [(PlayerId, [Action])] -> Int -> GameState -> GameState
simulate orders n gs
   | n > 0 = simulate [] (n-1) (gameTurn orders gs)
   | otherwise = gs

gameTurn :: [(PlayerId, [Action])] -> GameState -> GameState
gameTurn orders = moveTroops
              >>> moveBombs
              >>> processOrders orders
              >>> produceCyborgs
              >>> solveBattles
              >>> explodeBombs

moveTroops, moveBombs :: GameState -> GameState
moveTroops gs0 = gs0 { gsTroops = map (over turnsLeft (subtract 1)) (gsTroops gs0) }
moveBombs  gs0 = gs0 { gsBombs  = map (over turnsLeft (subtract 1)) (gsBombs  gs0) }

processOrders :: [(PlayerId, [Action])] -> GameState -> GameState
processOrders orders gs0 = foldl processOrder gs0 orders
   where
      processOrder gs (p, as) = foldl (processAction p) gs as
      processAction p gs = \case
         Move from to amt -> processMove p from to amt gs
         SendBomb from to -> processBomb p from to gs
         Increase factory -> processIncrease p factory gs
         Wait             -> gs
      processMove p from to amt gs
         | f:_ <- filter ((== from) . view entityId) (gsFactories gs)
         , ownedBy p f
         , adjAmt <- min (f^.cyborgs) amt
         = gs { gsFactories = map (\f -> if f^.entityId /= from then f else
                                         over cyborgs (subtract adjAmt) f)
                                  (gsFactories gs)
              , gsTroops = gsTroops gs ++
                 [Troop { troopId        = gsNextEntity gs
                        , troopOwner     = p
                        , troopOrigin    = from
                        , troopTarget    = to
                        , troopCyborgs   = adjAmt
                        , troopTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
                        }]
              , gsNextEntity = gsNextEntity gs + 1
              }
         | otherwise = gs
      processBomb p from to gs
         | fromMaybe 0 (M.lookup p (gsBombsLeft gs)) > 0
         = gs { gsBombs = gsBombs gs ++
                 [Bomb { bombId        = gsNextEntity gs
                       , bombOwner     = p
                       , bombOrigin    = from
                       , bombTarget    = to
                       , bombTurnsLeft = fromJust $ M.lookup (from, to) (gsLinks gs)
                       }]
              , gsBombsLeft  = M.update (Just . subtract 1) p $ gsBombsLeft gs
              , gsNextEntity = gsNextEntity gs + 1
              }
         | otherwise = gs
      processIncrease p factory gs =
         gs { gsFactories = map (\f -> if f^.entityId /= factory || f^.cyborgs < 10 then f else
                                          f & over cyborgs (subtract 10)
                                            & over production (min 3 . (+1)))
                                (gsFactories gs)
            }


produceCyborgs :: GameState -> GameState
produceCyborgs gs = gs { gsFactories = map produce (gsFactories gs) }
   where
      produce f
         | f^.turnsLeft > 0 = over turnsLeft (subtract 1) f
         | otherwise = over cyborgs (+ f^.production) f

solveBattles :: GameState -> GameState
solveBattles gs =
   gs { gsFactories = map solveFactory (gsFactories gs)
      , gsTroops = troopsInTransit
      }
   where
      (troopsArriving, troopsInTransit) = partition ((<= 0) . view turnsLeft) (gsTroops gs)
      solveFactory f
         | attacking > defending = f & set owner attackingPlayer
                                     & set cyborgs (attacking - defending)
         | otherwise             = f & set cyborgs (defending - attacking)
         where
            troopsArrivingHere = filter (\t -> t^.target == f^.entityId) troopsArriving
            (defendingHere, attackingHere) = partition (ownedBy (f^.owner)) troopsArrivingHere
            defending = sum (map (view cyborgs) defendingHere) + f^.cyborgs
            attacking = sum (map (view cyborgs) attackingHere)
            attackingPlayer = otherPlayer (f^.owner)

explodeBombs :: GameState -> GameState
explodeBombs gs =
   gs { gsFactories = foldl explodeBomb (gsFactories gs) bombsArrived
      , gsBombs     = bombsInTransit
      }
   where
      (bombsArrived, bombsInTransit) = partition (\b -> b^.turnsLeft <= 0) (gsBombs gs)
      explodeBomb fs b = flip map fs $ \f ->
         if f^.entityId /= b^.target then f else
            f & set cyborgs (max 0 (f^.cyborgs - max 10 (f^.cyborgs `div` 2)))
              & set turnsLeft 5

safeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
safeMinimumBy _   [] = Nothing
safeMinimumBy cmp xs = Just (minimumBy cmp xs)

safeMaximumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
safeMaximumBy _   [] = Nothing
safeMaximumBy cmp xs = Just (maximumBy cmp xs)

count :: (a -> Bool) -> [a] -> Int
count p = length . filter p

best :: Ord a => Int -> [(a, b)] -> [(a, b)]
best n = take n . sortBy (flip compare `on` fst)

type Getting r s a = (a -> Const r a) -> s -> Const r s
type Lens  s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s   a   = Lens s s a a

view :: Getting a s a -> s -> a
view g = getConst . g Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

set :: Lens s t a b -> b -> s -> t
set l = over l . const

(^.) :: s -> Getting a s a -> a
(^.) = flip view
infixl 8 ^.

class    HasEntityId  a       where entityId :: Lens' a EntityId
instance HasEntityId  Factory where entityId f s = (\b -> s { factoryId = b }) <$> f (factoryId s)
instance HasEntityId  Troop   where entityId f s = (\b -> s { troopId   = b }) <$> f (troopId   s)
instance HasEntityId  Bomb    where entityId f s = (\b -> s { bombId    = b }) <$> f (bombId    s)

class    HasOwner     a       where owner :: Lens' a PlayerId
instance HasOwner     Factory where owner f s = (\b -> s { factoryOwner = b }) <$> f (factoryOwner s)
instance HasOwner     Troop   where owner f s = (\b -> s { troopOwner   = b }) <$> f (troopOwner   s)
instance HasOwner     Bomb    where owner f s = (\b -> s { bombOwner    = b }) <$> f (bombOwner    s)

class    HasCyborgs   a       where cyborgs :: Lens' a Int
instance HasCyborgs   Factory where cyborgs f s = (\b -> s { factoryCyborgs = b }) <$> f (factoryCyborgs s)
instance HasCyborgs   Troop   where cyborgs f s = (\b -> s { troopCyborgs   = b }) <$> f (troopCyborgs   s)

class    HasTarget    a       where target :: Lens' a FactoryId
instance HasTarget    Troop   where target f s = (\b -> s { troopTarget = b }) <$> f (troopTarget s)
instance HasTarget    Bomb    where target f s = (\b -> s { bombTarget  = b }) <$> f (bombTarget  s)

class    HasTurnsLeft a       where turnsLeft :: Lens' a Int
instance HasTurnsLeft Factory where turnsLeft f s = (\b -> s { factoryTurnsLeft = b }) <$> f (factoryTurnsLeft s)
instance HasTurnsLeft Troop   where turnsLeft f s = (\b -> s { troopTurnsLeft   = b }) <$> f (troopTurnsLeft   s)
instance HasTurnsLeft Bomb    where turnsLeft f s = (\b -> s { bombTurnsLeft    = b }) <$> f (bombTurnsLeft    s)

production :: Lens' Factory Int
production f s = (\b -> s { factoryProduction = b }) <$> f (factoryProduction s)

flipSides :: GameState -> GameState
flipSides gs =
   gs { gsFactories = map flipOwner (gsFactories gs)
      , gsTroops    = map flipOwner (gsTroops    gs)
      , gsBombs     = map flipOwner (gsBombs     gs)
      , gsBombsLeft = M.mapKeys otherPlayer (gsBombsLeft gs)
      }
   where
      flipOwner :: HasOwner a => a -> a
      flipOwner = over owner otherPlayer

otherPlayer :: PlayerId -> PlayerId
otherPlayer = \case
   ThisPlayer -> Opponent
   Neutral    -> Neutral
   Opponent   -> ThisPlayer

ownedBy :: HasOwner a => PlayerId -> a -> Bool
ownedBy p a = a^.owner == p

parsePlayerId :: Int -> PlayerId
parsePlayerId   1  = ThisPlayer
parsePlayerId   0  = Neutral
parsePlayerId (-1) = Opponent

actionString :: Action -> String
actionString (Move src dst cnt) = unwords ["MOVE", show src, show dst, show cnt]
actionString (SendBomb src dst) = unwords ["BOMB", show src, show dst]
actionString (Increase fid)     = unwords ["INC",  show fid]
actionString  Wait              = "WAIT"