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

-- | Contains checks for custom properties of the map json
module Properties (checkProperty) where


import           Control.Monad             (unless)
import           Control.Monad.Trans.Class (lift)
import           Data.Aeson                as Aeson (Value (String))
import           Data.Map                  (Map, (!?))
import           Data.Text                 (Text)
import           Tiled2                    (Layer (layerProperties))
import           Util                      (prettyprint)

import           LintWriter                (Hint, LintWriter, Level(..), hint,
                                            assertWarn, complain, forbid, info,
                                            suggest, unwrapWarn, warn)

-- | values may be anything, and are not typechecked (for now),
-- since they may contain arbitrary json – our only guarantee
-- is that they are named, and therefore a map.
type Properties = Map Text Aeson.Value



-- | /technically/ the main function here
--
-- given a property, check if it is valid. It gets a reference
-- to its own layer since sometimes the presense of one property
-- implies the presence or absense of another.
--
-- The tests in here are meant to comply with the informal spec
-- at https://workadventu.re/map-building
--
-- In practice, the actual specification of what is allowed is
-- handled in checkProperty', since apparently all possible layerProperties
-- are strings anyways, so this just extracts that string and then
-- calls that.
checkProperty :: Layer -> Properties -> LintWriter ()
checkProperty layer prop = do
  tyObj <- lift $ getAttr prop "name"
  ty <- lift $ case tyObj of
    Aeson.String str -> Right str
    _                -> Left (hint Suggestion "wtf")
  checkProperty' layer prop ty

-- | The /real/ main  thing.
--
-- I've attempted to build the LintWriter monad in a way
-- that should make this readable even to non-Haskellers
checkProperty' :: Layer -> Properties -> Text -> LintWriter ()
checkProperty' layer prop ty = case ty of
    "jitsiRoom" -> do
      propEqual prop "type" "string"
      urlValue <- lift $ getAttr prop "value"
      info $ "found jitsi room: " <> prettyprint urlValue
      suggestPropertyValue "jitsiTrigger" "onaction"
    "jitsiTrigger" ->
      requireProperty "jitsiRoom"
    "jitsiUrl" -> isForbidden
    "jitsiConfig" -> isForbidden
    "jitsiClientConfig" -> isForbidden
    "jitsiRoomAdminTag" -> isForbidden
    "playAudio" -> do
      -- TODO: check for url validity?
      propEqual prop "type" "string"
    "audioLoop" ->
      requireProperty "playAudio"
    "audioVolume" ->
      requireProperty "playAudio"
    "openWebsite" ->
      suggestPropertyValue "openWebsiteTrigger" "onaction"
    "openWebsiteTrigger" ->
      requireProperty "openWebsite"
    "openWebsitePolicy" ->
      requireProperty "openWebsite"
    "exitUrl" -> pure ()
    "startLayer" -> pure ()
      -- could also make this a "hard error" (i.e. Left), but then it
      -- stops checking other properties as checkLayer short-circuits.
    _ -> warn $ "unknown property type " <> prettyprint ty
    where
      -- | require some property in this layer
      requireProperty name = unless (hasProperty name layer)
        $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint ty
      -- | This property is forbidden and should not be used
      isForbidden = forbid $ "property " <> prettyprint ty <> " should not be used"
      -- TODO: check if the property has the correct value
      suggestPropertyValue :: Text -> Text -> LintWriter ()
      suggestPropertyValue name value = unless (hasProperty name layer)
        $ suggest $ "set property " <> prettyprint name <> " to " <> prettyprint value




-- | does this layer have the given property?
hasProperty :: Text -> Layer -> Bool
hasProperty name = any
  (\prop -> prop !? "name" == Just (Aeson.String name))
  . layerProperties

-- | get an attribute from a map
getAttr :: Properties -> Text -> Either Hint Aeson.Value
getAttr props name = unwrapWarn msg $ props !? name
  where msg = "field " <> name <> "does not exist"

-- | lint goal: the property with the given name has given value
propEqual :: Properties -> Text -> Aeson.Value -> LintWriter ()
propEqual props name value = do
  value' <- lift $ getAttr props name
  assertWarn ("field "<>name<>" has unexpected value "<>prettyprint value'
              <>", should be "<>prettyprint value)
    $ value' == value