From d2983b867a106ee0581d8dc1d8f413178cdd4027 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 28 Oct 2021 13:28:55 +0200
Subject: make aeson instances agree with themselves

This cleans up all the old rubble that came from the Tiled package I
originally took from hackage. It now uses generics instead of
implementing all the ToJSON and FromJSON instances by hand, and
(deserialize . serialise) will now actually return a (semantically)
equivalent json.

It'll now also reject keys that it doesn't know, which required adding
some in several places which the tiled package didn't know about (or
which were introduced after it was originally written, dunno).

Several more Maybes are required now, to represent the difference
between e.g. empty lists and on set value, which does make the code
slightly weirder in other places …
---
 lib/Properties.hs | 21 +++++++--------------
 1 file changed, 7 insertions(+), 14 deletions(-)

(limited to 'lib/Properties.hs')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index ed97355..1b0569d 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -8,10 +8,12 @@ module Properties (checkLayerProperty, checkMap, checkTileset) where
 
 import           Control.Monad (unless, when)
 import           Data.Text     (Text, isPrefixOf)
-import           Tiled2        (Layer (..), Property (..), PropertyValue (..),
+import           Tiled2        (HasProperties (getProperties), Layer (..),
+                                Property (..), PropertyValue (..),
                                 Tiledmap (..), Tileset (..))
 import           Util          (layerIsEmpty, prettyprint)
 
+import           Data.Maybe    (fromMaybe)
 import           LintWriter    (LintWriter, askContext, askFileDepth, complain,
                                 dependsOn, forbid, offersEntrypoint, suggest,
                                 warn)
@@ -29,14 +31,14 @@ checkMap = do
   tiledmap <- askContext
 
   -- test other things
-  mapM_ checkMapProperty (tiledmapProperties tiledmap)
+  mapM_ checkMapProperty (fromMaybe [] $ tiledmapProperties tiledmap)
 
   -- some layers should exist
   hasLayerNamed "start" (const True)
     "The map must have one layer named \"start\""
   hasLayerNamed "floorLayer" ((==) "objectgroup" . layerType)
     "The map must have one layer named \"floorLayer\" of type \"objectgroup\""
-  hasLayer (flip containsProperty "exitUrl" . layerProperties)
+  hasLayer (flip containsProperty "exitUrl" . getProperties)
     "The map must contain at least one layer with the property \"exitUrl\" set"
 
   -- reject maps not suitable for workadventure
@@ -82,7 +84,7 @@ checkTileset tileset = do
 
   -- TODO: check copyright!
   requireProperty "copyright"
-  mapM_ checkTilesetProperty (tilesetProperties tileset)
+  mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset)
 
 checkTilesetProperty :: Property -> LintWriter Tileset
 checkTilesetProperty p@(Property name value) = case name of
@@ -182,15 +184,6 @@ checkLayerProperty p@(Property name _value) = case name of
 
 --------- Helper functions & stuff ---------
 
-class HasProperties a where
-  getProperties :: a -> [Property]
-
-instance HasProperties Layer where
-  getProperties = layerProperties
-
-instance HasProperties Tileset where
-  getProperties = tilesetProperties
-
 unlessHasProperty :: HasProperties a => Text -> LintWriter a -> LintWriter a
 unlessHasProperty name andthen = do
   layer <- askContext
@@ -229,7 +222,7 @@ suggestProperty (Property name value) =
 
 
 -- | does this layer have the given property?
-containsProperty :: [Property] -> Text -> Bool
+containsProperty :: Foldable t => t Property -> Text -> Bool
 containsProperty props name = any
   (\(Property name' _) -> name' == name) props
 
-- 
cgit v1.2.3