lots of code reorganising and some deduplication

it was kinda getting messy in places.

Also found some accidental isomorphisms between types, so these are now
only one type because the consequences were getting silly.

8 files changed, 288 insertions, 230 deletions

diff --git a/lib/Badges.hs b/lib/Badges.hs
index 0369334..b78f08d 100644
--- a/lib/Badges.hs
+++ b/lib/Badges.hs
@@ -22,10 +22,10 @@ data BadgeArea =
    , areaY :: Double
    }
  | BadgeRect
-   { areaX      :: Double
-   , areaY      :: Double
-   , areaWidth  :: Double
-   , areaHeight :: Double
+   { areaX         :: Double
+   , areaY         :: Double
+   , areaWidth     :: Double
+   , areaHeight    :: Double
    , areaIsEllipse :: Bool
    }
   deriving (Ord, Eq, Generic, Show)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 359452c..779123d 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -14,7 +14,6 @@ import           Data.Aeson.Types ((.=))
 import           Data.Functor     ((<&>))
 import           Data.Map         (Map, toList)
 import qualified Data.Map         as M
-import           Data.Maybe       (mapMaybe)
 import           Data.Text        (Text)
 import qualified Data.Text        as T
 import qualified Data.Vector      as V
@@ -23,16 +22,16 @@ import           GHC.Generics     (Generic)
 
 import           Badges           (Badge)
 import           LintConfig       (LintConfig')
-import           LintWriter       (LintResult (..), invertLintResult, lintToDep,
+import           LintWriter       (LintResult, invertLintResult,
                                    resultToAdjusted, resultToBadges,
                                    resultToDeps, resultToLints, resultToOffers,
                                    runLintWriter)
 import           Properties       (checkLayer, checkMap, checkTileset)
-import           Tiled2           (HasName (getName),
-                                   Layer (layerLayers, layerName),
+import           Tiled            (Layer (layerLayers, layerName),
                                    LoadResult (..),
                                    Tiledmap (tiledmapLayers, tiledmapTilesets),
                                    Tileset, loadTiledmap)
+import           TiledAbstract    (HasName (..))
 import           Types            (Dep, Hint (Hint, hintLevel, hintMsg),
                                    Level (..), lintsToHints)
 import           Util             (PrettyPrint (prettyprint), prettyprint)
@@ -94,7 +93,7 @@ runLinter config tiledmap depth = MapResult
   { mapresultLayer = invertThing layer
   , mapresultTileset = invertThing tileset
   , mapresultGeneral = lintsToHints $ resultToLints generalResult
-  , mapresultDepends = mapMaybe lintToDep (resultToLints generalResult)
+  , mapresultDepends = resultToDeps generalResult
     <> concatMap resultToDeps layer
     <> concatMap resultToDeps tileset
   , mapresultProvides = concatMap resultToOffers layer
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index e235fca..12c4311 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -7,11 +7,39 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TupleSections     #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
 
 -- | a monad that collects warnings, outputs, etc,
-module LintWriter where
+module LintWriter
+  ( runLintWriter
+  , LintWriter
+  , LintWriter'
+  , LintResult
+  , invertLintResult
+  -- * working with lint results
+  , resultToDeps
+  , resultToOffers
+  , resultToBadges
+  , resultToLints
+  , resultToAdjusted
+  -- * Add lints to a linter
+  , info
+  , suggest
+  , warn
+  , forbid
+  , complain
+  -- * add other information to the linter
+  , offersEntrypoint
+  , offersBadge
+  , dependsOn
+  -- * get information about the linter's context
+  , askContext
+  , askFileDepth
+  , lintConfig
+  -- * adjust the linter's context
+  , adjust
+  ) where
 
-import           Data.Aeson                 (ToJSON (toJSON))
 import           Data.Text                  (Text)
 
 import           Control.Monad.State        (StateT, modify)
@@ -21,123 +49,123 @@ import           Control.Monad.Writer.Lazy  (lift)
 import           Data.Bifunctor             (Bifunctor (second))
 import           Data.Map                   (Map, fromListWith)
 import           Data.Maybe                 (mapMaybe)
-import qualified Data.Text                  as T
-import           Util                       (PrettyPrint (..))
-
 import           Badges                     (Badge)
 import           LintConfig                 (LintConfig')
-import           Tiled2                     (HasName)
-import           Types
-
--- | for now, all context we have is how "deep" in the directory tree
--- we currently are
-type Context = Int
-
-newtype LinterState ctxt = LinterState
-  { fromLinterState :: ([Lint], ctxt)}
+import           TiledAbstract              (HasName)
+import           Types                      (Dep, Hint, Level (..), Lint (..),
+                                             hint, lintsToHints)
 
 
--- | a monad to collect hints, with some context (usually the containing layer/etc.)
+-- | A monad modelling the main linter features
 type LintWriter ctxt = LintWriter' ctxt ()
+-- | A linter that can use pure / return things monadically
 type LintWriter' ctxt res =
   StateT (LinterState ctxt) (Reader (Context, ctxt, LintConfig')) res
 
--- wrapped to allow for manual writing of Aeson instances
-type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint])
-newtype LintResult ctxt = LintResult (LintResult' ctxt)
+-- | A Linter's state: some context (which it may adjust), and a list of lints
+-- | it already collected.
+newtype LinterState ctxt = LinterState
+  { fromLinterState :: ([Lint], ctxt)}
+
+-- | The result of running a linter: an adjusted context, and a list of lints.
+-- | This is actually just a type synonym of LinterState, but kept seperately
+-- | for largely historic reasons since I don't think I'll change it again
+type LintResult ctxt = LinterState ctxt
 
+-- | for now, all context we have is how "deep" in the directory tree
+-- we currently are
+type Context = Int
 
+-- | run a linter. Returns the adjusted context, and a list of lints
+runLintWriter
+  :: LintConfig' -> ctxt -> Context -> LintWriter ctxt -> LintResult ctxt
+runLintWriter config context depth linter = LinterState
+  . fromLinterState
+  . snd
+  . runReader runstate
+  $ (depth, context, config)
+  where runstate = runStateT linter (LinterState ([], context))
+
+-- | "invert" a linter's result, grouping lints by their messages
 invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [ctxt]
-invertLintResult (LintResult (ctxt, lints)) =
+invertLintResult (LinterState (lints, ctxt)) =
   fromListWith (<>) $ (, [ctxt]) <$> lintsToHints lints
 
--- better, less confusing serialisation of an Either Hint (a, [Hint]).
--- Note that Left hint is also serialised as a list to make the resulting
--- json schema more regular.
-instance ToJSON (LintResult a) where
-  toJSON (LintResult res) = toJSON $ snd res
-
-instance PrettyPrint ctxt => PrettyPrint (Level, LintResult ctxt) where
-  prettyprint (level, LintResult (ctxt, res)) =
-    T.concat $ map ((<> context) . prettyprint) (filterLintLevel level res)
-    where context = " (" <> prettyprint ctxt <> ")\n"
-
-lintToDep :: Lint -> Maybe Dep
-lintToDep = \case
-  Depends dep -> Just dep
-  _           -> Nothing
-
-lintToOffer :: Lint -> Maybe Text
-lintToOffer = \case
-  Offers frag -> Just frag
-  _           -> Nothing
-
-filterLintLevel :: Level -> [Lint] -> [Lint]
-filterLintLevel level = mapMaybe $ \l -> if level <= lintLevel l
-  then Just l
-  else Nothing
-
 resultToDeps :: LintResult a -> [Dep]
-resultToDeps (LintResult a) = mapMaybe lintToDep $ snd a
+resultToDeps (LinterState (lints,_)) = mapMaybe lintToDep lints
+  where lintToDep = \case
+          Depends dep -> Just dep
+          _           -> Nothing
 
 resultToOffers :: LintResult a -> [Text]
-resultToOffers (LintResult a) = mapMaybe lintToOffer $ snd a
-
--- | convert a lint result into a flat list of lints
--- (throwing away information on if a single error was fatal)
-resultToLints :: LintResult a -> [Lint]
-resultToLints (LintResult res) = snd res
+resultToOffers (LinterState a) = mapMaybe lintToOffer $ fst a
+ where lintToOffer = \case
+         Offers frag -> Just frag
+         _           -> Nothing
 
 resultToBadges :: LintResult a -> [Badge]
-resultToBadges (LintResult a) = mapMaybe lintToBadge $ snd a
+resultToBadges (LinterState a) = mapMaybe lintToBadge $ fst a
   where lintToBadge (Badge badge) = Just badge
         lintToBadge _             = Nothing
 
+-- | convert a lint result into a flat list of lints
+resultToLints :: LintResult a -> [Lint]
+resultToLints (LinterState res) = fst res
+
+-- | extract the adjusted context from a lint result
 resultToAdjusted :: LintResult a -> a
-resultToAdjusted (LintResult res) = fst res
+resultToAdjusted (LinterState res) = snd res
 
--- | run a linter. Returns the adjusted context, and a list of lints
-runLintWriter :: LintConfig' -> ctxt -> Context -> LintWriter ctxt -> LintResult ctxt
-runLintWriter config c c' linter =  LintResult (snd $ fromLinterState lints,fst $ fromLinterState lints)
-  where lints = snd $ runReader ranstate (c',c, config)
-        ranstate = runStateT linter (LinterState ([], c))
 
-tell' :: Lint -> LintWriter ctxt
-tell' l = modify $ \(LinterState (lints, ctxt)) -> LinterState (l:lints, ctxt)
 
 
--- | write a hint into the LintWriter monad
-lint :: Level -> Text -> LintWriter a
-lint level text = tell' $ hint  level text
+-- | fundamental linter operations: add a lint of some severity
+info = lint Info
+suggest = lint Suggestion
+warn = lint Warning
+forbid = lint Forbidden
+complain = lint Error
 
+-- | add a dependency to the linter
 dependsOn :: Dep -> LintWriter a
 dependsOn dep = tell' $ Depends dep
 
+-- | add an offer for an entrypoint to the linter
 offersEntrypoint :: Text -> LintWriter a
 offersEntrypoint text = tell' $ Offers text
 
+-- | add an offer for a badge to the linter
 offersBadge :: Badge -> LintWriter a
 offersBadge badge = tell' $ Badge badge
 
--- | adjusts the context. Gets a copy of the /current/ context, i.e. one which might
--- have already been changed by other lints
-adjust :: (a -> a) -> LintWriter a
-adjust f = modify $ LinterState . second f . fromLinterState
 
 
-info = lint Info
-suggest = lint Suggestion
-warn = lint Warning
-forbid = lint Forbidden
-complain = lint Error
-
-
--- | get the context as it was originally, without any modifications
+-- | get the context as it was initially, without any modifications
 askContext :: LintWriter' a a
 askContext = lift $ asks (\(_,a,_) -> a)
 
+-- | ask for the file depth within the repository tree of the current map.
+-- | This function brings in a lot more conceptual baggage than I'd like, but
+-- | it's needed to check if relative paths lie outside the repository
 askFileDepth :: LintWriter' a Int
 askFileDepth = lift $ asks (\(a,_,_) -> a)
 
+-- | ask for a specific part of the linter's global config
 lintConfig :: (LintConfig' -> a) -> LintWriter' ctxt a
 lintConfig get = lift $ asks (\(_,_,config) -> get config)
+
+
+
+
+-- | tell, but for a singular lint. Leaves the context unchanged
+tell' :: Lint -> LintWriter ctxt
+tell' l = modify $ \(LinterState (lints, ctxt)) -> LinterState (l:lints, ctxt)
+
+-- | small helper to tell a singlular proper lint
+lint :: Level -> Text -> LintWriter a
+lint level text = tell' $ hint level text
+
+-- | adjusts the context. Gets a copy of the /current/ context,
+-- | i.e. one which might have already been changed by other adjustments
+adjust :: (a -> a) -> LintWriter a
+adjust f = modify $ LinterState . second f . fromLinterState
diff --git a/lib/Properties.hs b/lib/Properties.hs
index d65c9da..a9bf113 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -13,11 +13,10 @@ module Properties (checkMap, checkTileset, checkLayer) where
 import           Control.Monad (forM_, unless, when)
 import           Data.Text     (Text, isPrefixOf)
 import qualified Data.Vector   as V
-import           Tiled2        (HasName (getName),
-                                HasProperties (adjustProperties, getProperties),
-                                HasTypeName (typeName), IsProperty (asProperty),
-                                Layer (..), Object (..), Property (..),
+import           Tiled         (Layer (..), Object (..), Property (..),
                                 PropertyValue (..), Tiledmap (..), Tileset (..))
+import           TiledAbstract (HasName (..), HasProperties (..),
+                                HasTypeName (..), IsProperty (..))
 import           Util          (layerIsEmpty, mkProxy, naiveEscapeHTML,
                                 prettyprint, showText)
 
@@ -39,67 +38,59 @@ import           Uris          (SubstError (..), applySubst)
 
 -- | Checks an entire map for "general" lints.
 --
--- Note that it does /not/ call checkMapProperty; this is handled
--- seperately in CheckMap.hs, since these lints go into a different
--- field of the resulting json.
+-- Note that it does /not/ check any tile layer/tileset properties;
+-- these are handled seperately in CheckMap, since these lints go
+-- into a different field of the output.
 checkMap :: LintWriter Tiledmap
 checkMap = do
   tiledmap <- askContext
+  let unlessLayer = unlessElement (tiledmapLayers tiledmap)
 
-  -- test other things
-  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" . getProperties)
-    "The map must contain at least one layer with the property \"exitUrl\" set."
+  -- test custom map properties
+  mapM_ checkMapProperty (fromMaybe mempty $ tiledmapProperties tiledmap)
 
+  -- can't have these with the rest of layer/tileset lints since they're
+  -- not specific to any one of them
   refuseDoubledNames (tiledmapLayers tiledmap)
   refuseDoubledNames (tiledmapTilesets tiledmap)
 
+  -- some layers should exist
+  unlessElementNamed (tiledmapLayers tiledmap) "start"
+    $ complain "The map must have one layer named \"start\"."
+  unlessLayer (\l -> getName l == "floorLayer" && layerType l == "objectgroup")
+    $ complain "The map must have one layer named \"floorLayer\" of type \"objectgroup\"."
+  unlessLayer (flip containsProperty "exitUrl" . getProperties)
+    $ complain "The map must contain at least one layer with the property \"exitUrl\" set."
+
   -- reject maps not suitable for workadventure
   unless (tiledmapOrientation tiledmap == "orthogonal")
     $ complain "The map's orientation must be set to \"orthogonal\"."
   unless (tiledmapTileheight tiledmap == 32 && tiledmapTilewidth tiledmap == 32)
     $ complain "The map's tile size must be 32 by 32 pixels."
-  where
-    hasLayerNamed name p = hasLayer (\l -> layerName l == name && p l)
-    hasLayer p err = do
-      tiledmap <- askContext
-      unless (any p (tiledmapLayers tiledmap))
-        $ complain err
-
 
 -- | Checks a single property of a map.
 --
 -- Doesn't really do all that much, but could in theory be expanded into a
 -- longer function same as checkLayerProperty.
 checkMapProperty :: Property -> LintWriter Tiledmap
-checkMapProperty p@(Property name _value) = case name of
+checkMapProperty p@(Property name _) = case name of
   "script" -> do
     -- this is kind of stupid, since if we also inject script this
     -- will be overriden anyways, but it also doesn't really hurt I guess
     -- TODO: perhaps include an explanation in the lint, or allow
     -- exactly that one value?
     lintConfig configAllowScripts >>= \case
-      False -> isForbidden
+      False -> forbid "cannot use property \"script\"; custom scripts are disallowed"
       True  -> pure ()
     lintConfig configScriptInject >>= \case
       Nothing  -> pure ()
       Just url -> setProperty "script" url
   "mapName" -> naiveEscapeProperty p
-  "mapLink" -> pure ()
-  "mapImage" -> pure ()
   "mapDescription" -> naiveEscapeProperty p
   "mapCopyright" -> naiveEscapeProperty p
-
+  "mapLink" -> pure ()
+  "mapImage" -> pure ()
   _        -> complain $ "unknown map property " <> prettyprint name
-  where
-    -- | this property is forbidden and should not be used
-    isForbidden = forbid $ "property " <> prettyprint name <> " should not be used"
 
 
 -- | check an embedded tile set.
@@ -126,24 +117,25 @@ checkTileset = do
   unlessHasProperty "copyright"
     $ forbid "property \"copyright\" is required for tilesets."
 
-
+  -- check individual tileset properties
   mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset)
-
-checkTilesetProperty :: Property -> LintWriter Tileset
-checkTilesetProperty p@(Property name _value) = case name of
-  "copyright" -> naiveEscapeProperty p
-  _           -> pure () -- are there any other properties?
+  where
+    checkTilesetProperty :: Property -> LintWriter Tileset
+    checkTilesetProperty p@(Property name _value) = case name of
+      "copyright" -> naiveEscapeProperty p
+      _           -> warn $ "unknown tileset property " <> prettyprint name
 
 
 -- | collect lints on a single map layer
 checkLayer :: LintWriter Layer
 checkLayer = do
   layer <- askContext
-  when (isJust (layerImage layer))
-    $ complain "imagelayer are not supported."
 
   refuseDoubledNames (getProperties  layer)
 
+  when (isJust (layerImage layer))
+    $ complain "imagelayer are not supported."
+
   case layerType layer of
     "tilelayer" -> mapM_ checkTileLayerProperty (getProperties layer)
     "group" -> pure ()
@@ -154,18 +146,24 @@ checkLayer = do
       adjust $ \l -> l { layerObjects = Nothing, layerProperties = Nothing }
 
       unless (layerName layer == "floorLayer") $ do
+
+        -- TODO: these two checks can probably be unified
         unlessHasProperty "getBadge"
-          $ warn "objectgrouop layer (which aren't the floor layer) are useless if not used to define badges."
-        when (null (layerObjects layer) || layerObjects layer == Just (V.fromList []))
-          $ warn "empty objectgroup layers (which aren't the floor layer) are useless."
+          $ warn "objectgrouop layer (which aren't the floor layer)\
+                 \are useless if not used to define badges."
+
+        when (null (layerObjects layer) || layerObjects layer == Just mempty)
+          $ warn "empty objectgroup layers (which aren't the floor\
+                 \layer) are useless."
 
       -- individual objects can't have properties
-      forM_ (fromMaybe (V.fromList []) $ layerObjects layer) $ \object ->
+      forM_ (fromMaybe mempty (layerObjects layer)) $ \object ->
         unless (null (objectProperties object))
-          $ warn "Properties cannot be set on individual objects. For setting badge tokens, use per-layer properties instead."
-      mapM_ checkObjectGroupProperty (getProperties layer)
-    ty -> --unless (layerName layer == "floorLayer" && ty == "objectgroup")
-          complain $ "unsupported layer type " <> prettyprint ty <> "."
+          $ warn "Properties cannot be set on individual objects. For setting\
+                 \badge tokens, use per-layer properties instead."
+
+      forM_ (getProperties layer) checkObjectGroupProperty
+    ty -> complain $ "unsupported layer type " <> prettyprint ty <> "."
 
   if layerType layer == "group"
     then when (null (layerLayers layer))
@@ -177,7 +175,7 @@ checkLayer = do
 -- | Checks a single (custom) property of an objectgroup layer
 checkObjectGroupProperty :: Property -> LintWriter Layer
 checkObjectGroupProperty p@(Property name _) = case name of
-  "getBadge" ->  -- TODO check if all objects of this layer are allowed, then collect them
+  "getBadge" ->
     unwrapString p $ \str ->
       unwrapBadgeToken str $ \token -> do
         layer <- askContext
@@ -195,10 +193,8 @@ checkObjectGroupProperty p@(Property name _) = case name of
             ObjectPolyline {} -> complain "cannot use polylines for badges."
   _ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers"
 
+
 -- | Checks a single (custom) property of a "normal" tile layer
---
--- It gets a reference to its own layer since sometimes the presence
--- of one property implies the presence or absense of another.
 checkTileLayerProperty :: Property -> LintWriter Layer
 checkTileLayerProperty p@(Property name _value) = case name of
     "jitsiRoom" -> do
@@ -216,7 +212,8 @@ checkTileLayerProperty p@(Property name _value) = case name of
     "jitsiTrigger" -> do
       isString p
       unlessHasProperty "jitsiTriggerMessage"
-       $ suggest "set \"jitsiTriggerMessage\" to a custom message to overwrite the default \"press SPACE to enter in jitsi meet room\"."
+       $ suggest "set \"jitsiTriggerMessage\" to a custom message to overwrite\
+                 \the default \"press SPACE to enter in jitsi meet room\"."
       requireProperty "jitsiRoom"
     "jitsiTriggerMessage" -> do
       isString p
@@ -245,9 +242,10 @@ checkTileLayerProperty p@(Property name _value) = case name of
       unwrapString p
         (setProperty "openWebsiteTrigger")
       unlessHasProperty "bbbTriggerMessage" $ do
-       suggest "set \"bbbTriggerMessage\" to a custom message to overwrite the default \"press SPACE to enter the bbb room\""
        setProperty "openWebsiteTriggerMessage"
          ("press SPACE to enter bbb room" :: Text)
+       suggest "set \"bbbTriggerMessage\" to a custom message to overwrite the\
+               \default \"press SPACE to enter the bbb room\""
     "bbbTriggerMessage" -> do
       removeProperty "bbbTriggerMessage"
       requireProperty "bbbRoom"
@@ -274,9 +272,10 @@ checkTileLayerProperty p@(Property name _value) = case name of
         (dependsOn . Local)
     "openWebsiteTrigger" -> do
       isString p
-      unlessHasProperty "openWebsiteTriggerMessage"
-        $ suggest "set \"openWebsiteTriggerMessage\" to a custom message to overwrite the default \"press SPACE to open Website\"."
       requireProperty "openWebsite"
+      unlessHasProperty "openWebsiteTriggerMessage"
+        $ suggest "set \"openWebsiteTriggerMessage\" to a custom message to\
+                  \overwrite the default \"press SPACE to open Website\"."
     "openWebsiteTriggerMessage" -> do
       isString p
       requireProperty "openWebsiteTrigger"
@@ -320,12 +319,13 @@ checkTileLayerProperty p@(Property name _value) = case name of
       deprecatedUseInstead instead =
         warn $ "property \"" <> name <> "\" is deprecated. Use \"" <> instead <> "\" instead."
 
-
-      -- | this property can only be used on a layer that contains at least one tiles
+      -- | this property can only be used on a layer that contains
+      -- | at least one tile
       forbidEmptyLayer = do
         layer <- askContext
         when (layerIsEmpty layer)
           $ complain ("property " <> prettyprint name <> " should not be set on an empty layer.")
+
       -- | this layer is allowed, but also useless on a layer that contains no tiles
       uselessEmptyLayer = do
         layer <- askContext
@@ -349,24 +349,45 @@ refuseDoubledNames things = foldr folding base things mempty
       where name = getName thing
     base _ = pure ()
 
---------- Helper functions & stuff ---------
+
+---- General functions ----
+
+unlessElement
+  :: Foldable f
+  => f a
+  -> (a -> Bool)
+  -> LintWriter b
+  -> LintWriter b
+unlessElement things op = unless (any op things)
+
+unlessElementNamed :: (HasName a, Foldable f)
+  => f a -> Text -> LintWriter b -> LintWriter b
+unlessElementNamed things name =
+  unlessElement things ((==) name . getName)
 
 unlessHasProperty :: HasProperties a => Text -> LintWriter a -> LintWriter a
-unlessHasProperty name andthen = do
-  layer <- askContext
-  let hasprop = any (\(Property name' _) -> name == name') (getProperties layer)
-  unless hasprop andthen
+unlessHasProperty name linter =
+  askContext >>= \ctxt ->
+    unlessElementNamed (getProperties ctxt) name linter
+
+-- | does this layer have the given property?
+containsProperty :: Foldable t => t Property -> Text -> Bool
+containsProperty props name = any
+  (\(Property name' _) -> name' == name) props
+
 
+----- Functions with concrete lint messages -----
 
 -- | this property is forbidden and should not be used
 forbidProperty :: Text -> LintWriter Layer
 forbidProperty name = do
-  forbid $ "property " <> prettyprint name <> " should not be used."
+  forbid $ "property " <> prettyprint name <> " is disallowed."
 
 propertyRequiredBy :: HasProperties a => Text -> Text -> LintWriter a
 propertyRequiredBy req by =
   unlessHasProperty req
-  $ complain $ "property "<>prettyprint req<>" is required by property "<> prettyprint by<>"."
+  $ complain $ "property " <> prettyprint req <>
+               " is required by property " <> prettyprint by <> "."
 
 -- | suggest some value for another property if that property does not
 -- also already exist
@@ -375,6 +396,11 @@ suggestProperty (Property name value) =
   unlessHasProperty name
   $ suggest $ "set property " <> prettyprint name <> " to " <> prettyprint value<>"."
 
+
+
+---- Functions for adjusting the context -----
+
+
 -- | set a property, overwriting whatever value it had previously
 setProperty :: (IsProperty prop, HasProperties ctxt)
   => Text -> prop -> LintWriter ctxt
@@ -388,37 +414,41 @@ removeProperty name = adjust $ \ctxt ->
   flip adjustProperties ctxt
   $ \ps -> Just $ filter (\(Property name' _) -> name' /= name) ps
 
+naiveEscapeProperty :: HasProperties a =>  Property -> LintWriter a
+naiveEscapeProperty prop@(Property name _) =
+  unwrapString prop (setProperty name . naiveEscapeHTML)
 
--- | does this layer have the given property?
-containsProperty :: Foldable t => t Property -> Text -> Bool
-containsProperty props name = any
-  (\(Property name' _) -> name' == name) props
-
+---- "unwrappers" checking that a property has some type, then do something ----
 
 -- | asserts that this property is a string, and unwraps it
 unwrapString :: Property -> (Text -> LintWriter a) -> LintWriter a
 unwrapString (Property name value) f = case value of
   StrProp str -> f str
-  _ -> complain $ "type error: property " <> prettyprint name <> " should be of type string."
+  _ -> complain $ "type error: property "
+               <> prettyprint name <> " should be of type string."
 
 -- | same as unwrapString, but also forbids http:// as prefix
 unwrapLink :: Property -> (Text -> LintWriter a) -> LintWriter a
 unwrapLink (Property name value) f = case value of
   StrProp str -> if "http://" `isPrefixOf` str
-    then complain "cannot access content via http; either use https or include it locally instead."
+    then complain "cannot access content via http; either use https or include\
+                  \it locally in your repository instead."
     else f str
-  _ -> complain $ "type error: property " <> prettyprint name <> " should be of type string and contain a valid uri."
+  _ -> complain $ "type error: property " <> prettyprint name <> " should be\
+                  \of type string and contain a valid uri."
 
 -- | asserts that this property is a boolean, and unwraps it
 unwrapBool :: Property -> (Bool -> LintWriter a) -> LintWriter a
 unwrapBool (Property name value) f = case value of
   BoolProp b -> f b
-  _ -> complain $ "type error: property " <> prettyprint name <> " should be of type bool."
+  _ -> complain $ "type error: property " <> prettyprint name
+               <> " should be of type bool."
 
 unwrapInt :: Property -> (Int -> LintWriter a) -> LintWriter a
 unwrapInt (Property name value) f = case value of
   IntProp float -> f float
-  _ -> complain $ "type error: property " <> prettyprint name <> " should be of type int."
+  _ -> complain $ "type error: property " <> prettyprint name
+               <> " should be of type int."
 
 unwrapPath :: Text -> (RelPath -> LintWriter a) -> LintWriter a
 unwrapPath str f = case parsePath str of
@@ -437,20 +467,6 @@ unwrapBadgeToken str f = case parseToken str of
   Just a  -> f a
   Nothing -> complain "invalid badge token."
 
--- | just asserts that this is a string
-isString :: Property -> LintWriter a
-isString = flip unwrapString (const $ pure ())
-
--- | just asserts that this is a boolean
-isBool :: Property -> LintWriter a
-isBool = flip unwrapBool (const $ pure ())
-
-isIntInRange :: Int -> Int -> Property -> LintWriter a
-isIntInRange l r p@(Property name _) = unwrapInt p $ \int ->
-  if l < int && int < r then pure ()
-  else complain $ "Property " <> prettyprint name <> " should be between" <> showText l <> " and " <> showText r<>"."
-
-
 unwrapURI :: (KnownSymbol s, HasProperties a)
   => Proxy s -> Property -> (Text -> LintWriter a) -> (RelPath -> LintWriter a) -> LintWriter a
 unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do
@@ -468,6 +484,15 @@ unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do
       WrongScope schema ->
         "the URI schema " <> schema <> ":// cannot be used on \""<>name<>"\"."
 
-naiveEscapeProperty :: HasProperties a =>  Property -> LintWriter a
-naiveEscapeProperty prop@(Property name _) =
-  unwrapString prop (setProperty name . naiveEscapeHTML)
+-- | just asserts that this is a string
+isString :: Property -> LintWriter a
+isString = flip unwrapString (const $ pure ())
+
+-- | just asserts that this is a boolean
+isBool :: Property -> LintWriter a
+isBool = flip unwrapBool (const $ pure ())
+
+isIntInRange :: Int -> Int -> Property -> LintWriter a
+isIntInRange l r p@(Property name _) = unwrapInt p $ \int ->
+  if l < int && int < r then pure ()
+  else complain $ "Property " <> prettyprint name <> " should be between" <> showText l <> " and " <> showText r<>"."
diff --git a/lib/Tiled2.hs b/lib/Tiled.hs
index 44f2db7..9df52d3 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled.hs
@@ -13,7 +13,7 @@
 -- cover some of the types and records that are available in the format. For
 -- those you should read the TMX documentation at
 -- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
-module Tiled2 where
+module Tiled where
 
 import           Control.Exception      (try)
 import           Control.Exception.Base (SomeException)
@@ -24,8 +24,6 @@ import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Lazy   as LB
 import           Data.Char              (toLower)
 import           Data.Map               (Map)
-import           Data.Maybe             (fromMaybe)
-import           Data.Proxy             (Proxy)
 import           Data.String            (IsString (fromString))
 import           Data.Text              (Text)
 import qualified Data.Text              as T
@@ -377,53 +375,6 @@ instance FromJSON Tiledmap where
 instance ToJSON Tiledmap where
   toJSON = genericToJSON (aesonOptions 8)
 
-
-class HasProperties a where
-  getProperties :: a -> [Property]
-  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
-
-instance HasProperties Layer where
-  getProperties = fromMaybe [] . layerProperties
-  adjustProperties f layer = layer
-    { layerProperties = f (getProperties layer) }
-
-instance HasProperties Tileset where
-  getProperties = fromMaybe [] . tilesetProperties
-  adjustProperties f tileset = tileset
-    { tilesetProperties = f (getProperties tileset) }
-
-instance HasProperties Tiledmap where
-  getProperties = fromMaybe [] . tiledmapProperties
-  adjustProperties f tiledmap = tiledmap
-    { tiledmapProperties = f (getProperties tiledmap) }
-
-class HasTypeName a where
-  typeName :: Proxy a -> Text
-instance HasTypeName Layer where
-  typeName _ = "layer"
-instance HasTypeName Tileset where
-  typeName _ = "tileset"
-instance HasTypeName Property where
-  typeName _ = "property"
-
-class HasName a where
-  getName :: a -> Text
-instance HasName Layer where
-  getName = layerName
-instance HasName Tileset where
-  getName = tilesetName
-instance HasName Property where
-  getName (Property n _) = n
-
-class IsProperty a where
-  asProperty :: a -> PropertyValue
-instance IsProperty PropertyValue where
-  asProperty = id
-  {-# INLINE asProperty #-}
-instance IsProperty Text where
-  asProperty = StrProp
-  {-# INLINE asProperty #-}
-
 data LoadResult = Loaded Tiledmap | IOErr String | DecodeErr String
 
 -- | Load a Tiled map from the given 'FilePath'.
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
new file mode 100644
index 0000000..f7bbbb9
--- /dev/null
+++ b/lib/TiledAbstract.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TiledAbstract where
+
+import           Data.Maybe (fromMaybe)
+import           Data.Proxy (Proxy)
+import           Data.Text  (Text)
+import           Tiled      (Layer (..), Property (..), PropertyValue (..),
+                             Tiledmap (..), Tileset (..))
+
+class HasProperties a where
+  getProperties :: a -> [Property]
+  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
+
+instance HasProperties Layer where
+  getProperties = fromMaybe mempty . layerProperties
+  adjustProperties f layer = layer
+    { layerProperties = f (getProperties layer) }
+
+instance HasProperties Tileset where
+  getProperties = fromMaybe mempty . tilesetProperties
+  adjustProperties f tileset = tileset
+    { tilesetProperties = f (getProperties tileset) }
+
+instance HasProperties Tiledmap where
+  getProperties = fromMaybe mempty . tiledmapProperties
+  adjustProperties f tiledmap = tiledmap
+    { tiledmapProperties = f (getProperties tiledmap) }
+
+class HasTypeName a where
+  typeName :: Proxy a -> Text
+instance HasTypeName Layer where
+  typeName _ = "layer"
+instance HasTypeName Tileset where
+  typeName _ = "tileset"
+instance HasTypeName Property where
+  typeName _ = "property"
+
+class HasName a where
+  getName :: a -> Text
+instance HasName Layer where
+  getName = layerName
+instance HasName Tileset where
+  getName = tilesetName
+instance HasName Property where
+  getName (Property n _) = n
+
+class IsProperty a where
+  asProperty :: a -> PropertyValue
+instance IsProperty PropertyValue where
+  asProperty = id
+  {-# INLINE asProperty #-}
+instance IsProperty Text where
+  asProperty = StrProp
+  {-# INLINE asProperty #-}
diff --git a/lib/Util.hs b/lib/Util.hs
index c082bfe..e676e7e 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -10,7 +10,7 @@ import           Data.Aeson as Aeson
 import           Data.Proxy (Proxy (..))
 import           Data.Text  (Text)
 import qualified Data.Text  as T
-import           Tiled2     (Layer (layerData), PropertyValue (..),
+import           Tiled      (Layer (layerData), PropertyValue (..),
                              Tileset (tilesetName), layerName, mkTiledId)
 
 -- | helper function to create proxies
diff --git a/walint.cabal b/walint.cabal
index 89096e4..e39e9e3 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -31,7 +31,8 @@ library
         CheckDir
         LintWriter
         Properties
-        Tiled2
+        Tiled
+        TiledAbstract
         Util
         Types
         Paths
@@ -63,7 +64,6 @@ executable walint
                       aeson-pretty,
                       bytestring,
                       mtl,
---                      bytestring-encoding,
                       text
     hs-source-dirs:   src
     default-language: Haskell2010