diff options
author | stuebinm | 2021-10-28 13:28:55 +0200 |
---|---|---|
committer | stuebinm | 2021-10-30 15:44:25 +0200 |
commit | d2983b867a106ee0581d8dc1d8f413178cdd4027 (patch) | |
tree | d2368f38bf580544d8b19e7f3e9dba76630fdebe /lib/Properties.hs | |
parent | 9e3e10ae5f960d4e544a2792318c3fbf5c44d812 (diff) |
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 …
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r-- | lib/Properties.hs | 21 |
1 files changed, 7 insertions, 14 deletions
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 |