diff --git a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs index 8c9aac09d..2139b363d 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs +++ b/src/swarm-scenario/Swarm/Game/Scenario/Topography/WorldPalette.hs @@ -6,6 +6,7 @@ module Swarm.Game.Scenario.Topography.WorldPalette where import Control.Arrow (first) import Control.Lens hiding (from, (.=), (<.>)) +import Data.Aeson.Key qualified as K import Data.Aeson.KeyMap qualified as KM import Data.Map qualified as M import Data.Maybe (catMaybes) @@ -105,9 +106,8 @@ prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskCha where preassignments :: [(Char, TerrainWith EntityFacade)] preassignments = - map (first T.head . fmap (cellToTerrainPair . standardCell)) $ - M.toList $ - KM.toMapText suggestedPalette + map (first (T.head . K.toText) . fmap (cellToTerrainPair . standardCell)) $ + M.toList suggestedPalette entityCells :: M.Map (TerrainWith EntityName) (TerrainWith EntityFacade) entityCells = getUniqueTerrainFacadePairs $ catMaybes $ allMembers cellGrid diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs index 5f472674c..15e792876 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/ProtoCell.hs @@ -9,19 +9,21 @@ module Swarm.Game.Scenario.Topography.ProtoCell ( ) where import Control.Applicative ((<|>)) -import Data.Aeson.KeyMap (KeyMap) +import Data.Aeson.Key qualified as K +import Data.Aeson.KeyMap qualified as KM +import Data.Map (Map) import Data.Yaml as Y import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointConfig) import Swarm.Util.Yaml newtype StructurePalette e = StructurePalette - {unPalette :: KeyMap (SignpostableCell e)} + {unPalette :: Map K.Key (SignpostableCell e)} deriving (Eq, Show) instance (FromJSONE e a) => FromJSONE e (StructurePalette a) where parseJSONE = withObjectE "palette" $ - fmap StructurePalette . mapM parseJSONE + fmap (StructurePalette . KM.toMap) . mapM parseJSONE -- | Supplements a cell with waypoint information data SignpostableCell c = SignpostableCell diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs index 63ffb447a..eaf010c2c 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs +++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs @@ -136,8 +136,8 @@ paintMap maskChar pal g = do let usedChars = Set.fromList $ map T.singleton $ allMembers g unusedChars = filter (`Set.notMember` usedChars) + . map Key.toText . M.keys - . KeyMap.toMapText $ unPalette pal unless (null unusedChars) $ @@ -158,6 +158,6 @@ paintMap maskChar pal g = do toCell c = if Just c == maskChar then return Nothing - else case KeyMap.lookup (Key.fromString [c]) (unPalette pal) of + else case M.lookup (Key.fromString [c]) (unPalette pal) of Nothing -> failT ["Char not in world palette:", showT c] Just cell -> return $ Just cell diff --git a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs index d562d6003..3b8467d79 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/Palette.hs +++ b/src/swarm-tui/Swarm/TUI/Editor/Palette.hs @@ -7,7 +7,9 @@ module Swarm.TUI.Editor.Palette where import Control.Lens import Control.Monad (guard) +import Data.Aeson.Key qualified as K import Data.Aeson.KeyMap qualified as KM +import Data.Bifunctor (first) import Data.List (sortOn) import Data.List.NonEmpty qualified as NE import Data.Map (Map) @@ -41,13 +43,13 @@ import Swarm.Util.Erasable makeSuggestedPalette :: TerrainMap -> - KM.KeyMap (AugmentedCell Entity) -> + Map KM.Key (AugmentedCell Entity) -> Grid (Maybe CellPaintDisplay) -> - KM.KeyMap (AugmentedCell EntityFacade) + Map KM.Key (AugmentedCell EntityFacade) makeSuggestedPalette tm originalScenarioPalette cellGrid = - KM.fromMapText - . M.map (SignpostableCell Nothing) + M.map (SignpostableCell Nothing) . M.fromList + . map (first K.fromText) . M.elems -- NOTE: the left-most maps take precedence! $ paletteCellsByKey <> pairsWithDisplays <> terrainOnlyPalette @@ -89,19 +91,19 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid = paletteCellsByKey :: Map (TerrainWith EntityName) (T.Text, CellPaintDisplay) paletteCellsByKey = - M.map (NE.head . NE.sortWith toSortVal) + M.map (first K.toText . NE.head . NE.sortWith toSortVal) . binTuples . invertPaletteMapToDedupe - $ KM.toMapText originalPalette + $ originalPalette where toSortVal (symbol, Cell _terrain _maybeEntity robots) = Down (null robots, symbol) excludedPaletteChars :: Set Char excludedPaletteChars = Set.fromList [' '] - originalPalette :: KM.KeyMap CellPaintDisplay + originalPalette :: Map KM.Key CellPaintDisplay originalPalette = - KM.map (toCellPaintDisplay . standardCell) originalScenarioPalette + M.map (toCellPaintDisplay . standardCell) originalScenarioPalette pairsWithDisplays :: Map (TerrainWith EntityName) (T.Text, CellPaintDisplay) pairsWithDisplays = M.fromList $ mapMaybe g entitiesWithModalTerrain