{-# LANGUAGE TemplateHaskell #-}
module Swarm.Game.State.Runtime (
RuntimeState,
webPort,
upstreamRelease,
eventLog,
scenarios,
appData,
stdGameConfigInputs,
initScenarioInputs,
initRuntimeState,
initGameStateConfig,
)
where
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Effect.Throw
import Control.Lens
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Text (Text)
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.Failure (SystemFailure)
import Swarm.Game.Land
import Swarm.Game.Recipe (loadRecipes)
import Swarm.Game.ResourceLoading (initNameGenerator, readAppData)
import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..))
import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios)
import Swarm.Game.State.Substate
import Swarm.Game.World.Load (loadWorlds)
import Swarm.Log
import Swarm.Util.Lens (makeLensesNoSigs)
import Swarm.Version (NewReleaseFailure (..))
data RuntimeState = RuntimeState
{ RuntimeState -> Maybe Port
_webPort :: Maybe Port
, RuntimeState -> Either NewReleaseFailure String
_upstreamRelease :: Either NewReleaseFailure String
, RuntimeState -> Notifications LogEntry
_eventLog :: Notifications LogEntry
, RuntimeState -> ScenarioCollection
_scenarios :: ScenarioCollection
, RuntimeState -> GameStateConfig
_stdGameConfigInputs :: GameStateConfig
, RuntimeState -> Map Text Text
_appData :: Map Text Text
}
initScenarioInputs ::
( Has (Throw SystemFailure) sig m
, Has (Accum (Seq SystemFailure)) sig m
, Has (Lift IO) sig m
) =>
m ScenarioInputs
initScenarioInputs :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m ScenarioInputs
initScenarioInputs = do
TerrainEntityMaps
tem <- m TerrainEntityMaps
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m TerrainEntityMaps
loadEntitiesAndTerrain
WorldMap
worlds <- TerrainEntityMaps -> m WorldMap
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
TerrainEntityMaps -> m WorldMap
loadWorlds TerrainEntityMaps
tem
ScenarioInputs -> m ScenarioInputs
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioInputs -> m ScenarioInputs)
-> ScenarioInputs -> m ScenarioInputs
forall a b. (a -> b) -> a -> b
$ WorldMap -> TerrainEntityMaps -> ScenarioInputs
ScenarioInputs WorldMap
worlds TerrainEntityMaps
tem
initGameStateInputs ::
( Has (Throw SystemFailure) sig m
, Has (Accum (Seq SystemFailure)) sig m
, Has (Lift IO) sig m
) =>
m GameStateInputs
initGameStateInputs :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m GameStateInputs
initGameStateInputs = do
ScenarioInputs
scenarioInputs <- m ScenarioInputs
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m ScenarioInputs
initScenarioInputs
[Recipe Entity]
recipes <- EntityMap -> m [Recipe Entity]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> m [Recipe Entity]
loadRecipes (EntityMap -> m [Recipe Entity]) -> EntityMap -> m [Recipe Entity]
forall a b. (a -> b) -> a -> b
$ ScenarioInputs -> TerrainEntityMaps
initEntityTerrain ScenarioInputs
scenarioInputs TerrainEntityMaps
-> Getting EntityMap TerrainEntityMaps EntityMap -> EntityMap
forall s a. s -> Getting a s a -> a
^. Getting EntityMap TerrainEntityMaps EntityMap
Lens' TerrainEntityMaps EntityMap
entityMap
GameStateInputs -> m GameStateInputs
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GameStateInputs -> m GameStateInputs)
-> GameStateInputs -> m GameStateInputs
forall a b. (a -> b) -> a -> b
$ ScenarioInputs -> [Recipe Entity] -> GameStateInputs
GameStateInputs ScenarioInputs
scenarioInputs [Recipe Entity]
recipes
initGameStateConfig ::
( Has (Throw SystemFailure) sig m
, Has (Accum (Seq SystemFailure)) sig m
, Has (Lift IO) sig m
) =>
m GameStateConfig
initGameStateConfig :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m GameStateConfig
initGameStateConfig = do
GameStateInputs
gsi <- m GameStateInputs
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m GameStateInputs
initGameStateInputs
Map Text Text
appDataMap <- m (Map Text Text)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m (Map Text Text)
readAppData
NameGenerator
nameGen <- Map Text Text -> m NameGenerator
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw SystemFailure) sig m =>
Map Text Text -> m NameGenerator
initNameGenerator Map Text Text
appDataMap
GameStateConfig -> m GameStateConfig
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GameStateConfig -> m GameStateConfig)
-> GameStateConfig -> m GameStateConfig
forall a b. (a -> b) -> a -> b
$ Map Text Text
-> NameGenerator -> GameStateInputs -> GameStateConfig
GameStateConfig Map Text Text
appDataMap NameGenerator
nameGen GameStateInputs
gsi
initRuntimeState ::
( Has (Throw SystemFailure) sig m
, Has (Accum (Seq SystemFailure)) sig m
, Has (Lift IO) sig m
) =>
m RuntimeState
initRuntimeState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m RuntimeState
initRuntimeState = do
GameStateConfig
gsc <- m GameStateConfig
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m GameStateConfig
initGameStateConfig
ScenarioCollection
scenarios <- ScenarioInputs -> m ScenarioCollection
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> m ScenarioCollection
loadScenarios (ScenarioInputs -> m ScenarioCollection)
-> ScenarioInputs -> m ScenarioCollection
forall a b. (a -> b) -> a -> b
$ GameStateInputs -> ScenarioInputs
gsiScenarioInputs (GameStateInputs -> ScenarioInputs)
-> GameStateInputs -> ScenarioInputs
forall a b. (a -> b) -> a -> b
$ GameStateConfig -> GameStateInputs
initState GameStateConfig
gsc
RuntimeState -> m RuntimeState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeState -> m RuntimeState) -> RuntimeState -> m RuntimeState
forall a b. (a -> b) -> a -> b
$
RuntimeState
{ _webPort :: Maybe Port
_webPort = Maybe Port
forall a. Maybe a
Nothing
, _upstreamRelease :: Either NewReleaseFailure String
_upstreamRelease = NewReleaseFailure -> Either NewReleaseFailure String
forall a b. a -> Either a b
Left ([String] -> NewReleaseFailure
NoMainUpstreamRelease [])
, _eventLog :: Notifications LogEntry
_eventLog = Notifications LogEntry
forall a. Monoid a => a
mempty
, _scenarios :: ScenarioCollection
_scenarios = ScenarioCollection
scenarios
, _appData :: Map Text Text
_appData = GameStateConfig -> Map Text Text
initAppDataMap GameStateConfig
gsc
, _stdGameConfigInputs :: GameStateConfig
_stdGameConfigInputs = GameStateConfig
gsc
}
makeLensesNoSigs ''RuntimeState
webPort :: Lens' RuntimeState (Maybe Port)
upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)
eventLog :: Lens' RuntimeState (Notifications LogEntry)
scenarios :: Lens' RuntimeState ScenarioCollection
stdGameConfigInputs :: Lens' RuntimeState GameStateConfig
appData :: Lens' RuntimeState (Map Text Text)