linter: collect jitsi rooms of maps

4 files changed, 45 insertions, 32 deletions

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index aa4616a..258b6bb 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 87bad02..afcec65 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 faa6db0..18a0520 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 d737392..acba99d 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