From dcdbec32d495fa5252f2c8a949edca547310e2f4 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 23 Dec 2021 18:57:50 +0100
Subject: add suggestions for misspelled properties
(suggestions are shown only if they have a Damerau-Levenshtein distance
<= 4, which seems to yield reasonably good results)
---
lib/CheckDir.hs | 2 +-
lib/LintWriter.hs | 4 +-
lib/Properties.hs | 114 ++++++++++++++++++++++++++++++++++-----------------
lib/TiledAbstract.hs | 5 ++-
lib/Uris.hs | 2 +-
5 files changed, 84 insertions(+), 43 deletions(-)
(limited to 'lib')
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 21e51ea..7a1629f 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -18,7 +18,7 @@ import Data.Foldable (fold)
import Data.Functor ((<&>))
import Data.Map (Map, elems, keys)
import qualified Data.Map as M
-import Data.Map.Strict (mapKeys, (\\), mapWithKey)
+import Data.Map.Strict (mapKeys, mapWithKey, (\\))
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index bc2decf..fa8207b 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -44,9 +44,9 @@ module LintWriter
import Data.Text (Text)
import Badges (Badge)
-import Control.Monad.State (StateT, modify, MonadState (put))
+import Control.Monad.State (MonadState (put), StateT, modify)
import Control.Monad.Trans.Reader (Reader, asks, runReader)
-import Control.Monad.Trans.State (runStateT, get)
+import Control.Monad.Trans.State (get, runStateT)
import Control.Monad.Writer.Lazy (lift)
import Data.Bifunctor (Bifunctor (second))
import Data.Map (Map, fromListWith)
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 6d7e03c..364a579 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -4,43 +4,72 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
-- | Contains checks for custom ties of the map json
module Properties (checkMap, checkTileset, checkLayer) where
-import Control.Monad (forM_, unless, when, forM)
-import Data.Text (Text, intercalate, isPrefixOf)
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import Tiled (Layer (..), Object (..), Property (..),
- PropertyValue (..), Tile (..), Tiledmap (..),
- Tileset (..))
-import TiledAbstract (HasName (..), HasProperties (..),
- HasTypeName (..), IsProperty (..))
-import Util (layerIsEmpty, mkProxy, naiveEscapeHTML,
- prettyprint, showText)
-
-import Badges (Badge (Badge),
- BadgeArea (BadgePoint, BadgeRect), BadgeToken,
- parseToken)
-import Data.Data (Proxy (Proxy))
-import Data.List ((\\))
-import Data.Maybe (fromMaybe, isJust)
-import Data.Set (Set)
-import qualified Data.Set as S
-import GHC.TypeLits (KnownSymbol)
-import LayerData (Collision, layerOverlaps)
-import LintConfig (LintConfig (..))
-import LintWriter (LintWriter, adjust, askContext, askFileDepth,
- complain, dependsOn, forbid, lintConfig,
- offersBadge, offersEntrypoint, suggest, warn, zoom)
-import Paths (PathResult (..), RelPath (..), getExtension,
- isOldStyle, parsePath)
-import Types (Dep (Link, Local, LocalMap, MapLink))
-import Uris (SubstError (..), applySubst, parseUri)
-
+import Control.Monad (forM, forM_, unless, when)
+import Data.Text (Text, intercalate, isPrefixOf)
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import Tiled (Layer (..), Object (..), Property (..),
+ PropertyValue (..), Tile (..),
+ Tiledmap (..), Tileset (..))
+import TiledAbstract (HasName (..), HasProperties (..),
+ HasTypeName (..), IsProperty (..))
+import Util (layerIsEmpty, mkProxy, naiveEscapeHTML,
+ prettyprint, showText)
+
+import Badges (Badge (Badge),
+ BadgeArea (BadgePoint, BadgeRect),
+ BadgeToken, parseToken)
+import Data.Data (Proxy (Proxy))
+import Data.List ((\\))
+import Data.Maybe (fromMaybe, isJust)
+import Data.Set (Set)
+import qualified Data.Set as S
+import Data.Text.Metrics (damerauLevenshtein)
+import Data.Vector (Vector)
+import GHC.TypeLits (KnownSymbol)
+import LayerData (Collision, layerOverlaps)
+import LintConfig (LintConfig (..))
+import LintWriter (LintWriter, adjust, askContext,
+ askFileDepth, complain, dependsOn, forbid,
+ lintConfig, offersBadge, offersEntrypoint,
+ suggest, warn, zoom)
+import Paths (PathResult (..), RelPath (..), getExtension,
+ isOldStyle, parsePath)
+import Types (Dep (Link, Local, LocalMap, MapLink))
+import Uris (SubstError (..), applySubst, parseUri)
+
+
+
+knownMapProperties :: Vector Text
+knownMapProperties = V.fromList
+ [ "mapName", "mapDescription", "mapCopyright", "mapLink", "script" ]
+
+knownTilesetProperties :: Vector Text
+knownTilesetProperties = V.fromList
+ [ "tilesetCopyright", "collides"]
+
+knownObjectProperties :: Vector Text
+knownObjectProperties = V.fromList
+ [ "name", "url", "getBadge", "soundRadius", "default", "persist", "openLayer"
+ , "closeLayer", "door", "bell", "openSound", "closeSound", "bellSound"
+ , "allowapi"]
+
+knownTileLayerProperites :: Vector Text
+knownTileLayerProperites = V.fromList
+ [ "jitsiRoom", "jitsiTrigger", "jitsiTriggerMessage", "jitsiWidth", "bbbRoom"
+ , "bbbTrigger", "bbbTriggerMessage", "playAudio", "audioLoop", "audioVolumne"
+ , "openWebsite", "openWebsiteTrigger", "openWebsiteTriggerMessage", "openTag"
+ , "exitUrl", "startLayer", "silent", "getBadge", "zone", "name", "doorVariable"
+ , "bindVariable", "bellVariable", "code", "openTriggerMessage"
+ , "closeTriggerMessage", "autoOpen", "autoClose", "bellButtonText", "bellPopup"
+ , "enterValue", "leaveValue" ]
-- | Checks an entire map for "general" lints.
--
@@ -119,7 +148,7 @@ checkMapProperty p@(Property name _) = case name of
-> complain $ "property " <> name
<> " should be set on layers, not the map directly"
| otherwise
- -> complain $ "unknown map property " <> prettyprint name
+ -> warnUnknown p knownMapProperties
-- | check an embedded tile set.
@@ -176,9 +205,9 @@ checkTileset = do
"collides" -> isBool p
-- named tiles are needed for scripting and do not hurt otherwise
"name" -> isString p
- _ -> warn $ "unknown tile property " <> prettyprint name
- <> " in tile with global id "
- <> showText (tileId tile)
+ _ -> warnUnknown' ("unknown tile property "
+ <> prettyprint name <> " in tile with global id "
+ <> showText (tileId tile)) p knownTilesetProperties
-- | collect lints on a single map layer
@@ -293,7 +322,7 @@ checkObjectProperty p@(Property name _) = do
| T.toLower name `elem` [ "allowapi" ]
-> forbidProperty name
| otherwise ->
- warn $ "unknown object property " <> prettyprint name <> "."
+ warnUnknown p knownObjectProperties
-- | Checks a single (custom) property of an objectgroup layer
checkObjectGroupProperty :: Property -> LintWriter Layer
@@ -452,7 +481,7 @@ checkTileLayerProperty p@(Property name _value) = case name of
, "allowapi" ]
-> forbidProperty name
| otherwise ->
- warn $ "unknown property type " <> prettyprint name
+ warnUnknown p knownTileLayerProperites
where
requireProperty req = propertyRequiredBy req name
isUnsupported = warn $ "property " <> name <> " is not (yet) supported by walint."
@@ -502,6 +531,17 @@ refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempt
base _ = pure ()
+warnUnknown' :: Text -> Property -> Vector Text -> LintWriter a
+warnUnknown' msg (Property name _) knowns =
+ if snd minDist < 4
+ then warn (msg <> ", perhaps you meant " <> prettyprint (fst minDist) <> "?")
+ else warn msg
+ where dists = V.map (\n -> (n, damerauLevenshtein name n)) knowns
+ minDist = V.minimumBy (\(_,a) (_,b) -> compare a b) dists
+
+warnUnknown :: Property -> Vector Text -> LintWriter a
+warnUnknown p@(Property name _) =
+ warnUnknown' ("unknown property " <> prettyprint name) p
---- General functions ----
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
index 948a91a..6d58f46 100644
--- a/lib/TiledAbstract.hs
+++ b/lib/TiledAbstract.hs
@@ -6,8 +6,9 @@ import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy)
import Data.Text (Text)
import qualified Data.Vector as V
-import Tiled (Layer (..), Property (..), PropertyValue (..),
- Tile (..), Tiledmap (..), Tileset (..), Object(..))
+import Tiled (Layer (..), Object (..), Property (..),
+ PropertyValue (..), Tile (..), Tiledmap (..),
+ Tileset (..))
class HasProperties a where
getProperties :: a -> [Property]
diff --git a/lib/Uris.hs b/lib/Uris.hs
index 24ddd93..40dc34a 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -18,7 +18,7 @@ import Data.Either.Combinators (maybeToRight)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text, pack)
-import qualified Data.Text as T
+import qualified Data.Text as T
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Text.Regex.TDFA ((=~))
--
cgit v1.2.3