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

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

import           Control.Monad.Trans.Writer (WriterT (runWriterT))
import           Data.Aeson                 (ToJSON)
import           Data.Map                   (Map, fromList, toList)
import           Data.Maybe                 (mapMaybe)
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import qualified Data.Vector                as V
import           GHC.Generics               (Generic)

import           LintWriter                 (LintResult (..), LintWriter)
import           Properties                 (checkProperty)
import           Tiled2                     (Layer (layerName, layerProperties),
                                             Tiledmap (tiledmapLayers),
                                             loadTiledmap)
import           Types                      (Level (..), Lint (..), hint,
                                             lintLevel)
import           Util                       (PrettyPrint (prettyprint),
                                             prettyprint)


-- | What this linter produces: lints for a single map
data MapResult a = MapResult
  { mapresultLayer   :: Maybe (Map Text (LintResult a))
  , mapresultGeneral :: [Lint]
  } deriving (Generic, ToJSON)



-- | this module's raison d'être
loadAndLintMap :: FilePath -> IO (MapResult ())
loadAndLintMap path = loadTiledmap path >>= pure . \case
    Left err -> MapResult
      { mapresultLayer = Nothing
      , mapresultGeneral =
        [ hint Fatal . T.pack $
          path <> ": parse error (probably invalid json/not a tiled map): " <> err
        ]
      }
    Right waMap ->
      runLinter waMap

-- | lint a loaded map
runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
  { mapresultLayer = Just 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)

-- human-readable lint output, e.g. for consoles
instance PrettyPrint a => PrettyPrint (MapResult a) where
  prettyprint mapResult = T.concat $ prettyGeneral <> prettyLayer
    where
      -- TODO: this can be simplified further
      prettyLayer :: [Text]
      prettyLayer = mapMaybe
        (uncurry showResult)
        (maybe [] toList . mapresultLayer $ mapResult)
      prettyGeneral :: [Text]
      prettyGeneral = prettyprint <$> mapresultGeneral 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 PrettyPrint 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 :: Text -> LintResult a -> Maybe Text
showResult ctxt (LintResult res) = case res of
  Left hint        -> Just $ "Fatal: " <> prettyprint hint
  Right (_, [])    -> Nothing
  Right (_, hints) -> Just $ T.concat (mapMaybe showHint hints)
  where
    -- TODO: make the "log level" configurable
    showHint hint = case lintLevel hint of
      Info -> Nothing
      _    -> Just $ prettyprint hint <> ctxtHint
    ctxtHint = showContext ctxt