{-#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