CheckMap.hs

{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Module that contains the high-level checking functions
module CheckMap (loadAndLintMap, MapResult(..)) where

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           LintConfig       (LintConfig')
import           LintWriter       (LintResult, invertLintResult,
                                   resultToAdjusted, resultToBadges,
                                   resultToDeps, resultToLints, resultToOffers,
                                   runLintWriter)
import           Properties       (checkLayer, checkMap, checkTileset)
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)



-- | What this linter produces: lints for a single map
data MapResult = MapResult
  { mapresultLayer    :: Map Hint [Layer]
  -- ^ lints that occurred in one or more layers
  , mapresultTileset  :: Map Hint [Tileset]
  -- ^ lints that occurred in one or more tilesets
  , mapresultDepends  :: [Dep]
  -- ^ (external and local) dependencies of this map
  , mapresultProvides :: [Text]
  -- ^ entrypoints provided by this map (needed for dependency checking)
  , mapresultAdjusted :: 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)

instance ToJSON MapResult where
  toJSON res = A.object
    [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res)
    , "tileset" .= CollectedLints (fmap getName <$> mapresultTileset res)
    , "general" .= mapresultGeneral res
    ]

newtype CollectedLints = CollectedLints (Map Hint [Text])

instance ToJSON CollectedLints where
  toJSON (CollectedLints col) = toJSON
    . M.mapKeys hintMsg