{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Monad.Trans.Maybe
import           Control.Monad.Writer
import qualified Data.Aeson                as Aeson
import           Data.Map                  (Map, (!?))
import           Data.Maybe                (isJust, mapMaybe)
import           Data.Set                  (Set, fromList)
import           Data.Text                 (Text)
import qualified Data.Text                 as T
import qualified Data.Text.IO              as T
import           Data.Vector               (Vector)
import qualified Data.Vector               as V

import           LintWriter                (LintWriter, LintResult, Hint(..), Level(..))
import           Properties                (checkProperty)
import           Tiled2
import           Util                      (showText)



checkLayer :: Layer -> LintWriter ()
checkLayer layer =
  mapM_ (checkProperty layer) (layerProperties layer)

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

-- | pretty-printer for a result of WriterMaybe (currently only for errors/hints)
showResult :: Show a => Text -> LintResult a -> Maybe Text
showResult ctxt (Left hint) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
showResult _ (Right (a, [])) = Nothing
showResult ctxt (Right (a, hints)) = Just $ showHints hints
  where
    showHints hints = T.concat (mapMaybe showHint hints)
    -- TODO: make the "log level" configurable
    showHint Hint { hintMsg, hintLevel } = case hintLevel of
      Info -> Nothing
      _    -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
    ctxtHint = showContext ctxt


main :: IO ()
main = do
  Right map <- loadTiledmap "example.json"
  -- LintWriter is a Writer transformer, so run it with runWriterT
  let lints = fmap (runWriterT . checkLayer) (tiledmapLayers map)

  -- well this is a bit awkward (but how to get layer names otherwise?)
  let lines = V.mapMaybe thing (tiledmapLayers map)
        where thing layer = (showResult (T.pack $ layerName layer)
                             . runWriterT . checkLayer) layer
  mapM_ T.putStr lines