summaryrefslogtreecommitdiff
path: root/server/Server.hs
diff options
context:
space:
mode:
authorstuebinm2022-03-19 19:12:04 +0100
committerstuebinm2022-03-19 20:07:45 +0100
commitdbf2253dc4256809b255767cbf4ae9c236f18542 (patch)
treeae2eb6e09db7aeab76ef22171c43e679cfa2c86a /server/Server.hs
parent25111b467c91e411f1c7a4281c2eee5671db7406 (diff)
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!
Diffstat (limited to 'server/Server.hs')
-rw-r--r--server/Server.hs22
1 files changed, 14 insertions, 8 deletions
diff --git a/server/Server.hs b/server/Server.hs
index 779509d..da2e73d 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -47,7 +47,8 @@ import Data.Either.Extra (mapLeft)
import Data.Functor.Contravariant (contramap)
import qualified Data.Map.Strict as M
import Lens.Micro.Platform (at, ix, makeLenses, traverseOf)
-import LintConfig (LintConfig')
+import LintConfig (ConfigKind (..), LintConfig,
+ feedConfig)
import Servant (FromHttpApiData)
import Servant.Client (BaseUrl, parseBaseUrl)
import qualified Text.Show as TS
@@ -89,7 +90,7 @@ toSha ref = Sha1
data Org (loaded :: Bool) = Org
{ orgSlug :: Text
- , orgLintconfig :: ConfigRes loaded LintConfig'
+ , orgLintconfig :: ConfigRes loaded (LintConfig Skeleton)
, orgEntrypoint :: FilePath
, orgGeneration :: Int
, orgRepos :: [RemoteRef]
@@ -97,7 +98,8 @@ data Org (loaded :: Bool) = Org
, orgWebdir :: Text
} deriving (Generic)
-instance NFData LintConfig' => NFData (Org True)
+instance NFData (LintConfig Skeleton) => NFData (Org True)
+deriving instance Show (LintConfig Skeleton) => Show (Org True)
-- | Orgs are compared via their slugs only
-- TODO: the server should probably refuse to start if two orgs have the
@@ -176,11 +178,15 @@ loadConfig path = do
Left err -> error $ prettyTomlDecodeErrors err
where
loadOrg :: Org False -> IO (Org True)
- loadOrg org = do
- lintconfig <- eitherDecodeFileStrict' (orgLintconfig org) >>= \case
- Right c -> pure c
- Left err -> error $ show err
- pure $ org { orgLintconfig = lintconfig }
+ loadOrg org@Org{..} = do
+ lintconfig <-
+ eitherDecodeFileStrict' orgLintconfig >>= \case
+ Right (c :: LintConfig Basic) -> pure c
+ Left err -> error $ show err
+ let config = org { orgLintconfig =
+ feedConfig lintconfig (map reponame orgRepos) orgSlug }
+ print config
+ pure config
data RealtimeMsg = RelintPending | Reload
deriving (Generic, ToJSON)