Move modules where they belong (#1096)

- Move the Location module to Game
- Move Achievements modules to Game
- Move Render and Model modules to TUI
- split off from #1069
- part of #1043

bench/Benchmark.hs

@@ -11,6 +11,7 @@ import Criterion.Main (Benchmark, bench, bgroup, defaultConfig, defaultMainWith,
 import Criterion.Types (Config (timeLimit))
 import Swarm.Game.CESK (emptyStore, initMachine)
 import Swarm.Game.Display (defaultRobotDisplay)
+import Swarm.Game.Location
 import Swarm.Game.Robot (TRobot, mkRobot)
 import Swarm.Game.State (GameState, addTRobot, classicGame0, creativeMode, world)
 import Swarm.Game.Step (gameTick)
@@ -20,7 +21,6 @@ import Swarm.Language.Context qualified as Context
 import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Syntax (north)
-import Swarm.Util.Location
 
 -- | The program of a robot that does nothing.
 idleProgram :: ProcessedTerm

src/Swarm/TUI/Model/Achievement/Attainment.hs → src/Swarm/Game/Achievement/Attainment.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Swarm.TUI.Model.Achievement.Attainment where
+module Swarm.Game.Achievement.Attainment where
 
 import Control.Lens hiding (from, (<.>))
 import Data.Aeson (
@@ -13,7 +13,7 @@ import Data.Function (on)
 import Data.Time (ZonedTime, zonedTimeToUTC)
 import Data.Yaml as Y
 import GHC.Generics (Generic)
-import Swarm.TUI.Model.Achievement.Definitions
+import Swarm.Game.Achievement.Definitions
 
 data Attainment = Attainment
   { _achievement :: CategorizedAchievement

src/Swarm/TUI/Model/Achievement/Definitions.hs → src/Swarm/Game/Achievement/Definitions.hs

@@ -1,4 +1,4 @@
-module Swarm.TUI.Model.Achievement.Definitions where
+module Swarm.Game.Achievement.Definitions where
 
 import Data.Aeson
 import Data.Text (Text)

src/Swarm/TUI/Model/Achievement/Description.hs → src/Swarm/Game/Achievement/Description.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Swarm.TUI.Model.Achievement.Description where
+module Swarm.Game.Achievement.Description where
 
-import Swarm.TUI.Model.Achievement.Definitions
+import Swarm.Game.Achievement.Definitions
 
 describe :: CategorizedAchievement -> AchievementInfo
 describe (GlobalAchievement CompletedSingleTutorial) =

src/Swarm/TUI/Model/Achievement/Persistence.hs → src/Swarm/Game/Achievement/Persistence.hs

@@ -1,14 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Swarm.TUI.Model.Achievement.Persistence where
+module Swarm.Game.Achievement.Persistence where
 
 import Control.Arrow (left)
 import Control.Carrier.Lift (sendIO)
 import Control.Monad (forM, forM_)
 import Data.Either (partitionEithers)
 import Data.Yaml qualified as Y
-import Swarm.TUI.Model.Achievement.Attainment
-import Swarm.TUI.Model.Achievement.Definitions
+import Swarm.Game.Achievement.Attainment
+import Swarm.Game.Achievement.Definitions
 import Swarm.TUI.Model.Failure
 import Swarm.Util
 import System.Directory (

src/Swarm/Game/Entity.hs

@@ -105,9 +105,9 @@ import Data.Text qualified as T
 import Data.Yaml
 import GHC.Generics (Generic)
 import Swarm.Game.Display
+import Swarm.Game.Location
 import Swarm.Language.Capability
 import Swarm.Util (binTuples, dataNotFound, getDataFileNameSafe, plural, reflow, (?))
-import Swarm.Util.Location
 import Swarm.Util.Yaml
 import Text.Read (readMaybe)
 import Witch

src/Swarm/Game/Exception.hs

@@ -26,12 +26,12 @@ import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Generics (Generic)
+import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Entity (EntityMap, deviceForCap, entityName)
 import Swarm.Language.Capability (Capability (CGod), capabilityName)
 import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Requirement (Requirements (..))
 import Swarm.Language.Syntax (Const, Term)
-import Swarm.TUI.Model.Achievement.Definitions
 import Swarm.Util
 import Witch (from)
 

src/Swarm/Game/Location.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- Orphan JSON instances for Location and Heading
+
+-- |
+-- Module      :  Swarm.Game.Location
+-- Copyright   :  Brent Yorgey
+-- Maintainer  :  byorgey@gmail.com
+--
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- Locations and headings.
+module Swarm.Game.Location (
+  Location,
+  pattern Location,
+  Heading,
+
+  -- ** utility functions
+  manhattan,
+  getElemsInArea,
+
+  -- ** reexports for convenience
+  Affine (..),
+  Point (..),
+  origin,
+) where
+
+import Data.Aeson (FromJSONKey, ToJSONKey)
+import Data.Function ((&))
+import Data.Int (Int32)
+import Data.Map (Map)
+import Data.Map qualified as M
+import Data.Yaml (FromJSON (parseJSON), ToJSON (toJSON))
+import Linear (V2 (..))
+import Linear.Affine (Affine (..), Point (..), origin)
+
+-- $setup
+-- >>> import qualified Data.Map as Map
+
+-- | A Location is a pair of (x,y) coordinates, both up to 32 bits.
+--   The positive x-axis points east and the positive y-axis points
+--   north.  These are the coordinates that are shown to players.
+--
+--   See also the 'Coords' type defined in "Swarm.Game.World", which
+--   use a (row, column) format instead, which is more convenient for
+--   internal use.  The "Swarm.Game.World" module also defines
+--   conversions between 'Location' and 'Coords'.
+type Location = Point V2 Int32
+
+-- | A convenient way to pattern-match on 'Location' values.
+pattern Location :: Int32 -> Int32 -> Location
+pattern Location x y = P (V2 x y)
+
+{-# COMPLETE Location #-}
+
+-- | A @Heading@ is a 2D vector, with 32-bit coordinates.
+--
+--   'Location' and 'Heading' are both represented using types from
+--   the @linear@ package, so they can be manipulated using a large
+--   number of operators from that package.  For example:
+--
+--   * Two headings can be added with '^+^'.
+--   * The difference between two 'Location's is a 'Heading' (via '.-.').
+--   * A 'Location' plus a 'Heading' is another 'Location' (via '.^+').
+type Heading = V2 Int32
+
+deriving instance ToJSON (V2 Int32)
+deriving instance FromJSON (V2 Int32)
+
+deriving instance FromJSONKey (V2 Int32)
+deriving instance ToJSONKey (V2 Int32)
+
+instance FromJSON Location where
+  parseJSON = fmap P . parseJSON
+
+instance ToJSON Location where
+  toJSON (P v) = toJSON v
+
+-- | Manhattan distance between world locations.
+manhattan :: Location -> Location -> Int32
+manhattan (Location x1 y1) (Location x2 y2) = abs (x1 - x2) + abs (y1 - y2)
+
+-- | Get elements that are in manhattan distance from location.
+--
+-- >>> v2s i = [(p, manhattan origin p) | x <- [-i..i], y <- [-i..i], let p = Location x y]
+-- >>> v2s 0
+-- [(P (V2 0 0),0)]
+-- >>> map (\i -> length (getElemsInArea origin i (Map.fromList $ v2s i))) [0..8]
+-- [1,5,13,25,41,61,85,113,145]
+--
+-- The last test is the sequence "Centered square numbers":
+-- https://oeis.org/A001844
+getElemsInArea :: Location -> Int32 -> Map Location e -> [e]
+getElemsInArea o@(Location x y) d m = M.elems sm'
+ where
+  -- to be more efficient we basically split on first coordinate
+  -- (which is logarithmic) and then we have to linearly filter
+  -- the second coordinate to get a square - this is how it looks:
+  --         ▲▲▲▲
+  --         ││││    the arrows mark points that are greater then A
+  --         ││s│                                 and lesser then B
+  --         │sssB (2,1)
+  --         ssoss   <-- o=(x=0,y=0) with d=2
+  -- (-2,-1) Asss│
+  --          │s││   the point o and all s are in manhattan
+  --          ││││                  distance 2 from point o
+  --          ▼▼▼▼
+  sm =
+    m
+      & M.split (Location (x - d) (y - 1)) -- A
+      & snd -- A<
+      & M.split (Location (x + d) (y + 1)) -- B
+      & fst -- B>
+  sm' = M.filterWithKey (const . (<= d) . manhattan o) sm

src/Swarm/Game/Log.hs

@@ -36,7 +36,7 @@ import Control.Lens hiding (contains)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Swarm.Util.Location (Location)
+import Swarm.Game.Location (Location)
 
 -- | Severity of the error - critical errors are bugs
 --   and should be reported as Issues.

src/Swarm/Game/Robot.hs

@@ -93,6 +93,7 @@ import Linear
 import Swarm.Game.CESK
 import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
 import Swarm.Game.Entity hiding (empty)
+import Swarm.Game.Location
 import Swarm.Game.Log
 import Swarm.Language.Capability (Capability)
 import Swarm.Language.Context qualified as Ctx
@@ -101,7 +102,6 @@ import Swarm.Language.Syntax (toDirection)
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Types (TCtx)
 import Swarm.Language.Value as V
-import Swarm.Util.Location
 import Swarm.Util.Yaml
 import System.Clock (TimeSpec)
 

src/Swarm/Game/Scenario/Objective.hs

@@ -10,9 +10,9 @@ import Data.Aeson
 import Data.Set qualified as Set
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Scenario.Objective.Logic as L
 import Swarm.Language.Pipeline (ProcessedTerm)
-import Swarm.TUI.Model.Achievement.Definitions
 import Swarm.Util (reflow)
 
 ------------------------------------------------------------
@@ -129,6 +129,11 @@ data CompletionBuckets = CompletionBuckets
   }
   deriving (Show, Generic, FromJSON, ToJSON)
 
+-- | TODO: #1044 Could also add an "ObjectiveFailed" constructor...
+newtype Announcement
+  = ObjectiveCompleted Objective
+  deriving (Show, Generic, ToJSON)
+
 data ObjectiveCompletion = ObjectiveCompletion
   { completionBuckets :: CompletionBuckets
   -- ^ This is the authoritative "completion status"

src/Swarm/Game/Scenario/WorldDescription.hs

@@ -10,9 +10,9 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Yaml as Y
 import Swarm.Game.Entity
+import Swarm.Game.Location
 import Swarm.Game.Scenario.Cell
 import Swarm.Game.Scenario.RobotLookup
-import Swarm.Util.Location
 import Swarm.Util.Yaml
 import Witch (into)
 

src/Swarm/Game/State.hs

@@ -143,8 +143,11 @@ import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TL
 import Data.Time (getZonedTime)
 import GHC.Generics (Generic)
+import Swarm.Game.Achievement.Attainment
+import Swarm.Game.Achievement.Definitions
 import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
 import Swarm.Game.Entity
+import Swarm.Game.Location
 import Swarm.Game.Recipe (
   Recipe,
   inRecipeMap,
@@ -154,7 +157,6 @@ import Swarm.Game.Recipe (
  )
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Objective
-import Swarm.Game.Scenario.Objective.Presentation.Model
 import Swarm.Game.ScenarioInfo
 import Swarm.Game.Terrain (TerrainType (..))
 import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
@@ -168,10 +170,7 @@ import Swarm.Language.Syntax (Const, SrcLoc (..), Syntax' (..), allConst)
 import Swarm.Language.Typed (Typed (Typed))
 import Swarm.Language.Types
 import Swarm.Language.Value (Value)
-import Swarm.TUI.Model.Achievement.Attainment
-import Swarm.TUI.Model.Achievement.Definitions
-import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
-import Swarm.Util.Location
+import Swarm.Util (getDataFileNameSafe, isRightOr, uniq, (<+=), (<<.=), (?))
 import System.Clock qualified as Clock
 import System.Random (StdGen, mkStdGen, randomRIO)
 

src/Swarm/Game/Step.hs

@@ -50,11 +50,14 @@ import Data.Text qualified as T
 import Data.Time (getZonedTime)
 import Data.Tuple (swap)
 import Linear (zero)
+import Swarm.Game.Achievement.Attainment
+import Swarm.Game.Achievement.Definitions
 import Swarm.Game.CESK
 import Swarm.Game.Display
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Entity qualified as E
 import Swarm.Game.Exception
+import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Objective qualified as OB
@@ -70,10 +73,7 @@ import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
 import Swarm.Language.Typed (Typed (..))
 import Swarm.Language.Value
-import Swarm.TUI.Model.Achievement.Attainment
-import Swarm.TUI.Model.Achievement.Definitions
 import Swarm.Util
-import Swarm.Util.Location
 import System.Clock (TimeSpec)
 import System.Clock qualified
 import System.Random (UniformRange, uniformR)

src/Swarm/Game/World.hs

@@ -60,8 +60,8 @@ import Data.Int (Int32)
 import Data.Map.Strict qualified as M
 import Data.Yaml (FromJSON, ToJSON)
 import GHC.Generics (Generic)
+import Swarm.Game.Location
 import Swarm.Util
-import Swarm.Util.Location
 import Prelude hiding (lookup)
 
 ------------------------------------------------------------

src/Swarm/Language/Syntax.hs

@@ -107,9 +107,9 @@ import Data.Text hiding (filter, map)
 import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Linear
+import Swarm.Game.Location (Heading)
 import Swarm.Language.Types
 import Swarm.Util qualified as Util
-import Swarm.Util.Location (Heading)
 import Witch.From (from)
 
 ------------------------------------------------------------

src/Swarm/TUI/Controller.hs

@@ -67,11 +67,12 @@ import Data.Time (getZonedTime)
 import Data.Vector qualified as V
 import Graphics.Vty qualified as V
 import Linear
+import Swarm.Game.Achievement.Definitions
+import Swarm.Game.Achievement.Persistence
 import Swarm.Game.CESK (cancel, emptyStore, initMachine)
 import Swarm.Game.Entity hiding (empty)
+import Swarm.Game.Location
 import Swarm.Game.Robot
-import Swarm.Game.Scenario.Objective.Presentation.Model
-import Swarm.Game.Scenario.Objective.Presentation.Render qualified as GR
 import Swarm.Game.ScenarioInfo
 import Swarm.Game.State
 import Swarm.Game.Step (gameTick)
@@ -92,15 +93,14 @@ import Swarm.TUI.Controller.Util
 import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
 import Swarm.TUI.List
 import Swarm.TUI.Model
-import Swarm.TUI.Model.Achievement.Definitions
-import Swarm.TUI.Model.Achievement.Persistence
+import Swarm.TUI.Model.Goal
 import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.StateUpdate
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View (generateModal)
+import Swarm.TUI.View.Objective qualified as GR
 import Swarm.Util hiding ((<<.=))
-import Swarm.Util.Location
 import Swarm.Version (NewReleaseFailure (..))
 import System.Clock
 import System.FilePath (splitDirectories)