diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index aa4616a950e8c543877af02fe523d28424c09075..258b6bbe7d609635f6c78efbaf3b49c8a1ba41a0 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -33,7 +33,7 @@ import LintConfig (LintConfig (..), LintConfig')
import LintWriter (LintResult, invertLintResult,
resultToAdjusted, resultToBadges,
resultToDeps, resultToLints, resultToOffers,
- runLintWriter, resultToCWs)
+ runLintWriter, resultToCWs, resultToJitsis)
import Properties (checkLayer, checkMap, checkTileset)
import System.FilePath (takeFileName)
import Types (Dep (MapLink),
@@ -64,6 +64,8 @@ data MapResult (kind :: ResultKind) = MapResult
-- ^ badges that can be found on this map
, mapresultCWs :: [Text]
-- ^ collected CWs that apply to this map
+ , mapresultJitsis :: [Text]
+ -- ^ all jitsi room slugs mentioned in this map
, mapresultGeneral :: [Hint]
-- ^ general-purpose lints that didn't fit anywhere else
} deriving (Generic)
@@ -105,7 +107,7 @@ shrinkMapResult !res = res { mapresultAdjusted = () }
-- layers upwards in the file hierarchy
loadAndLintMap :: LintConfig' -> FilePath -> Int -> IO (Maybe (MapResult Full))
loadAndLintMap config path depth = loadTiledmap path <&> \case
- Left err -> Just (MapResult mempty mempty mempty mempty Nothing mempty mempty
+ Left err -> Just (MapResult mempty mempty mempty mempty Nothing mempty mempty mempty
[ Hint Fatal . toText $
path <> ": Fatal: " <> err
])
@@ -127,6 +129,8 @@ runLinter isMain config@LintConfig{..} tiledmap depth = MapResult
, mapresultProvides = concatMap resultToOffers layer
, mapresultAdjusted = Just adjustedMap
, mapresultCWs = resultToCWs generalResult
+ , mapresultJitsis = concatMap resultToJitsis tileset
+ <> concatMap resultToJitsis layer
, mapresultBadges = concatMap resultToBadges layer
<> resultToBadges generalResult
}
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 87bad02cc61e59cf172559a07670a296ea00f395..afcec6545de07c46393e358ac06be76e8abd5bdc 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -40,7 +40,7 @@ module LintWriter
, lintConfig
-- * adjust the linter's context
, adjust
- ,offersCWs,resultToCWs) where
+ ,offersCWs,resultToCWs,offersJitsi,resultToJitsis) where
import Universum
@@ -126,6 +126,9 @@ resultToCWs :: LintResult a -> [Text]
resultToCWs (LinterState a) = fold $ mapMaybe lintToCW $ fst a
where lintToCW = \case (CW cw) -> Just cw; _ -> Nothing
+resultToJitsis :: LintResult a -> [Text]
+resultToJitsis (LinterState a) = mapMaybe lintToJitsi $ fst a
+ where lintToJitsi = \case (Jitsi room) -> Just room; _ -> Nothing
-- | convert a lint result into a flat list of lints
resultToLints :: LintResult a -> [Lint]
@@ -160,6 +163,9 @@ offersBadge badge = tell' $ Badge badge
offersCWs :: [Text] -> LintWriter a
offersCWs = tell' . CW
+offersJitsi :: Text -> LintWriter a
+offersJitsi = tell' . Jitsi
+
-- | get the context as it was initially, without any modifications
askContext :: LintWriter' a a
diff --git a/lib/Properties.hs b/lib/Properties.hs
index faa6db033b3b91f90098991e3afe7bb7f0dd0ffe..18a05200279b9931f4913795eca23ab682c3e61e 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -38,7 +38,7 @@ import LintConfig (LintConfig (..))
import LintWriter (LintWriter, adjust, askContext,
askFileDepth, complain, dependsOn, forbid,
lintConfig, offersBadge, offersEntrypoint,
- suggest, warn, zoom, offersCWs)
+ suggest, warn, zoom, offersCWs, offersJitsi)
import Paths (PathResult (..), RelPath (..),
getExtension, isOldStyle, parsePath)
import Types (Dep (Link, Local, LocalMap, MapLink))
@@ -363,9 +363,12 @@ checkTileThing removeExits p@(Property name _value) = case name of
suggestProperty $ Property "jitsiTrigger" "onaction"
-- prevents namespace clashes for jitsi room names
- unless ("shared" `isPrefixOf` jitsiRoom) $ do
+ if "shared" `isPrefixOf` jitsiRoom then do
assemblyname <- lintConfig configAssemblyTag
setProperty "jitsiRoom" (assemblyname <> "-" <> jitsiRoom)
+ offersJitsi (assemblyname <> "-" <> jitsiRoom)
+ else
+ offersJitsi jitsiRoom
"jitsiTrigger" -> do
isString p
unlessHasProperty "jitsiTriggerMessage"
diff --git a/lib/Types.hs b/lib/Types.hs
index d7373921ebaf22f95bc81d6199a721c95e8d0acd..acba99d92e688a5663012dbde12d2d9dbc8f2e53 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -54,8 +54,8 @@ instance HasArguments Level where
-- | a hint comes with an explanation (and a level), or is a dependency
-- (in which case it'll be otherwise treated as an info hint)
-data Lint = Depends Dep | Offers Text | Lint Hint | Badge Badge | CW [Text]
- deriving (Ord, Eq, Generic, ToJSONKey)
+data Lint = Depends Dep | Offers Text | Lint Hint | Badge Badge | CW [Text] | Jitsi Text
+ deriving (Ord, Eq, Generic)
data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
deriving (Generic, Ord, Eq, NFData)
@@ -78,35 +78,35 @@ lintLevel _ = Info
lintsToHints :: [Lint] -> [Hint]
lintsToHints = mapMaybe (\case {Lint hint -> Just hint ; _ -> Nothing})
-instance PrettyPrint Lint where
- prettyprint (Lint Hint { hintMsg, hintLevel } ) =
- " " <> show hintLevel <> ": " <> hintMsg
- prettyprint (Depends dep) =
- " Info: found dependency: " <> prettyprint dep
- prettyprint (Offers dep) =
- " Info: map offers entrypoint " <> prettyprint dep
- prettyprint (Badge _) =
- " Info: found a badge."
- prettyprint (CW cws) =
- " CWs: " <> show cws
+-- instance PrettyPrint Lint where
+-- prettyprint (Lint Hint { hintMsg, hintLevel } ) =
+-- " " <> show hintLevel <> ": " <> hintMsg
+-- prettyprint (Depends dep) =
+-- " Info: found dependency: " <> prettyprint dep
+-- prettyprint (Offers dep) =
+-- " Info: map offers entrypoint " <> prettyprint dep
+-- prettyprint (Badge _) =
+-- " Info: found a badge."
+-- prettyprint (CW cws) =
+-- " CWs: " <> show cws
instance PrettyPrint Hint where
prettyprint (Hint level msg) = " " <> show level <> ": " <> msg
-instance ToJSON Lint where
- toJSON (Lint h) = toJSON h
- toJSON (Depends dep) = A.object
- [ "msg" .= prettyprint dep
- , "level" .= A.String "Dependency Info" ]
- toJSON (Offers l) = A.object
- [ "msg" .= prettyprint l
- , "level" .= A.String "Entrypoint Info" ]
- toJSON (Badge _) = A.object
- [ "msg" .= A.String "found a badge"
- , "level" .= A.String "Badge Info"]
- toJSON (CW cws) = A.object
- [ "msg" .= A.String "Content Warning"
- , "level" .= A.String "CW Info" ]
+-- instance ToJSON Lint where
+-- toJSON (Lint h) = toJSON h
+-- toJSON (Depends dep) = A.object
+-- [ "msg" .= prettyprint dep
+-- , "level" .= A.String "Dependency Info" ]
+-- toJSON (Offers l) = A.object
+-- [ "msg" .= prettyprint l
+-- , "level" .= A.String "Entrypoint Info" ]
+-- toJSON (Badge _) = A.object
+-- [ "msg" .= A.String "found a badge"
+-- , "level" .= A.String "Badge Info"]
+-- toJSON (CW cws) = A.object
+-- [ "msg" .= A.String "Content Warning"
+-- , "level" .= A.String "CW Info" ]
instance ToJSON Hint where
toJSON (Hint l m) = A.object