{-# LANGUAGE DataKinds #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Evaluation for the Swarm world description DSL.
module Swarm.Game.World.Eval (
  runWorld,
) where

import Swarm.Game.Entity (Entity)
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.World (WorldFun (..))
import Swarm.Game.World.Abstract (bracket)
import Swarm.Game.World.Coords (Coords)
import Swarm.Game.World.Gen (Seed)
import Swarm.Game.World.Interpret (interpBTerm)
import Swarm.Game.World.Syntax
import Swarm.Game.World.Typecheck

-- | Run a typechecked world description DSL term to produce a
--   'WorldFun'.
runWorld :: TTerm '[] (World CellVal) -> Seed -> WorldFun TerrainType Entity
runWorld :: TTerm '[] (World CellVal) -> Seed -> WorldFun TerrainType Entity
runWorld TTerm '[] (World CellVal)
t Seed
seed = World CellVal -> WorldFun TerrainType Entity
convertWF (World CellVal -> WorldFun TerrainType Entity)
-> (TTerm '[] (World CellVal) -> World CellVal)
-> TTerm '[] (World CellVal)
-> WorldFun TerrainType Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> BTerm (World CellVal) -> World CellVal
forall a. Seed -> BTerm a -> a
interpBTerm Seed
seed (BTerm (World CellVal) -> World CellVal)
-> (TTerm '[] (World CellVal) -> BTerm (World CellVal))
-> TTerm '[] (World CellVal)
-> World CellVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TTerm '[] (World CellVal) -> BTerm (World CellVal)
forall a. TTerm '[] a -> BTerm a
bracket (TTerm '[] (World CellVal) -> WorldFun TerrainType Entity)
-> TTerm '[] (World CellVal) -> WorldFun TerrainType Entity
forall a b. (a -> b) -> a -> b
$ TTerm '[] (World CellVal)
t

-- Currently we run a DSL term by performing bracket abstraction,
-- producing a 'BTerm', then directly interpreting the 'BTerm' with
-- 'interpBTerm'.  We could also compile the 'BTerm' to a 'CTerm' and
-- run it, i.e.
--
--   convertWF . runCTerm . compile seed . bracket $ t
--
-- which can supposedly give a performance boost, but it is unclear
-- whether this actually makes a difference in our case.

-- | Simple adapter function to convert a plain @Coords -> CellVal@
--   function into a 'WorldFun' value.
convertWF :: (Coords -> CellVal) -> WorldFun TerrainType Entity
convertWF :: World CellVal -> WorldFun TerrainType Entity
convertWF World CellVal
f = (Coords -> (TerrainType, Erasable (Last Entity)))
-> WorldFun TerrainType Entity
forall t e. (Coords -> (t, Erasable (Last e))) -> WorldFun t e
WF ((\(CellVal TerrainType
t Erasable (Last Entity)
e [TRobot]
_) -> (TerrainType
t, Erasable (Last Entity)
e)) (CellVal -> (TerrainType, Erasable (Last Entity)))
-> World CellVal -> Coords -> (TerrainType, Erasable (Last Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. World CellVal
f)