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 +- walint.cabal | 3 +- 6 files changed, 86 insertions(+), 44 deletions(-) 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 ((=~)) diff --git a/walint.cabal b/walint.cabal index 5e12d01..4f03b25 100644 --- a/walint.cabal +++ b/walint.cabal @@ -55,7 +55,8 @@ library regex-tdfa, extra, witherable, - dotgen + dotgen, + text-metrics -- TODO: move more stuff into lib, these dependencies are silly executable walint -- cgit v1.2.3