switch to universum prelude

also don't keep adjusted maps around if not necessary

24 files changed, 287 insertions, 303 deletions

diff --git a/.hlint.yaml b/.hlint.yaml
index 0415941..202635a 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -136,9 +136,6 @@
 - warn: {lhs: "m ?: mempty", rhs: maybeToMonoid m}
 
 
-- hint: {lhs: pure (), rhs: pass}
-- hint: {lhs: return (), rhs: pass}
-
 # Probably will be reduced when function equality is done:
 # https://github.com/ndmitchell/hlint/issues/434
 - warn: {lhs: (case m of Just x -> f x; Nothing -> pure ()  ), rhs: Universum.whenJust m f}
diff --git a/lib/Badges.hs b/lib/Badges.hs
index c1a17b3..d6afc43 100644
--- a/lib/Badges.hs
+++ b/lib/Badges.hs
@@ -8,14 +8,13 @@
 -- | module defining Badge types and utility functions
 module Badges where
 
-import           Control.DeepSeq (NFData)
+import           Universum
+
 import           Data.Aeson      (Options (fieldLabelModifier, sumEncoding),
                                   SumEncoding (UntaggedValue), ToJSON (toJSON),
                                   defaultOptions, genericToJSON, (.=))
 import qualified Data.Aeson      as A
 import           Data.Char       (toLower)
-import           Data.Text       (Text)
-import           GHC.Generics    (Generic)
 import           Text.Regex.TDFA ((=~))
 
 
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 1aeb5e3..a19a412 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -1,29 +1,35 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections     #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE BangPatterns         #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveAnyClass       #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TupleSections        #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | Module that contains high-level checking for an entire directory
-module CheckDir (maximumLintLevel, recursiveCheckDir, DirResult(..), MissingAsset(..), MissingDep(..), resultIsFatal)  where
-
-import           CheckMap               (MapResult (..), loadAndLintMap)
-import           Control.DeepSeq        (NFData)
-import           Control.Monad          (void)
+module CheckDir ( maximumLintLevel
+                , recursiveCheckDir
+                , DirResult (..)
+                , MissingAsset(..)
+                , MissingDep(..)
+                , resultIsFatal
+                ,shrinkDirResult)  where
+
+import           Universum              hiding (Set)
+
+import           CheckMap               (MapResult (..), Optional,
+                                         ResultKind (..), loadAndLintMap,
+                                         shrinkMapResult)
 import           Control.Monad.Extra    (mapMaybeM)
 import           Data.Aeson             (ToJSON, (.=))
 import qualified Data.Aeson             as A
-import           Data.Bifunctor         (first)
-import           Data.Foldable          (fold)
-import           Data.Functor           ((<&>))
-import           Data.List              (partition)
-import           Data.Map               (Map, elems, keys)
 import qualified Data.Map               as M
 import           Data.Map.Strict        (mapKeys, mapWithKey, (\\))
-import           Data.Maybe             (isJust, mapMaybe)
-import           Data.Text              (Text, isInfixOf)
+import           Data.Text              (isInfixOf)
 import qualified Data.Text              as T
 import           Dirgraph               (graphToDot, invertGraph, resultToGraph,
                                          takeSubGraph, unreachableFrom)
@@ -34,7 +40,8 @@ import           System.Directory.Extra (doesFileExist)
 import           System.FilePath        (splitPath, (</>))
 import qualified System.FilePath        as FP
 import           System.FilePath.Posix  (takeDirectory)
-import           Text.Dot               (Dot, showDot)
+import           Text.Dot               (showDot)
+import           Tiled                  (Tiledmap)
 import           Types                  (Dep (Local, LocalMap), Hint (Hint),
                                          Level (..), hintLevel)
 import           Util                   (PrettyPrint (prettyprint), ellipsis)
@@ -49,15 +56,18 @@ listFromSet :: Set a -> [a]
 listFromSet = map fst . M.toList
 
 -- | Result of linting an entire directory / repository
-data DirResult = DirResult
-  { dirresultMaps          :: Map FilePath MapResult
+data DirResult (complete :: ResultKind) = DirResult
+  { dirresultMaps          :: Map FilePath (MapResult complete)
   -- ^ all maps of this respository, by (local) filepath
   , dirresultDeps          :: [MissingDep]
   -- ^ all dependencies to things outside this repository
   , dirresultMissingAssets :: [MissingAsset]
   -- ^ entrypoints of maps which are referred to but missing
   , dirresultGraph         :: Text
-  } deriving (Generic, NFData)
+  } deriving (Generic)
+
+instance NFData (Optional a (Maybe Tiledmap)) => NFData (DirResult a)
+
 
 data MissingDep = MissingDep
   { depFatal   :: Maybe Bool
@@ -71,8 +81,14 @@ data MissingDep = MissingDep
 newtype MissingAsset = MissingAsset MissingDep
   deriving (Generic, NFData)
 
+
+-- | "shrink" the result by throwing the adjusted tiledmaps away
+shrinkDirResult :: DirResult Full -> DirResult Shrunk
+shrinkDirResult !res =
+  res { dirresultMaps = fmap shrinkMapResult (dirresultMaps res) }
+
 -- | given this config, should the result be considered to have failed?
-resultIsFatal :: LintConfig' -> DirResult -> Bool
+resultIsFatal :: LintConfig' -> DirResult Full -> Bool
 resultIsFatal config res =
   not (null (dirresultMissingAssets res) || not (any (isJust . depFatal) (dirresultDeps res)))
   || maximumLintLevel res > configMaxLintLevel config
@@ -80,11 +96,11 @@ resultIsFatal config res =
 -- | maximum lint level that was observed anywhere in any map.
 -- note that it really does go through all lints, so don't
 -- call it too often
-maximumLintLevel :: DirResult -> Level
+maximumLintLevel :: DirResult a -> Level
 maximumLintLevel res
   | not (null (dirresultMissingAssets res)) = Fatal
   | otherwise =
-    (\t -> if null t then Info else maximum t)
+    (maybe Info maximum . nonEmpty)
     . map hintLevel
     . concatMap (\map -> keys (mapresultLayer map)
                   <> keys (mapresultTileset map)
@@ -96,7 +112,7 @@ maximumLintLevel res
 
 
 
-instance ToJSON DirResult where
+instance ToJSON (DirResult a) where
   toJSON res = A.object [
     "result" .=  A.object
       [ "missingDeps" .= dirresultDeps res
@@ -127,7 +143,7 @@ instance ToJSON MissingAsset where
     ]
 
 
-instance PrettyPrint (Level, DirResult) where
+instance PrettyPrint (Level, DirResult a) where
   prettyprint (level, res) = prettyMapLints <> prettyMissingDeps
     where
       prettyMissingDeps = if not (null (dirresultDeps res))
@@ -135,9 +151,9 @@ instance PrettyPrint (Level, DirResult) where
         else ""
       prettyMapLints = T.concat
         (map prettyLint $ M.toList $ dirresultMaps res)
-      prettyLint :: (FilePath, MapResult) -> Text
+      prettyLint :: (FilePath, MapResult a) -> Text
       prettyLint (p, lint) =
-        "\nin " <> T.pack p <> ":\n" <> prettyprint (level, lint)
+        "\nin " <> toText p <> ":\n" <> prettyprint (level, lint)
 
 instance PrettyPrint MissingDep where
   prettyprint (MissingDep _ f n) =
@@ -145,7 +161,7 @@ instance PrettyPrint MissingDep where
     <> prettyDependents <> "\n"
     where
       prettyDependents =
-        T.intercalate "," $ map T.pack n
+        T.intercalate "," $ map toText n
 
 
 -- | check an entire repository
@@ -155,7 +171,7 @@ recursiveCheckDir
   -- ^ the repository's prefix (i.e. path to its directory)
   -> FilePath
   -- ^ the repository's entrypoint (filename of a map, from the repo's root)
-  -> IO DirResult
+  -> IO (DirResult Full)
 recursiveCheckDir config prefix root = do
   maps <- recursiveCheckDir' config prefix [root] mempty
 
@@ -170,7 +186,7 @@ recursiveCheckDir config prefix root = do
   let maps' = flip mapWithKey maps $ \path res ->
         if path `elem` nowayback
         then res { mapresultGeneral =
-                   Hint Warning ("Cannot go back to " <> T.pack root <> " from this map.")
+                   Hint Warning ("Cannot go back to " <> toText root <> " from this map.")
                    : mapresultGeneral res
                  }
         else res
@@ -180,7 +196,7 @@ recursiveCheckDir config prefix root = do
                    , dirresultMissingAssets = mAssets
                    , dirresultMaps = maps'
                    , dirresultGraph =
-                     T.pack
+                     toText
                      . showDot
                      . graphToDot
                      . takeSubGraph 7 root
@@ -190,9 +206,9 @@ recursiveCheckDir config prefix root = do
 
 -- | Given a (partially) completed DirResult, check which local
 -- maps are referenced but do not actually exist.
-missingDeps :: FilePath -> Map FilePath MapResult -> [MissingDep]
+missingDeps :: FilePath -> Map FilePath (MapResult a) -> [MissingDep]
 missingDeps entrypoint maps =
-  let simple = M.insert (T.pack entrypoint) [] used \\ M.union defined trivial
+  let simple = M.insert (toText entrypoint) [] used \\ M.union defined trivial
   in M.foldMapWithKey (\f n -> [MissingDep (Just $ not ("#" `isInfixOf` f)) f n]) simple
   where
     -- which maps are linked somewhere?
@@ -202,19 +218,19 @@ missingDeps entrypoint maps =
       (\path v -> map (, [path]) . mapMaybe (extractLocalDeps path) . mapresultDepends $ v)
       maps
       where extractLocalDeps prefix = \case
-              LocalMap name -> Just $ T.pack $ normaliseWithFrag prefix name
+              LocalMap name -> Just $ toText $ normaliseWithFrag prefix name
               _             -> Nothing
     -- which are defined using startLayer?
     defined :: Set Text
     defined = setFromList
       $ M.foldMapWithKey
-      (\k v -> map ((T.pack k <> "#") <>) . mapresultProvides $ v)
+      (\k v -> map ((toText k <> "#") <>) . mapresultProvides $ v)
       maps
     -- each map file is an entrypoint by itself
-    trivial = mapKeys T.pack $ void maps
+    trivial = mapKeys toText $ void maps
 
 -- | Checks if all assets referenced in the result actually exist as files
-missingAssets :: FilePath -> Map FilePath MapResult -> IO [MissingAsset]
+missingAssets :: FilePath -> Map FilePath (MapResult a) -> IO [MissingAsset]
 missingAssets prefix maps =
   mapM (fmap (fmap (fmap MissingAsset)) missingOfMap) (M.toList maps) <&> fold
   where missingOfMap (path, mapres) = mapMaybeM
@@ -222,7 +238,7 @@ missingAssets prefix maps =
                    let asset = normalise (takeDirectory path) relpath
                    in doesFileExist (prefix </> asset) <&>
                      \case True  -> Nothing
-                           False -> Just $ MissingDep Nothing (T.pack asset) [path]
+                           False -> Just $ MissingDep Nothing (toText asset) [path]
                  _ -> pure Nothing)
           (mapresultDepends mapres)
 
@@ -234,9 +250,9 @@ recursiveCheckDir'
   -- ^ the repo's directory
   -> [FilePath]
   -- ^ paths of maps yet to check
-  -> Map FilePath MapResult
+  -> Map FilePath (MapResult Full)
   -- ^ accumulator for map results
-  -> IO (Map FilePath MapResult)
+  -> IO (Map FilePath (MapResult Full))
 recursiveCheckDir' config prefix paths acc = do
 
   -- lint all maps in paths. The double fmap skips maps which cause IO errors
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index b6361b5..23267a8 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -1,27 +1,30 @@
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE NamedFieldPuns    #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns         #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE LambdaCase           #-}
+{-# LANGUAGE NamedFieldPuns       #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | Module that contains the high-level checking functions
-module CheckMap (loadAndLintMap, MapResult(..)) where
+module CheckMap (loadAndLintMap, MapResult(..), ResultKind(..), Optional,shrinkMapResult) where
+
+import           Universum
 
 import           Data.Aeson       (ToJSON (toJSON))
 import qualified Data.Aeson       as A
 import           Data.Aeson.Types ((.=))
-import           Data.Functor     ((<&>))
-import           Data.Map         (Map, toList)
 import qualified Data.Map         as M
-import           Data.Text        (Text)
 import qualified Data.Text        as T
 import qualified Data.Vector      as V
-import           GHC.Generics     (Generic)
 
 
 import           Badges           (Badge)
-import           Control.DeepSeq  (NFData)
 import           LintConfig       (LintConfig (configAssemblyTag), LintConfig')
 import           LintWriter       (LintResult, invertLintResult,
                                    resultToAdjusted, resultToBadges,
@@ -39,9 +42,14 @@ import           Types            (Dep (MapLink),
 import           Util             (PrettyPrint (prettyprint), prettyprint)
 
 
+data ResultKind = Full | Shrunk
+
+type family Optional (a :: ResultKind) (b :: *) where
+  Optional Full b = b
+  Optional Shrunk b = ()
 
 -- | What this linter produces: lints for a single map
-data MapResult = MapResult
+data MapResult (kind :: ResultKind) = MapResult
   { mapresultLayer    :: Map Hint [Text]
   -- ^ lints that occurred in one or more layers
   , mapresultTileset  :: Map Hint [Text]
@@ -50,16 +58,18 @@ data MapResult = MapResult
   -- ^ (external and local) dependencies of this map
   , mapresultProvides :: [Text]
   -- ^ entrypoints provided by this map (needed for dependency checking)
-  , mapresultAdjusted :: Maybe Tiledmap
+  , mapresultAdjusted :: Optional kind (Maybe Tiledmap)
   -- ^ the loaded map, with adjustments by the linter
   , mapresultBadges   :: [Badge]
   -- ^ badges that can be found on this map
   , mapresultGeneral  :: [Hint]
   -- ^ general-purpose lints that didn't fit anywhere else
-  } deriving (Generic, NFData)
+  } deriving (Generic)
 
+instance NFData (Optional a (Maybe Tiledmap)) => NFData (MapResult a)
 
-instance Eq MapResult where
+
+instance Eq (MapResult a) where
   a == b =
     mapresultLayer a == mapresultLayer b &&
     mapresultTileset a == mapresultTileset b &&
@@ -67,7 +77,7 @@ instance Eq MapResult where
     mapresultGeneral a == mapresultGeneral b
 
 
-instance ToJSON MapResult where
+instance ToJSON (MapResult a) where
   toJSON res = A.object
     [ "layer" .= CollectedLints (mapresultLayer res)
     , "tileset" .= CollectedLints (mapresultTileset res)
@@ -85,13 +95,16 @@ instance ToJSON CollectedLints where
             else cs
 
 
+shrinkMapResult :: MapResult Full -> MapResult Shrunk
+shrinkMapResult !res = res { mapresultAdjusted = () }
+
 -- | this module's raison d'être
 -- Lints the map at `path`, and limits local links to at most `depth`
 -- layers upwards in the file hierarchy
-loadAndLintMap :: LintConfig' -> FilePath -> Int -> IO (Maybe MapResult)
+loadAndLintMap :: LintConfig' -> FilePath -> Int -> IO (Maybe (MapResult Full))
 loadAndLintMap config path depth = loadTiledmap path <&> (\case
     DecodeErr err -> Just (MapResult mempty mempty mempty mempty Nothing mempty
-        [ Hint Fatal . T.pack $
+        [ Hint Fatal . toText $
           path <> ": Fatal: " <> err
         ])
     IOErr _ -> Nothing
@@ -99,7 +112,7 @@ loadAndLintMap config path depth = loadTiledmap path <&> (\case
       Just (runLinter (takeFileName path == "main.json") config waMap depth))
 
 -- | lint a loaded map
-runLinter :: Bool -> LintConfig' -> Tiledmap -> Int -> MapResult
+runLinter :: Bool -> LintConfig' -> Tiledmap -> Int -> MapResult Full
 runLinter isMain config tiledmap depth = MapResult
   { mapresultLayer = invertThing layer
   , mapresultTileset = invertThing tileset
@@ -184,7 +197,7 @@ checkLayerRec config depth layers =
 
 
 -- human-readable lint output, e.g. for consoles
-instance PrettyPrint (Level, MapResult) where
+instance PrettyPrint (Level, MapResult a) where
   prettyprint (_, mapResult) = if complete == ""
     then "  all good!\n" else complete
     where
@@ -195,7 +208,7 @@ instance PrettyPrint (Level, MapResult) where
       -- | pretty-prints a collection of Hints, printing each
       --   Hint only once, then a list of its occurences line-wrapped
       --   to fit onto a decent-sized terminal
-      prettyLints :: (MapResult -> Map Hint [Text]) -> [Text]
+      prettyLints :: (MapResult a -> Map Hint [Text]) -> [Text]
       prettyLints getter = fmap
         (\(h, cs) -> prettyprint h
           <> "\n    (in "
@@ -207,7 +220,7 @@ instance PrettyPrint (Level, MapResult) where
                         )
              (0, "") cs)
           <> ")\n")
-        (toList . getter $ mapResult)
+        (M.toList . getter $ mapResult)
 
       prettyGeneral :: [Text]
       prettyGeneral = map
diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs
index 8d4a5f2..fe9dc96 100644
--- a/lib/Dirgraph.hs
+++ b/lib/Dirgraph.hs
@@ -1,26 +1,21 @@
-{-# LANGUAGE LambdaCase    #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE TupleSections    #-}
 
 -- | Simple directed graphs, for dependency checking
 module Dirgraph where
 
+import           Universum
 
-import           CheckMap              (MapResult (mapresultDepends))
-import           Control.Monad         (forM_, unless)
-import           Data.Functor          ((<&>))
-import           Data.Map.Strict       (Map, mapMaybeWithKey, mapWithKey,
-                                        traverseMaybeWithKey, traverseWithKey)
-import qualified Data.Map.Strict       as M
-import           Data.Maybe            (fromMaybe)
-import           Data.Set              (Set, (\\))
-import qualified Data.Set              as S
-import           Paths                 (normalise)
-import qualified System.FilePath       as FP
-import           System.FilePath.Posix (takeDirectory, (</>))
-import           Text.Dot              (Dot, (.->.))
-import qualified Text.Dot              as D
-import           Types                 (Dep (LocalMap))
-import           Witherable            (mapMaybe)
+import           CheckMap        (MapResult (mapresultDepends))
+import           Data.Map.Strict (mapMaybeWithKey, mapWithKey, traverseWithKey)
+import qualified Data.Map.Strict as M
+import           Data.Set        ((\\))
+import qualified Data.Set        as S
+import           Paths           (normalise)
+import           Text.Dot        (Dot, (.->.))
+import qualified Text.Dot        as D
+import           Types           (Dep (LocalMap))
 
 -- | a simple directed graph
 type Graph a = Map a (Set a)
@@ -29,18 +24,16 @@ nodes :: Graph a -> Set a
 nodes = M.keysSet
 
 -- | simple directed graph of exits
-resultToGraph :: Map FilePath MapResult -> Graph FilePath
-resultToGraph = mapWithKey (\p r -> S.fromList
-                             . mapMaybe (onlyLocalMaps (takeDirectory p))
-                             . mapresultDepends $ r)
-  where onlyLocalMaps prefix = \case
-          LocalMap path -> Just (FP.normalise (prefix </> normalise "" path))
+resultToGraph :: Map FilePath (MapResult a) -> Graph FilePath
+resultToGraph = fmap (S.fromList . mapMaybe onlyLocalMaps . mapresultDepends)
+  where onlyLocalMaps = \case
+          LocalMap path -> Just (normalise "" path)
           _             -> Nothing
 
 -- | invert edges of a directed graph
 invertGraph :: (Eq a, Ord a) => Graph a -> Graph a
 invertGraph graph = mapWithKey collectFroms graph
-  where collectFroms to _ = S.fromList . M.elems . mapMaybeWithKey (select to) $ graph
+  where collectFroms to _ = S.fromList . elems . mapMaybeWithKey (select to) $ graph
         select to from elems = if to `elem` elems then Just from else Nothing
 
 -- | all nodes reachable from some entrypoint
diff --git a/lib/KindLinter.hs b/lib/KindLinter.hs
index ccca1db..a876a8f 100644
--- a/lib/KindLinter.hs
+++ b/lib/KindLinter.hs
@@ -13,11 +13,10 @@
 
 module KindLinter where
 
+import           Universum
+
 import           Data.HList
-import           Data.Kind       (Type)
-import           Data.Map.Strict
-import           Data.Void       (Void)
-import           GHC.TypeLits    (KnownSymbol, Symbol, symbolVal)
+import           GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
 
 
 func :: a -> HList [Int, String]
diff --git a/lib/LayerData.hs b/lib/LayerData.hs
index 1a07982..6956c92 100644
--- a/lib/LayerData.hs
+++ b/lib/LayerData.hs
@@ -2,12 +2,12 @@
 
 module LayerData where
 
+import           Universum         hiding (maximum, uncons)
 
 import           Control.Monad.Zip (mzipWith)
-import           Data.Set          (Set, insert)
-import           Data.Text         (Text)
-import qualified Data.Text         as T
-import           Data.Vector       (Vector, uncons)
+import           Data.Set          (insert)
+import           Data.Vector       (maximum, uncons)
+import qualified Text.Show         as TS
 import           Tiled             (GlobalId (unGlobalId), Layer (..))
 import           Util              (PrettyPrint (..))
 
@@ -22,8 +22,8 @@ instance Eq Collision where
 instance PrettyPrint Collision where
   prettyprint (Collision (a,b)) = a <> " and " <> b
 
-instance Show Collision where
-  show c = T.unpack $ prettyprint c
+instance TS.Show Collision where
+  show c = toString $ prettyprint c
 
 -- | Finds pairwise tile collisions between the given layers.
 layerOverlaps :: Vector Layer -> Set Collision
diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index e71638b..11a8122 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -12,21 +12,21 @@
 -- | Module that deals with handling config options
 module LintConfig (LintConfig(..), LintConfig', patchConfig) where
 
-import           Control.Monad.Identity (Identity)
-import           Data.Aeson             (FromJSON (parseJSON), Options (..),
-                                         defaultOptions, eitherDecode)
-import           Data.Aeson.Types       (genericParseJSON)
-import qualified Data.ByteString.Char8  as C8
-import qualified Data.ByteString.Lazy   as LB
-import qualified Data.Map.Strict        as M
-import           Data.Text              (Text)
-import           GHC.Generics           (Generic (Rep, from, to), K1 (..),
-                                         M1 (..), (:*:) (..))
-import           Types                  (Level)
-import           Uris                   (SchemaSet,
-                                         Substitution (DomainSubstitution))
-import           WithCli                (Proxy (..))
-import           WithCli.Pure           (Argument (argumentType, parseArgument))
+import           Universum
+import qualified Universum.Unsafe      as Unsafe
+
+import           Data.Aeson            (FromJSON (parseJSON), Options (..),
+                                        defaultOptions, eitherDecode)
+import           Data.Aeson.Types      (genericParseJSON)
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy  as LB
+import qualified Data.Map.Strict       as M
+import           GHC.Generics          (Generic (Rep, from, to), K1 (..),
+                                        M1 (..), (:*:) (..))
+import           Types                 (Level)
+import           Uris                  (SchemaSet,
+                                        Substitution (DomainSubstitution))
+import           WithCli.Pure          (Argument (argumentType, parseArgument))
 
 type family HKD f a where
   HKD Identity a = a
@@ -138,7 +138,7 @@ patchConfig config p = config'
           DomainSubstitution (M.fromList generated) scope
           where generated = (\slug -> (slug, "/@/rc3_21/"<>slug)) <$> configAssemblies config'
         scope = (\(DomainSubstitution _ s) -> s)
-         . snd . head
+         . snd . Unsafe.head
          . filter ((==) "world" . fst)
          $ configUriSchemas config'
 
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 2b891c3..d0c6c4e 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -42,21 +42,15 @@ module LintWriter
   , adjust
   ) where
 
-import           Data.Text                  (Text)
-
-import           Badges                     (Badge)
-import           Control.Monad.State        (MonadState (put), StateT, modify)
-import           Control.Monad.Trans.Reader (Reader, asks, runReader)
-import           Control.Monad.Trans.State  (get, runStateT)
-import           Control.Monad.Writer.Lazy  (lift)
-import           Data.Bifunctor             (Bifunctor (second))
-import           Data.Map                   (Map, fromListWith)
-import           Data.Maybe                 (mapMaybe)
-import qualified Data.Set                   as S
-import           LintConfig                 (LintConfig')
-import           TiledAbstract              (HasName (getName))
-import           Types                      (Dep, Hint, Level (..), Lint (..),
-                                             hint, lintsToHints)
+import           Universum
+
+
+import           Badges        (Badge)
+import           Data.Map      (fromListWith)
+import           LintConfig    (LintConfig')
+import           TiledAbstract (HasName (getName))
+import           Types         (Dep, Hint, Level (..), Lint (..), hint,
+                                lintsToHints)
 
 
 -- | A monad modelling the main linter features
@@ -109,7 +103,7 @@ zoom embed extract operation = do
 -- | "invert" a linter's result, grouping lints by their messages
 invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [Text]
 invertLintResult (LinterState (lints, ctxt)) =
-  fmap (S.toList . S.fromList . fmap getName) . fromListWith (<>) $ (, [ctxt]) <$> lintsToHints lints
+  fmap (sortNub . map getName) . fromListWith (<>) $ (, [ctxt]) <$> lintsToHints lints
 
 resultToDeps :: LintResult a -> [Dep]
 resultToDeps (LinterState (lints,_)) = mapMaybe lintToDep lints
diff --git a/lib/Paths.hs b/lib/Paths.hs
index 15dc66b..f4dc3ed 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -7,15 +7,16 @@
 -- I just hope you are running this on some kind of Unix
 module Paths where
 
-import           Control.DeepSeq       (NFData)
-import           Data.Text             (Text, isPrefixOf)
+import           Universum
+import qualified Universum.Unsafe      as Unsafe
+
 import qualified Data.Text             as T
-import           GHC.Generics          (Generic)
 import           System.FilePath       (splitPath)
 import           System.FilePath.Posix ((</>))
 import           Text.Regex.TDFA
 import           Util                  (PrettyPrint (prettyprint))
 
+
 -- | a normalised path: a number of "upwards" steps, and
 -- a path without any . or .. in it. Also possibly a
 -- fragment, mostly for map links.
@@ -36,9 +37,9 @@ parsePath :: Text -> PathResult
 parsePath text =
   if | T.isInfixOf "{{" text || T.isInfixOf "}}" text -> PathVarsDisallowed
      | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
-     | "/_/" `isPrefixOf` text ->  UnderscoreMapLink
-     | "/@/" `isPrefixOf` text ->  AtMapLink
-     | "/" `isPrefixOf` text ->  AbsolutePath
+     | "/_/" `T.isPrefixOf` text ->  UnderscoreMapLink
+     | "/@/" `T.isPrefixOf` text ->  AtMapLink
+     | "/" `T.isPrefixOf` text ->  AbsolutePath
      | otherwise ->  NotAPath
   where
     (_, prefix, rest, _) =
@@ -47,10 +48,10 @@ parsePath text =
     up = length . filter (".." ==) . T.splitOn  "/" $ prefix
     parts = T.splitOn "#" rest
     -- `head` is unsafe, but splitOn will always produce lists with at least one element
-    path = head parts
-    fragment = if length parts >= 2
-      then Just $ T.concat $ tail parts
-      else Nothing
+    path = Unsafe.head parts
+    fragment = case nonEmpty parts of
+      Nothing -> Nothing
+      Just p  -> Just $ T.concat $ tail p
 
 instance PrettyPrint RelPath where
   prettyprint (Path up rest frag) = ups <> rest <> fragment
@@ -63,14 +64,14 @@ instance PrettyPrint RelPath where
 -- at the end of the prefix, i.e. it will never return paths
 -- that lie (naïvely) outside of the prefix.
 normalise :: FilePath -> RelPath ->  FilePath
-normalise prefix (Path 0 path _) = prefix </> T.unpack path
+normalise prefix (Path 0 path _) = prefix </> toString path
 normalise prefix (Path i path _) =
-  concat (take (length dirs - i) dirs) </> T.unpack path
+  concat (take (length dirs - i) dirs) </> toString path
   where dirs = splitPath prefix
 
 normaliseWithFrag :: FilePath -> RelPath -> FilePath
 normaliseWithFrag prefix (Path i path frag) =
-  normalise prefix (Path (i+1) path frag) <> T.unpack (maybe mempty ("#" <>) frag)
+  normalise prefix (Path (i+1) path frag) <> toString (maybe mempty ("#" <>) frag)
 
 -- | does this path contain an old-style pattern for inter-repository
 -- links as was used at rc3 in 2020?
@@ -81,7 +82,5 @@ isOldStyle (Path _ text frag) = path =~ ("{<.+>*}" :: Text)
           _      -> text
 
 getExtension :: RelPath -> Text
-getExtension (Path _ text _) = case length splitted of
-  0 -> ""
-  _ -> last splitted
+getExtension (Path _ text _) = maybe "" last (nonEmpty splitted)
   where splitted = T.splitOn "." text
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 9cde1ec..eb31403 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -1,18 +1,21 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE MultiWayIf        #-}
-{-# LANGUAGE NamedFieldPuns    #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TupleSections     #-}
-{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE MultiWayIf          #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 -- | Contains checks for custom ties of the map json
 module Properties (checkMap, checkTileset, checkLayer) where
 
+import           Universum         hiding (intercalate, isPrefixOf)
 
-import           Control.Monad     (forM, forM_, unless, when)
-import           Data.Text         (Text, intercalate, isInfixOf, isPrefixOf)
+import           Data.Text         (intercalate, isInfixOf, isPrefixOf)
 import qualified Data.Text         as T
 import qualified Data.Vector       as V
 import           Tiled             (Layer (..), Object (..), Property (..),
@@ -27,14 +30,9 @@ import           Util              (mkProxy, naiveEscapeHTML, prettyprint,
 import           Badges            (Badge (Badge),
                                     BadgeArea (BadgePoint, BadgeRect),
                                     BadgeToken, parseToken)
-import           Data.Data         (Proxy (Proxy))
-import           Data.Functor      ((<&>))
 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 (..))
@@ -86,7 +84,7 @@ checkMap = do
   let unlessLayer = unlessElement layers
 
   -- test custom map properties
-  mapM_ checkMapProperty (fromMaybe mempty $ tiledmapProperties tiledmap)
+  mapM_ checkMapProperty (maybeToMonoid $ tiledmapProperties tiledmap)
 
   -- can't have these with the rest of layer/tileset lints since they're
   -- not specific to any one of them
@@ -144,10 +142,10 @@ checkMapProperty p@(Property name _) = case name of
   -- scripts can be used by one map
   _ | T.toLower name == "script" ->
       unwrapString p $ \str ->
-        unless ((checkIsRc3Url str) &&
-                (not $ "/../" `isInfixOf` str) &&
-                (not $ "%" `isInfixOf` str) &&
-                (not $ "@" `isInfixOf` str))
+        unless (checkIsRc3Url str &&
+                not ( "/../" `isInfixOf` str) &&
+                not ( "%" `isInfixOf` str) &&
+                not ( "@" `isInfixOf` str))
         $ forbid "only scripts hosted on static.rc3.world are allowed."
     | name `elem` ["jitsiRoom", "bbbRoom", "playAudio", "openWebsite"
                   , "url", "exitUrl", "silent", "getBadge"]
@@ -192,14 +190,14 @@ checkTileset = do
   adjust (\t -> t { tilesetTiles = tiles' })
 
   -- check individual tileset properties
-  mapM_ checkTilesetProperty (fromMaybe mempty $ tilesetProperties tileset)
+  mapM_ checkTilesetProperty (maybeToMonoid $ tilesetProperties tileset)
 
   case tilesetTiles tileset of
     Nothing -> pure ()
     Just tiles -> refuseDoubledThings tileId
       -- can't set properties on the same tile twice
         (\tile -> complain $ "cannot set properties on the \
-                  \tile with the id" <> showText (tileId tile) <> "twice.")
+                  \tile with the id" <> show (tileId tile) <> "twice.")
         tiles
 
   where
@@ -258,14 +256,14 @@ checkLayer = do
       forM_ (getProperties layer) checkObjectGroupProperty
 
       unless (layerName layer == "floorLayer") $
-        when (null (layerObjects layer) || layerObjects layer == Just mempty) $
+        when (isNothing (layerObjects layer) || layerObjects layer == Just mempty) $
           warn "objectgroup layer (which aren't the floorLayer) \
                \are useless if they are empty."
 
     ty -> complain $ "unsupported layer type " <> prettyprint ty <> "."
 
   if layerType layer == "group"
-    then when (null (layerLayers layer))
+    then when (isNothing (layerLayers layer))
     $ warn "Empty group layers are pointless."
     else when (isJust (layerLayers layer))
     $ complain "Layer is not of type \"group\", but has sublayers."
@@ -316,7 +314,7 @@ checkObjectProperty p@(Property name _) = do
         unless (objectType obj == "variable") $
           complain $ "the "<>prettyprint name<>" property should only be set \
                      \on objects of type \"variable\""
-        when (null (objectName obj) || objectName obj == Just mempty) $
+        when (isNothing (objectName obj) || objectName obj == Just mempty) $
           complain $ "Objects with the property "<>prettyprint name<>" set must \
                      \be named."
     | name `elem` [ "openSound", "closeSound", "bellSound", "loadSound" ] -> do
@@ -525,7 +523,7 @@ checkTileThing removeExits p@(Property name _value) = case name of
       requireProperty req = propertyRequiredBy req name
       requireOneOf names = do
         context <- askContext
-        when (all (not . containsProperty context) names)
+        unless (any (containsProperty context) names)
           $ complain $ "property " <> prettyprint name <> " requires one of "
                     <> prettyprint names
 
@@ -549,9 +547,8 @@ checkTileThing removeExits p@(Property name _value) = case name of
 
 -- | refuse doubled names in everything that's somehow a collection of names
 refuseDoubledNames
-  :: (HasName a, HasTypeName a)
-  => (Foldable t, Functor t)
-  => t a
+  :: (Container t, HasName (Element t), HasTypeName (Element t))
+  => t
   -> LintWriter b
 refuseDoubledNames = refuseDoubledThings
   getName
@@ -560,10 +557,10 @@ refuseDoubledNames = refuseDoubledThings
 
 -- | refuse doubled things via equality on after applying some function
 refuseDoubledThings
-  :: (Eq a, Ord a, Foldable t, Functor t)
-  => (a' -> a)
-  -> (a' -> LintWriter b)
-  -> t a'
+  :: (Eq a, Ord a, Container t)
+  => (Element t -> a)
+  -> (Element t -> LintWriter b)
+  -> t
   -> LintWriter b
 refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempty)
   where
@@ -591,15 +588,15 @@ warnUnknown p@(Property name _) =
 ---- General functions ----
 
 unlessElement
-  :: Foldable f
-  => f a
-  -> (a -> Bool)
+  :: Container f
+  => f
+  -> (Element f -> 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 :: (HasName (Element f), Container f)
+  => f -> Text -> LintWriter b -> LintWriter b
 unlessElementNamed things name =
   unlessElement things ((==) name . getName)
 
@@ -777,4 +774,4 @@ isOrdInRange :: (Ord a, Show a)
 isOrdInRange unwrapa l r p@(Property name _) = unwrapa p $ \int ->
   if l < int && int < r then pure ()
   else complain $ "Property " <> prettyprint name <> " should be between "
-               <> showText l <> " and " <> showText r<>"."
+               <> show l <> " and " <> show r<>"."
diff --git a/lib/Tiled.hs b/lib/Tiled.hs
index ab7d4f4..3162dfd 100644
--- a/lib/Tiled.hs
+++ b/lib/Tiled.hs
@@ -17,21 +17,15 @@
 -- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
 module Tiled where
 
-import           Control.DeepSeq        (NFData)
-import           Control.Exception      (try)
-import           Control.Exception.Base (SomeException)
-import           Data.Aeson             hiding (Object)
-import qualified Data.Aeson             as A
-import           Data.Aeson.Types       (typeMismatch)
-import qualified Data.ByteString        as BS
-import qualified Data.ByteString.Lazy   as LB
-import           Data.Char              (toLower)
-import           Data.Map               (Map)
-import           Data.String            (IsString (fromString))
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import           Data.Vector            (Vector)
-import           GHC.Generics           (Generic)
+import           Universum
+
+-- TODO: what ever are these aeson imports
+import           Data.Aeson           hiding (Object)
+import qualified Data.Aeson           as A
+import           Data.Aeson.Types     (typeMismatch)
+import qualified Data.ByteString      as BS
+import qualified Data.ByteString.Lazy as LB
+import           Data.Char            (toLower)
 
 
 -- | options for Aeson's generic encoding and parsing functions
@@ -68,7 +62,7 @@ data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int | FloatProp Floa
   deriving (Eq, Generic, Show, NFData)
 
 instance IsString PropertyValue where
-  fromString s = StrProp (T.pack s)
+  fromString s = StrProp (toText s)
 
 instance FromJSON Property where
   parseJSON (A.Object o) = do
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
index 5589207..f55e75e 100644
--- a/lib/TiledAbstract.hs
+++ b/lib/TiledAbstract.hs
@@ -2,10 +2,8 @@
 
 module TiledAbstract where
 
-import           Data.Maybe  (fromMaybe)
-import           Data.Proxy  (Proxy)
-import           Data.Text   (Text)
-import           Data.Vector (Vector)
+import           Universum
+
 import qualified Data.Vector as V
 import           Tiled       (GlobalId, Layer (..), Object (..), Property (..),
                               PropertyValue (..), Tile (..), Tiledmap (..),
@@ -17,27 +15,27 @@ class HasProperties a where
   adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
 
 instance HasProperties Layer where
-  getProperties = fromMaybe mempty . layerProperties
+  getProperties = maybeToMonoid . layerProperties
   adjustProperties f layer = layer
     { layerProperties = f (getProperties layer) }
 
 instance HasProperties Tileset where
-  getProperties = fromMaybe mempty . tilesetProperties
+  getProperties = maybeToMonoid . tilesetProperties
   adjustProperties f tileset = tileset
     { tilesetProperties = f (getProperties tileset) }
 
 instance HasProperties Tile where
-  getProperties = V.toList . fromMaybe mempty . tileProperties
+  getProperties = V.toList . maybeToMonoid . tileProperties
   adjustProperties f tile = tile
     { tileProperties = (fmap V.fromList . f) (getProperties tile) }
 
 instance HasProperties Object where
-  getProperties = V.toList . fromMaybe mempty . objectProperties
+  getProperties = V.toList . maybeToMonoid . objectProperties
   adjustProperties f obj = obj
     { objectProperties = (fmap V.fromList . f) (getProperties obj) }
 
 instance HasProperties Tiledmap where
-  getProperties = fromMaybe mempty . tiledmapProperties
+  getProperties = maybeToMonoid . tiledmapProperties
   adjustProperties f tiledmap = tiledmap
     { tiledmapProperties = f (getProperties tiledmap) }
 
diff --git a/lib/Types.hs b/lib/Types.hs
index 43a5131..f58705a 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -17,20 +17,17 @@ module Types
   , lintsToHints
   ) where
 
+import           Universum
+
 import           Control.Monad.Trans.Maybe ()
 import           Data.Aeson                (FromJSON, ToJSON (toJSON),
                                             ToJSONKey, (.=))
-import           Data.Text                 (Text)
-import           GHC.Generics              (Generic)
 
 import           Badges                    (Badge)
-import           Control.DeepSeq           (NFData)
 import qualified Data.Aeson                as A
-import           Data.Maybe                (mapMaybe)
 import           Paths                     (RelPath)
-import           Util                      (PrettyPrint (..), showText)
-import           WithCli                   (Argument, Proxy (..),
-                                            atomicArgumentsParser)
+import           Util                      (PrettyPrint (..))
+import           WithCli                   (Argument, atomicArgumentsParser)
 import           WithCli.Pure              (Argument (argumentType, parseArgument),
                                             HasArguments (argumentsParser))
 
@@ -83,7 +80,7 @@ lintsToHints = mapMaybe (\case {Lint hint -> Just hint ; _ -> Nothing})
 
 instance PrettyPrint Lint where
   prettyprint (Lint  Hint { hintMsg, hintLevel } ) =
-    "  " <> showText hintLevel <> ": " <> hintMsg
+    "  " <> show hintLevel <> ": " <> hintMsg
   prettyprint (Depends dep) =
     "  Info: found dependency: " <> prettyprint dep
   prettyprint (Offers dep) =
@@ -92,7 +89,7 @@ instance PrettyPrint Lint where
     "  Info: found a badge."
 
 instance PrettyPrint Hint where
-  prettyprint (Hint level msg) = "  " <> showText level <> ": " <> msg
+  prettyprint (Hint level msg) = "  " <> show level <> ": " <> msg
 
 instance ToJSON Lint where
   toJSON (Lint h) = toJSON h
diff --git a/lib/Uris.hs b/lib/Uris.hs
index 00f86a4..a8c7068 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -8,26 +8,16 @@
 -- | Functions to deal with uris and custom uri schemes
 module Uris where
 
+import           Universum
 
-
-import           Control.Monad           (unless, when)
-import           Data.Aeson              (FromJSON (..), Options (..),
-                                          SumEncoding (UntaggedValue),
-                                          defaultOptions, genericParseJSON)
-import           Data.Data               (Proxy)
-import           Data.Either.Combinators (maybeToRight, rightToMaybe)
-import           Data.Map.Strict         (Map)
-import qualified Data.Map.Strict         as M
-import           Data.Text               (Text, pack, unpack)
-import qualified Data.Text               as T
-import           GHC.Generics            (Generic)
-import           GHC.TypeLits            (KnownSymbol, symbolVal)
-import           Network.URI.Encode      as URI
-import           Text.Regex.TDFA         ((=~))
-import           Witherable              (mapMaybe)
-
-import           Data.String
-import           Network.URI             as NativeUri
+import           Data.Aeson         (FromJSON (..), Options (..),
+                                     SumEncoding (UntaggedValue),
+                                     defaultOptions, genericParseJSON)
+import qualified Data.Map.Strict    as M
+import qualified Data.Text          as T
+import           GHC.TypeLits       (KnownSymbol, symbolVal)
+import           Network.URI        (URI (..), URIAuth (..), parseURI)
+import qualified Network.URI.Encode as URI
 
 data Substitution =
     Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] }
@@ -56,7 +46,7 @@ extractDomain url =
 
 parseUri :: Text -> Maybe (Text, Text, Text)
 parseUri uri =
-  case parseURI (unpack uri) of
+  case parseURI (toString uri) of
     Nothing -> Nothing
     Just parsedUri -> case uriAuthority parsedUri of
         Nothing -> Nothing
@@ -84,15 +74,15 @@ data SubstError =
 applySubsts :: KnownSymbol s
   => Proxy s -> SchemaSet -> Text -> Either SubstError Text
 applySubsts s substs uri =  do
-  when (T.isInfixOf (pack "{{") uri || T.isInfixOf (pack "}}") uri)
+  when (T.isInfixOf (toText "{{") uri || T.isInfixOf (toText "}}") uri)
    $ Left VarsDisallowed
   parts@(schema, _, _) <- note NotALink $ parseUri uri
 
   let rules = filter ((==) schema . fst) substs
 
-  case fmap (applySubst parts . snd) rules of
-    []  -> Left (SchemaDoesNotExist schema)
-    results@(_:_) -> case mapMaybe rightToMaybe results of
+  case nonEmpty (map (applySubst parts . snd) rules) of
+    Nothing  -> Left (SchemaDoesNotExist schema)
+    Just results -> case rights (toList results) of
       suc:_ -> Right suc
       _     -> minimum results
 
@@ -104,14 +94,14 @@ applySubsts s substs uri =  do
          (fmap fst . filter (elem (symbolVal s) . scope . snd) $ substs))
       case rule of
         DomainSubstitution table _  -> do
-          prefix <- note (DomainDoesNotExist (schema <> pack "://" <> domain))
+          prefix <- note (DomainDoesNotExist (schema <> toText "://" <> domain))
                        $ M.lookup domain table
           pure (prefix <> rest)
         Prefixed {..}
           | domain `elem` blocked -> Left IsBlocked
-          | domain `elem` allowed || pack "streamproxy.rc3.world" `T.isSuffixOf` domain -> Right uri
+          | domain `elem` allowed || toText "streamproxy.rc3.world" `T.isSuffixOf` domain -> Right uri
           | otherwise -> Right (prefix <> URI.encodeText uri)
         Allowed _ domains -> if domain `elem` domains
-                    || pack "streamproxy.rc3.world" `T.isSuffixOf` domain
+                    || toText "streamproxy.rc3.world" `T.isSuffixOf` domain
           then Right uri
           else Left (DomainIsBlocked domains)
diff --git a/lib/Util.hs b/lib/Util.hs
index ffd9faa..1ffbbe5 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -6,31 +6,24 @@
 -- concerns itself with wrangling haskell's string types
 module Util
   ( mkProxy
-  , showText
   , PrettyPrint(..)
   , printPretty
   , naiveEscapeHTML
   , layerIsEmpty
   ) where
 
+import           Universum
+
 import           Data.Aeson as Aeson
-import           Data.Proxy (Proxy (..))
-import           Data.Set   (Set)
 import qualified Data.Set   as S
-import           Data.Text  (Text)
 import qualified Data.Text  as T
 import           Tiled      (Layer (layerData), PropertyValue (..),
                              Tileset (tilesetName), layerName, mkTiledId)
 
-
 -- | helper function to create proxies
 mkProxy :: a -> Proxy a
 mkProxy = const Proxy
 
--- | haskell's many string types are FUN …
-showText :: Show a => a -> Text
-showText = T.pack . show
-
 -- | a class to address all the string conversions necessary
 -- when using Show to much that just uses Text instead
 class PrettyPrint a where
@@ -44,7 +37,7 @@ instance PrettyPrint Text where
 instance PrettyPrint Aeson.Value where
   prettyprint = \case
     Aeson.String s -> prettyprint s
-    v              -> (T.pack . show) v
+    v              -> show v
 
 instance PrettyPrint t => PrettyPrint (Set t) where
   prettyprint = prettyprint . S.toList
@@ -53,8 +46,8 @@ instance PrettyPrint PropertyValue where
   prettyprint = \case
     StrProp str     -> str
     BoolProp bool   -> if bool then "true" else "false"
-    IntProp int     -> showText int
-    FloatProp float -> showText float
+    IntProp int     -> show int
+    FloatProp float -> show float
 
 -- | here since Unit is sometimes used as dummy type
 instance PrettyPrint () where
@@ -70,7 +63,7 @@ instance PrettyPrint a => PrettyPrint [a] where
   prettyprint = T.intercalate ", " . fmap prettyprint
 
 printPretty :: PrettyPrint a => a -> IO ()
-printPretty = putStr . T.unpack . prettyprint
+printPretty = putStr . toString . prettyprint
 
 
 -- | for long lists which shouldn't be printed out in their entirety
diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs
index 36c0df7..e4815fe 100644
--- a/lib/WriteRepo.hs
+++ b/lib/WriteRepo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -5,14 +6,11 @@
 -- | Module for writing an already linted map Repository back out again.
 module WriteRepo (writeAdjustedRepository) where
 
+import           Universum
+
 import           CheckDir               (DirResult (..), resultIsFatal)
-import           CheckMap               (MapResult (..))
-import           Control.Monad          (forM_, unless)
-import           Control.Monad.Extra    (ifM)
+import           CheckMap               (MapResult (..), ResultKind (..))
 import           Data.Aeson             (encodeFile)
-import           Data.Map.Strict        (toList)
-import           Data.Maybe             (mapMaybe)
-import           Data.Set               (Set)
 import qualified Data.Set               as S
 import           LintConfig             (LintConfig (configDontCopyAssets),
                                          LintConfig')
@@ -27,7 +25,7 @@ import           Types                  (Dep (Local))
 
 
 
-writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult -> IO ExitCode
+writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult Full -> IO ExitCode
 writeAdjustedRepository config inPath outPath result
   | resultIsFatal config result =
       pure (ExitFailure 1)
@@ -36,7 +34,7 @@ writeAdjustedRepository config inPath outPath result
         createDirectoryIfMissing True outPath
 
         -- write out all maps
-        forM_ (toList $ dirresultMaps result) $ \(path,out) -> do
+        forM_ (toPairs $ dirresultMaps result) $ \(path,out) -> do
           createDirectoryIfMissing True (takeDirectory (outPath </> path))
           encodeFile (outPath </> path) $ mapresultAdjusted out
 
@@ -51,7 +49,7 @@ writeAdjustedRepository config inPath outPath result
                        Local path -> Just . normalise mapdir $ path
                        _          -> Nothing)
                      $ mapresultDepends mapresult)
-                . toList $ dirresultMaps result
+                . toPairs $ dirresultMaps result
 
           -- copy all assets
           forM_ localdeps $ \path ->
diff --git a/package.yaml b/package.yaml
index 7cd6130..4acf9e8 100644
--- a/package.yaml
+++ b/package.yaml
@@ -6,9 +6,11 @@ author: stuebinm
 maintainer: stuebinm@disroot.org
 copyright: 2022 stuebinm
 ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
+default-extensions: NoImplicitPrelude
 
 dependencies:
   - base
+  - universum
   - aeson
   - bytestring
   - mtl
@@ -54,8 +56,7 @@ executables:
   walint-server:
     main: Main.hs
     source-dirs: 'server'
-    default-extensions:
-      - NoImplicitPrelude
+    ghc-options: -rtsopts -threaded
     dependencies:
       - walint
       - universum
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index ebe65aa..9b09f1d 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -108,7 +108,7 @@ headerText = \case
 
 
 -- | The fully monky
-instance ToHtml DirResult where
+instance ToHtml (DirResult a) where
   toHtml res@DirResult { .. } = do
 
     p_ $ do badge maxlevel "Linted:"; " "; headerText maxlevel
diff --git a/server/Server.hs b/server/Server.hs
index f2b286b..711da88 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE ExistentialQuantification  #-}
+{-# LANGUAGE ExplicitForAll             #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -31,6 +33,7 @@ module Server ( loadConfig
 import           Universum
 
 import           CheckDir                   (DirResult)
+import           CheckMap                   (ResultKind (Full, Shrunk))
 import           Control.Arrow              ((>>>))
 import           Control.Concurrent         (modifyMVar_, withMVar)
 import           Crypto.Hash.SHA1           (hash)
@@ -162,7 +165,7 @@ configCodec = Config
 
 -- | a job status (of a specific uuid)
 data JobStatus =
-  Pending | Linted !DirResult Text | Failed Text
+  Pending | Linted !(DirResult Shrunk) Text | Failed Text
   deriving (Generic, ToJSON, NFData)
 
 instance TS.Show JobStatus where
diff --git a/server/Worker.hs b/server/Worker.hs
index 91fa8e2..af07904 100644
--- a/server/Worker.hs
+++ b/server/Worker.hs
@@ -9,7 +9,8 @@ module Worker (linterThread, Job(..)) where
 
 import           Universum
 
-import           CheckDir                      (recursiveCheckDir)
+import           CheckDir                      (recursiveCheckDir,
+                                                shrinkDirResult)
 import           Control.Concurrent.Async      (async, link)
 import           Control.Concurrent.STM.TQueue
 import           Control.Exception             (IOException, handle)
@@ -66,7 +67,7 @@ runJob config Job {..} done = do
       callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ]
 
       res <- recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg)
-               >>= evaluateNF
+               >>= evaluateNF . shrinkDirResult
       setJobStatus done jobOrg jobRef $
         Linted res rev
 
diff --git a/src/Main.hs b/src/Main.hs
index f0a6c09..bf39564 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,18 +7,15 @@
 
 module Main where
 
-import           Control.Monad            (unless, when)
-import           Control.Monad.Identity   (Identity)
+import           Universum
+
 import           Data.Aeson               (eitherDecode, encode)
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import           Data.Aeson.KeyMap        (coercionToHashMap)
 import qualified Data.ByteString.Lazy     as LB
-import           Data.Maybe               (fromMaybe)
 import qualified Data.Text.Encoding       as T
 import qualified Data.Text.IO             as T
-import           System.Exit              (ExitCode (..), exitWith)
-import           System.IO                (hPutStrLn, stderr)
-import           WithCli                  (Generic, HasArguments, withCli)
+import           WithCli                  (HasArguments, withCli)
 
 import           CheckDir                 (recursiveCheckDir, resultIsFatal, DirResult (dirresultGraph))
 import           Control.Monad            (when)
@@ -28,6 +25,7 @@ import           Util                     (printPretty)
 import           WriteRepo                (writeAdjustedRepository)
 import Text.Dot (showDot)
 
+import           System.Exit              (ExitCode (ExitFailure, ExitSuccess))
 import qualified Version                  as V (version)
 
 -- | the options this cli tool can take
@@ -62,7 +60,7 @@ run options = do
 
   when (version options) $ do
     putStrLn V.version
-    exitWith ExitSuccess
+    exitSuccess
 
   let repo = fromMaybe "." (repository options)
   let entry = fromMaybe "main.json" (entrypoint options)
@@ -72,7 +70,7 @@ run options = do
     Nothing -> error "Need a config file!"
     Just path -> LB.readFile path >>= \res ->
       case eitherDecode res :: Either String (LintConfig Identity) of
-        Left err   -> error $ "config file invalid: " <> err
+        Left err   -> error $ "config file invalid: " <> toText err
         Right file -> pure (patchConfig file (config options))
 
   lints <- recursiveCheckDir lintconfig repo entry
@@ -85,16 +83,14 @@ run options = do
      | otherwise -> printPretty (level, lints)
 
   case out options of
-    Nothing -> exitWith $ case resultIsFatal lintconfig lints of
-      False -> ExitSuccess
-      True  -> ExitFailure 1
+    Nothing -> exitWith $ if resultIsFatal lintconfig lints then ExitFailure 1 else ExitSuccess
     Just outpath -> do
       c <- writeAdjustedRepository lintconfig repo outpath lints
       unless (json options) $
         case c of
-          ExitFailure 1 -> putStrLn "\nMap failed linting!"
-          ExitFailure 2 -> putStrLn "\nOutpath already exists, not writing anything."
-          _ -> pure ()
+          ExitFailure 1 -> putTextLn "\nMap failed linting!"
+          ExitFailure 2 -> putTextLn "\nOutpath already exists, not writing anything."
+          _ -> pass
       exitWith c
 
 
@@ -113,10 +109,10 @@ printLB a = T.putStrLn $ T.decodeUtf8 $ LB.toStrict a
 aesonWarning :: IO ()
 aesonWarning = case coercionToHashMap of
   Just _ -> hPutStrLn stderr
-    "Warning: this program was compiled using an older version of the Aeson Library\n\
+    ("Warning: this program was compiled using an older version of the Aeson Library\n\
     \used for parsing JSON, which is susceptible to hash flooding attacks.\n\
     \n\
     \Recompiling with a newer version is recommended when handling untrusted inputs.\n\
     \n\
-    \See https://cs-syd.eu/posts/2021-09-11-json-vulnerability for details."
-  _ -> pure ()
+    \See https://cs-syd.eu/posts/2021-09-11-json-vulnerability for details." :: Text)
+  _ -> pass
diff --git a/src/Version.hs b/src/Version.hs
index c0f7edf..2ec1537 100644
--- a/src/Version.hs
+++ b/src/Version.hs
@@ -3,10 +3,10 @@
 
 module Version ( version ) where
 
-import           Control.Monad.Trans (liftIO)
+import           Universum
+
 import qualified Language.Haskell.TH as TH
 import           System.Process      (readProcess)
-import GHC.IO (catchAny)
 
 version :: String
 version = "walint rc3 2021 (" <>
diff --git a/walint.cabal b/walint.cabal
index caf3a4f..ae7f6aa 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -34,6 +34,8 @@ library
       Paths_walint
   hs-source-dirs:
       lib
+  default-extensions:
+      NoImplicitPrelude
   ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
   build-depends:
       HList
@@ -53,6 +55,7 @@ library
     , text
     , text-metrics
     , transformers
+    , universum
     , uri-encode
     , vector
     , witherable
@@ -65,6 +68,8 @@ executable walint
       Paths_walint
   hs-source-dirs:
       src
+  default-extensions:
+      NoImplicitPrelude
   ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
   build-depends:
       aeson
@@ -76,6 +81,7 @@ executable walint
     , process
     , template-haskell
     , text
+    , universum
     , walint
   default-language: Haskell2010
 
@@ -91,7 +97,7 @@ executable walint-server
       server
   default-extensions:
       NoImplicitPrelude
-  ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
+  ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors -rtsopts -threaded
   build-depends:
       aeson
     , async