{-# 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                 (Hint (..), Level (..),
                                             LintResult (..), LintWriter, hint)
import           Properties                 (checkProperty)
import           Tiled2                     (Layer (layerName, layerProperties),
                                             Tiledmap (tiledmapLayers),
                                             loadTiledmap)
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 :: [Hint]
  } 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 $ "ERROR: " <> hintMsg hint <> showContext ctxt
  Right (_, []) -> Nothing
  Right (_, hints) -> Just $ T.concat (mapMaybe showHint hints)
  where
    -- TODO: make the "log level" configurable
    showHint hint = case hintLevel hint of
      Info -> Nothing
      _    -> Just $ prettyprint hint <> ctxtHint
    ctxtHint = showContext ctxt