better JSON direction representation (#1359)

data/scenarios/Testing/1138-structures/flip-and-rotate.yaml

@@ -39,34 +39,34 @@ world:
     - src: tetromino
       offset: [9, -2]
       orient:
-        up: "DEast"
+        up: east
     - src: tetromino
       offset: [17, -2]
       orient:
-        up: "DSouth"
+        up: south
     - src: tetromino
       offset: [23, -2]
       orient:
-        up: "DWest"
+        up: west
     - src: tetromino
       offset: [3, -9]
       orient:
-        up: "DNorth"
+        up: north
         flip: true
     - src: tetromino
       offset: [9, -9]
       orient:
-        up: "DEast"
+        up: east
         flip: true
     - src: tetromino
       offset: [17, -9]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: tetromino
       offset: [23, -9]
       orient:
-        up: "DWest"
+        up: west
         flip: true
   map: |
     ┌──────────────────────────────┐

data/scenarios/Vignettes/roadway.yaml

@@ -93,35 +93,35 @@ world:
     - src: tunnel
       offset: [3, -21]
       orient:
-        up: "DWest"
+        up: west
     - src: tunnel
       offset: [71, -21]
       orient:
-        up: "DEast"
+        up: east
     - src: road segment
       offset: [6, -22]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: road segment
       offset: [12, -22]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: road segment
       offset: [18, -22]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: road segment
       offset: [24, -22]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: road segment
       offset: [30, -22]
       orient:
-        up: "DSouth"
+        up: south
         flip: true
     - src: intersection
       offset: [36, -22]
@@ -138,29 +138,29 @@ world:
     - src: road segment
       offset: [36, -28]
       orient:
-        up: "DEast"
+        up: east
     - src: road segment
       offset: [36, -34]
       orient:
-        up: "DEast"
+        up: east
     - src: road segment
       offset: [36, -40]
       orient:
-        up: "DEast"
+        up: east
     - src: road segment
       offset: [36, -16]
       orient:
-        up: "DWest"
+        up: west
         flip: true
     - src: road segment
       offset: [36, -10]
       orient:
-        up: "DWest"
+        up: west
         flip: true
     - src: road segment
       offset: [36, -4]
       orient:
-        up: "DWest"
+        up: west
         flip: true
   upperleft:
   - -18

src/Swarm/Language/Syntax.hs

@@ -137,12 +137,27 @@ maxStrideRange = 64
 -- Do not alter this ordering, as there exist functions that depend on it
 -- (e.g. "nearestDirection" and "relativeTo").
 data AbsoluteDir = DEast | DNorth | DWest | DSouth
-  deriving (Eq, Ord, Show, Read, Generic, Data, Hashable, ToJSON, FromJSON, Enum, Bounded)
+  deriving (Eq, Ord, Show, Read, Generic, Data, Hashable, Enum, Bounded)
+
+directionJsonModifier :: String -> String
+directionJsonModifier = map C.toLower . L.tail
+
+directionJsonOptions :: Options
+directionJsonOptions =
+  defaultOptions
+    { constructorTagModifier = directionJsonModifier
+    }
+
+instance FromJSON AbsoluteDir where
+  parseJSON = genericParseJSON directionJsonOptions
+
+instance ToJSON AbsoluteDir where
+  toJSON = genericToJSON directionJsonOptions
 
 cardinalDirectionKeyOptions :: JSONKeyOptions
 cardinalDirectionKeyOptions =
   defaultJSONKeyOptions
-    { keyModifier = map C.toLower . L.tail
+    { keyModifier = directionJsonModifier
     }
 
 instance ToJSONKey AbsoluteDir where
@@ -160,7 +175,13 @@ data RelativeDir = DPlanar PlanarRelativeDir | DDown
 -- | Caution: Do not alter this ordering, as there exist functions that depend on it
 -- (e.g. "nearestDirection" and "relativeTo").
 data PlanarRelativeDir = DForward | DLeft | DBack | DRight
-  deriving (Eq, Ord, Show, Read, Generic, Data, Hashable, ToJSON, FromJSON, Enum, Bounded)
+  deriving (Eq, Ord, Show, Read, Generic, Data, Hashable, Enum, Bounded)
+
+instance FromJSON PlanarRelativeDir where
+  parseJSON = genericParseJSON directionJsonOptions
+
+instance ToJSON PlanarRelativeDir where
+  toJSON = genericToJSON directionJsonOptions
 
 -- | The type of directions. Used /e.g./ to indicate which way a robot
 --   will turn.