{-# 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                       (showText)

-- | 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)


-- 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 $ prettyGeneral <> prettyLayer
    where
      -- TODO: this can be simplified further
      prettyLayer :: [String]
      prettyLayer = mapMaybe
        (\(name, lints) -> T.unpack <$> showResult name lints)
        (maybe [] toList . mapresultLayer $ mapResult)
      prettyGeneral :: [String]
      prettyGeneral = show <$> 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 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