diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index d71d037199a5e29fb0f66c25154f60c6e2e23125..8d91948683261835562649cecbd2bd6eff87baf7 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -6,34 +6,37 @@
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TupleSections     #-}
 
 -- | a monad that collects warnings, outputs, etc,
-{-# LANGUAGE TupleSections     #-}
 module LintWriter where
 
-import           Control.Monad.Trans.Maybe  ()
-import           Control.Monad.Writer       (MonadWriter (tell), WriterT,
-                                             runWriterT)
 import           Data.Aeson                 (ToJSON (toJSON))
 import           Data.Text                  (Text)
 
+import           Control.Monad.State        (StateT, modify)
 import           Control.Monad.Trans.Reader (Reader, asks, runReader)
+import           Control.Monad.Trans.State  (runStateT)
 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           Tiled2                     (HasName (getName))
-import           Types
 import           Util                       (PrettyPrint (..))
 
+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)}
+
+
 -- | a monad to collect hints, with some context (usually the containing layer/etc.)
 type LintWriter ctxt = LintWriter' ctxt ()
-type LintWriter' ctxt res = WriterT [Lint] (Reader (Context, ctxt)) res
+type LintWriter' ctxt res = StateT (LinterState ctxt) (Reader (Context, ctxt)) res
 
 -- wrapped to allow for manual writing of Aeson instances
 type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint])
@@ -42,7 +45,7 @@ newtype LintResult ctxt = LintResult (LintResult' ctxt)
 
 invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [ctxt]
 invertLintResult (LintResult (ctxt, lints)) =
-  fromListWith (<>) $ fmap (, [ctxt]) $ lintsToHints lints
+  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
@@ -83,19 +86,26 @@ resultToLints (LintResult res) = snd res
 
 -- | run a linter
 runLintWriter :: ctxt -> Context -> LintWriter ctxt -> LintResult ctxt
-runLintWriter c c' linter =  LintResult (c, lints)
-  where lints = snd $ flip runReader (c',c) $ runWriterT linter
+runLintWriter c c' linter =  LintResult (c, fst $ fromLinterState lints)
+  where lints = snd $ runReader ranstate (c',c)
+        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 = tell . (: []) . hint level
+lint level text = tell' $ hint  level text
 
 dependsOn :: Dep -> LintWriter a
-dependsOn dep = tell . (: []) $ Depends dep
+dependsOn dep = tell' $ Depends dep
 
 offersEntrypoint :: Text -> LintWriter a
-offersEntrypoint = tell . (: []) . Offers
+offersEntrypoint text = tell' $ Offers text
 
+adjust :: (a -> a) -> LintWriter a
+adjust f = modify $ LinterState . second f . fromLinterState
 
 
 info = lint Info
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 65782c8cef94d0e105e072e23f369ea997acdbc4..403df8e4765988c969dd87842f286fd0bd031a9a 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -88,7 +88,7 @@ checkTileset = do
   mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset)
 
 checkTilesetProperty :: Property -> LintWriter Tileset
-checkTilesetProperty p@(Property name value) = case name of
+checkTilesetProperty (Property name _value) = case name of
   "copyright" -> pure () -- only allow some licenses?
   _           -> pure () -- are there any other properties?