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

-- | Module that contains the high-level checking functions
module CheckMap where

import           Data.Maybe                 (mapMaybe)
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import qualified Data.Vector                as V

import           Control.Monad.Trans.Writer
import           Data.Aeson                 (ToJSON)
import           Data.Map                   (Map, fromList, toList)
import           GHC.Generics               (Generic)
import           LintWriter                 (Hint (..), Level (..),
                                             LintResult (..), LintWriter)
import           Properties                 (checkProperty)
import           Tiled2
import           Util                       (showText)

-- | What this linter produces
data MapResult a = MapResult
  { mapresultLayer   :: Map Text (LintResult a)
  , mapresultGeneral :: [Hint]
  } deriving (Generic, ToJSON)

-- | the main thing. runs the linter and everything
runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
  { mapresultLayer = layer
  , mapresultGeneral = [] -- no general lints for now
  }
  where
    layer :: Map Text (LintResult ())
    layer = fromList . V.toList . V.map runCheck $ tiledmapLayers tiledmap
      where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))

-- | collect lints on a single map layer
checkLayer :: Layer -> LintWriter ()
checkLayer layer =
  mapM_ (checkProperty layer) (layerProperties layer)


-- this instance of show produces a reasonably human-readable
-- list of lints that can be shown e.g. on a console
instance Show a => Show (MapResult a) where
  show mapResult = concat prettyLayer
    where
      prettyLayer :: [String]
      prettyLayer = mapMaybe
        (\(name, lints) -> T.unpack <$> showResult name lints)
        (toList . mapresultLayer $ mapResult)


-- TODO: possibly expand this to something more detailed?
showContext :: Text -> Text
showContext ctxt = " (in layer " <> ctxt <> ")\n"

-- | pretty-printer for a LintResult. Isn't an instance of Show since
-- it needs to know about the result's context (yes, there could be
-- a wrapper type for that – but I wasn't really in the mood)
showResult :: Show a => Text -> LintResult a -> Maybe Text
showResult ctxt (LintResult (Left hint)) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
showResult _ (LintResult (Right (_, []))) = Nothing
showResult ctxt (LintResult (Right (_, hints))) = Just $ T.concat (mapMaybe showHint hints)
  where
    -- TODO: make the "log level" configurable
    showHint Hint { hintMsg, hintLevel } = case hintLevel of
      Info -> Nothing
      _    -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
    ctxtHint = showContext ctxt