remove leftover rc3 things & some new stuff

this removes:
 - the bbb properties
 - all explicit mentions of rc3
 - the weird script domain hacks (done via a substitution now)
 - some (few) of the weirder code choices

it also adds some more type level witchery to deal with configs, which
for some reason seems to be the hardest problem of this entire program …

also the server now does inter-assembly dependency checking!

1 files changed, 102 insertions, 61 deletions

diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index 11a8122..b0fa3b0 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -1,19 +1,21 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveAnyClass        #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE StandaloneDeriving    #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 -- | Module that deals with handling config options
-module LintConfig (LintConfig(..), LintConfig', patchConfig) where
+module LintConfig (LintConfig(..), LintConfig', ConfigKind (..), patchConfig,stuffConfig,feedConfig) where
 
 import           Universum
-import qualified Universum.Unsafe      as Unsafe
 
 import           Data.Aeson            (FromJSON (parseJSON), Options (..),
                                         defaultOptions, eitherDecode)
@@ -28,38 +30,51 @@ import           Uris                  (SchemaSet,
                                         Substitution (DomainSubstitution))
 import           WithCli.Pure          (Argument (argumentType, parseArgument))
 
-type family HKD f a where
-  HKD Identity a = a
-  HKD f a = f a
 
-data LintConfig f = LintConfig
-  { configScriptInject   :: HKD f (Maybe Text)
+
+data ConfigKind = Complete | Basic | Skeleton | Patch
+
+-- | a field that must be given in configs for both server & standalone linter
+type family ConfigField (f::ConfigKind) a where
+  ConfigField Patch a = Maybe a
+  ConfigField _ a = a
+
+-- | a field that must be given for the standalone linter, but not the server
+-- (usually because the server will infer them from its own config)
+type family StandaloneField (f :: ConfigKind) a where
+  StandaloneField Complete a = a
+  StandaloneField Skeleton a = a
+  StandaloneField _ a = Maybe a
+
+-- | a field specific to a single world / assembly
+type family WorldField (f :: ConfigKind) a where
+  WorldField Complete a = a
+  WorldField _ a = Maybe a
+
+data LintConfig (f :: ConfigKind) = LintConfig
+  { configScriptInject   :: ConfigField f (Maybe Text)
   -- ^ Link to Script that should be injected
-  , configAssemblyTag    :: HKD f Text
+  , configAssemblyTag    :: WorldField f Text
   -- ^ Assembly name (used for jitsiRoomAdminTag)
-  , configAssemblies     :: HKD f [Text]
+  , configAssemblies     :: StandaloneField f [Text]
   -- ^ list of all assembly slugs (used to lint e.g. world:// links)
-  , configMaxLintLevel   :: HKD f Level
+  , configEventSlug      :: StandaloneField f Text
+  -- ^ slug of this event (used e.g. to resolve world:// links)
+  , configMaxLintLevel   :: ConfigField f Level
   -- ^ Maximum warn level allowed before the lint fails
-  , configDontCopyAssets :: HKD f Bool
+  , configDontCopyAssets :: ConfigField f Bool
   -- ^ Don't copy map assets (mostly useful for development)
-  , configAllowScripts   :: HKD f Bool
+  , configAllowScripts   :: ConfigField f Bool
   -- ^ Allow defining custom scripts in maps
-  , configUriSchemas     :: HKD f SchemaSet
+  , configUriSchemas     :: ConfigField f SchemaSet
   } deriving (Generic)
 
-type LintConfig' = LintConfig Identity
+type LintConfig' = LintConfig Complete
 
--- TODO: should probably find a way to write these constraints nicer ...
-deriving instance
-  ( Show (HKD a (Maybe Text))
-  , Show (HKD a Text)
-  , Show (HKD a Level)
-  , Show (HKD a [Text])
-  , Show (HKD a Bool)
-  , Show (HKD a SchemaSet)
-  )
-  => Show (LintConfig a)
+deriving instance Show (LintConfig Complete)
+deriving instance Show (LintConfig Skeleton)
+deriving instance Show (LintConfig Patch)
+instance NFData (LintConfig Basic)
 
 aesonOptions :: Options
 aesonOptions = defaultOptions
@@ -68,23 +83,13 @@ aesonOptions = defaultOptions
   , fieldLabelModifier = drop 6
   }
 
-instance
-    ( FromJSON (HKD a (Maybe Text))
-    , FromJSON (HKD a [Text])
-    , FromJSON (HKD a Text)
-    , FromJSON (HKD a Level)
-    , FromJSON (HKD a Bool)
-    , FromJSON (HKD a SchemaSet)
-    )
-    => FromJSON (LintConfig a)
-  where
-    parseJSON = genericParseJSON aesonOptions
+instance FromJSON (LintConfig Complete) where
+  parseJSON = genericParseJSON aesonOptions
 
--- need to define this one extra, since Aeson will not make
--- Maybe fields optional if the type isn't given explicitly.
---
--- Whoever said instances had confusing semantics?
-instance {-# Overlapping #-} FromJSON (LintConfig Maybe) where
+instance FromJSON (LintConfig Patch) where
+  parseJSON = genericParseJSON aesonOptions
+
+instance FromJSON (LintConfig Basic) where
   parseJSON = genericParseJSON aesonOptions
 
 
@@ -118,30 +123,66 @@ instance GPatch i o
 -- abstract, I just wanted to play around with higher kinded types for
 -- a bit.
 patch ::
-  ( Generic (f Maybe)
-  , Generic (f Identity)
-  , GPatch (Rep (f Identity))
-    (Rep (f Maybe))
+  ( Generic (f Patch)
+  , Generic (f Complete)
+  , GPatch (Rep (f Complete))
+    (Rep (f Patch))
   )
-  => f Identity
-  -> f Maybe
-  -> f Identity
+  => f Complete
+  -> f Patch
+  -> f Complete
 patch x y = to (gappend (from x) (from y))
 
-patchConfig :: LintConfig Identity -> Maybe (LintConfig Maybe) -> LintConfig Identity
-patchConfig config p = config'
-  { configUriSchemas = ("world", assemblysubsts) : configUriSchemas config'}
-  where config' = case p of
-          Just p  -> patch config p
-          Nothing -> config
-        assemblysubsts =
-          DomainSubstitution (M.fromList generated) scope
-          where generated = (\slug -> (slug, "/@/rc3_21/"<>slug)) <$> configAssemblies config'
-        scope = (\(DomainSubstitution _ s) -> s)
-         . snd . Unsafe.head
-         . filter ((==) "world" . fst)
-         $ configUriSchemas config'
-
+patchConfig
+  :: LintConfig Complete
+  -> Maybe (LintConfig Patch)
+  -> LintConfig Complete
+patchConfig config p = expandWorlds config'
+  where
+    config' = case p of
+      Just p  -> patch config p
+      Nothing -> config
+
+
+-- | feed a basic server config
+feedConfig
+  :: LintConfig Basic
+  -> [Text]
+  -> Text
+  -> LintConfig Skeleton
+feedConfig LintConfig{..} worlds eventslug = expandWorlds $
+  LintConfig
+  { configAssemblies = worlds
+  , configEventSlug = eventslug
+  , .. }
+
+-- | stuff a
+stuffConfig :: LintConfig Skeleton -> Text -> LintConfig Complete
+stuffConfig LintConfig{..} assemblyslug =
+  LintConfig
+  { configAssemblyTag = assemblyslug
+  , ..}
+
+class HasWorldList (a :: ConfigKind)
+instance HasWorldList 'Complete
+instance HasWorldList 'Skeleton
+
+-- kinda sad that ghc can't solve these contraints automatically,
+-- though i guess it also makes sense …
+expandWorlds
+  :: ( ConfigField a SchemaSet ~ SchemaSet
+     , StandaloneField a [Text] ~ [Text]
+     , StandaloneField a Text ~ Text
+     , HasWorldList a)
+  => LintConfig a -> LintConfig a
+expandWorlds config = config { configUriSchemas = configUriSchemas' }
+  where
+    configUriSchemas' =
+      M.insert "world:" [assemblysubsts] (configUriSchemas config)
+    assemblysubsts =
+      DomainSubstitution (M.fromList generated) ["map"]
+      where generated = configAssemblies config
+              <&> \slug -> (slug, "/@/"<>configEventSlug config<>"/"<>slug)
 
 instance (FromJSON (LintConfig a)) => Argument (LintConfig a) where
   parseArgument str =