Agent.hs

{-#LANGUAGE NoMonadFailDesugaring #-} -- FIXME
{-#LANGUAGE TypeApplications, TemplateHaskell, NamedFieldPuns, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables#-}
{-#LANGUAGE GADTs, RankNTypes, GeneralisedNewtypeDeriving, PatternSynonyms, DataKinds, ConstraintKinds, FlexibleContexts, TypeOperators,OverloadedLabels, PartialTypeSignatures #-}
module Network.SC2.Agent where

import Control.Monad.Freer
import Control.Effects.Logging
import Data.OpenUnion ((:++:))
import Control.Monad.Freer.Reader
import Data.Traversable
import Control.Lens
import Data.Functor.Identity
import Network.SC2.LowLevel.Requests as LLR
import Control.Monad.Freer.State
import Data.Word
import Network.SC2.Constants.Entities
import qualified Network.SC2.Constants.Abilities as A
import qualified Network.SC2.Constants.Units as U
import qualified Proto.S2clientprotocol.Sc2api as S
import qualified Proto.S2clientprotocol.Raw as S
import Network.SC2.LowLevel.Types 
import Control.Monad.Freer.TH
import Lens.Labels (HasLens')
import Network.SC2.LowLevel.Protocol  as LLP (SC2Control, syncRequest, Split, unsafeRequest, unsafeResponse, getStatus)
import Data.ProtoLens (defMessage)
import qualified Data.Text as T
import Network.SC2.LowLevel.Convert
import Data.Maybe
import Data.Coerce

data AgentUnitKnowledge = UnitKnowledge { -- TODO Use an entity component system, or at least...
    --TODO Turn this into a map from PlayerID -> UnitContainer or some other associative structure
    --TODO or just a damn Reader and use local
    ownUnits :: UnitContainer
    , enemyUnits :: UnitContainer
    , alliedUnits :: UnitContainer
    , neutralUnits :: UnitContainer
    , allUnits :: UnitContainer
} deriving (Eq, Show)
defUnitKnowledge :: AgentUnitKnowledge
defUnitKnowledge = UnitKnowledge{ownUnits = [], enemyUnits = [], alliedUnits = [], neutralUnits =[], allUnits = []}
type UnitFilter = Unit -> Bool

instance Eq UnitKnowledgeFilter where
    (==) a b= True
instance Show UnitKnowledgeFilter where
    show a = ""
data WorldState = WorldState {
    gameInfo :: GameInfoResponse,
    knownUnits :: AgentUnitKnowledge
} deriving (Eq, Show)


type UnitKnowledgeFilter = (AgentUnitKnowledge -> UnitContainer)
data Agent a where
    UpdateObservations :: Agent ()
    ViewPlayerResources :: Agent PlayerResources
    ViewMapInfo :: Agent MapInfo
    ViewUnits ::  Agent AgentUnitKnowledge
    OrderUnits :: forall a. Orderable a=> a -> Order -> Agent ()
    SendChat :: T.Text -> ChatChannel -> Agent ()
    ViewWorldState :: Agent WorldState
    Step :: Agent ()
    StepN :: Word -> Agent ()
    GetStatus :: Agent S.Status

    
$(makeEffect ''Agent)
type SC2Agent r = Member Agent r 
type SC2AgentEffects = Agent
type SC2AgentSupportEffects = '[Split, Logging]
runSC2Agent :: (Members (SC2AgentSupportEffects) r) =>  WorldState -> Eff (Agent ': r) ~> Eff ( SC2Control ': r)
runSC2Agent initialState = evalState initialState . reinterpret2 act where
    act :: (Members (SC2AgentSupportEffects) r) => Agent  ~> Eff (State WorldState ': SC2Control ': r)
    act (Network.SC2.Agent.Step) = do --ugh
        result <- syncRequest (LLR.Step) --ugh
        case result of 
            Right () -> return ()
            Left e -> logError ("runSC2Agent Step: " ++ show e)
    act (StepN i) = do
        result <- syncRequest (StepMany i)
        case result of
            Right () -> return ()
            Left e -> logError ("runSC2Agent StepN: " ++ show e)
    act GetStatus = LLP.getStatus
        
    act UpdateObservations = do
        Right obs <- syncRequest $ ((defMessage & #observation .~ defMessage) :: S.Request) -- FIXME
        currState <- get @WorldState
        put $ processObservations currState (obs ^. #observation . #observation)
    
    act ViewUnits= do
        state <- get
        return (knownUnits state)
    act ViewWorldState = get
    act (OrderUnits units order) = do -- TODO: This is terribly hacky. Make Action a Requestable!
        let aruc = (defMessage:: S.ActionRawUnitCommand) & #abilityId .~ (A.toInt $ abilityID order) & setTarget (target order)  & #unitTags .~ (toTags units)
        let ar = (defMessage :: S.ActionRaw) & #unitCommand .~ aruc
        let a = (defMessage :: S.RequestAction) & #actions .~ [(defMessage :: S.Action) & #actionRaw .~ ar]
        _ <- syncRequest ((defMessage & #action .~ a)      :: S.Request)
        return ()
        where
            setTarget (TargetPoint p) m = m & #targetWorldSpacePos .~ convertTo p
            setTarget (TargetUnit u) m = m & #targetUnitTag .~ coerce u





enemyStartLocations :: Eff (Agent ': r) [Point]
enemyStartLocations = do
    state <- viewWorldState
    return $ (startLocations . fromJust . startRaw . gameInfo) state
processObservations ::  WorldState -> S.Observation -> WorldState
processObservations state obs = state {knownUnits = knownUnits'} where
    knownUnits' = UnitKnowledge {ownUnits, enemyUnits, alliedUnits, neutralUnits, allUnits}
    allUnits = fmap (fromJust . convertFrom) (obs ^. #rawData . #units)
    ownUnits = filter (\u -> alliance u == S.Self) allUnits
    enemyUnits = filter (\u -> alliance u == S.Enemy) allUnits
    alliedUnits = filter (\u -> alliance u == S.Ally) allUnits
    neutralUnits = filter (\u -> alliance u == S.Neutral) allUnits



--TODO: Turn this into a lens (is it a zoom?) over arbitrary UnitContainer

selectFromAllUnits :: SC2Agent r=>  UnitFilter -> Eff r UnitContainer
selectFromAllUnits f= do
    unitsKnown <- viewUnits
    return (filter f (allUnits unitsKnown))
    

units :: SC2Agent r=> Eff  r UnitContainer
units = do
    all <- viewUnits
    return (ownUnits all)



workers :: SC2Agent r =>  Eff r UnitContainer
workers = do
    un <- units
    return (filter isWorker un)
    


isWorker' :: UnitType -> Bool
isWorker' u = u == U.Probe || u == U.SCV || u == U.Drone
isWorker :: Unit -> Bool
isWorker u = isWorker' (unitType u)

viewUnitsOfPlayer :: SC2Agent r => PlayerID -> Eff (r) UnitContainer
viewUnitsOfPlayer player = selectFromAllUnits (\u -> owner u == player)


initialiseWithGameInfo :: GameInfoResponse -> WorldState
initialiseWithGameInfo gi = WorldState {gameInfo = gi, knownUnits = defUnitKnowledge}


attack :: (Member Agent r, Orderable a, Targetable b) => a -> b -> Eff r ()
attack units target = do
    send $ OrderUnits units order
    where
        order = Order A.Attack (asTarget target) False