From 652c2030c5ef39bf1dd34d26064e1059431898f0 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 9 Nov 2021 20:24:17 +0100
Subject: first example of a map adjustment

this also includes some more monad plumbing, and an option for the
linter to actually write things out again. Some of the previous commit
was reverted a bit since it turned out to be stupid, but overall it was
suprisingly easy once I got around to it, so yay! i guess

Also includes a fairly silly example of how to use it.
---
 lib/Properties.hs | 31 +++++++++++++++++++++----------
 1 file changed, 21 insertions(+), 10 deletions(-)

(limited to 'lib/Properties.hs')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index 403df8e..97c5189 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -3,20 +3,20 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Contains checks for custom properties of the map json
-module Properties (checkLayerProperty, checkMap, checkTileset) where
+module Properties (checkMap, checkTileset, checkLayer) where
 
 
 import           Control.Monad (unless, when)
 import           Data.Text     (Text, isPrefixOf)
-import           Tiled2        (HasProperties (getProperties), Layer (..),
-                                Property (..), PropertyValue (..),
+import           Tiled2        (HasProperties (adjustProperties, 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)
+import           LintWriter    (LintWriter, adjust, askContext, askFileDepth,
+                                complain, dependsOn, forbid, offersEntrypoint,
+                                suggest, warn)
 import           Paths         (RelPath (..), parsePath)
 import           Types         (Dep (Link, Local, LocalMap, MapLink))
 
@@ -92,6 +92,16 @@ checkTilesetProperty (Property name _value) = case name of
   "copyright" -> pure () -- only allow some licenses?
   _           -> pure () -- are there any other properties?
 
+
+-- | collect lints on a single map layer
+checkLayer :: LintWriter Layer
+checkLayer = do
+  layer <- askContext
+  mapM_ checkLayerProperty (getProperties layer)
+  setProperty "jitsiRoomAdminTag" "Hello, World"
+
+
+
 -- | Checks a single (custom) property of a layer
 --
 -- It gets a reference to its own layer since sometimes the presence
@@ -210,7 +220,6 @@ propertyRequiredBy req by =
   unlessHasProperty req
   $ complain $ "property "<>prettyprint req<>" is required by property "<> prettyprint by
 
-
 -- | suggest some value for another property if that property does not
 -- also already exist
 suggestProperty :: Property -> LintWriter Layer
@@ -218,9 +227,11 @@ suggestProperty (Property name value) =
   unlessHasProperty name
   $ suggest $ "set property " <> prettyprint name <> " to " <> prettyprint value
 
-
-
-
+-- | set a property, overwriting whatever value it had previously
+setProperty :: HasProperties ctxt => Text -> PropertyValue -> LintWriter ctxt
+setProperty name value = adjust $ \ctxt ->
+  adjustProperties (\props -> Just $ Property name value : filter sameName props) ctxt
+  where sameName (Property name' _) = name /= name'
 
 -- | does this layer have the given property?
 containsProperty :: Foldable t => t Property -> Text -> Bool
-- 
cgit v1.2.3