diff options
author | stuebinm | 2022-03-23 02:35:58 +0100 |
---|---|---|
committer | stuebinm | 2022-03-23 02:35:58 +0100 |
commit | ac96dea6cb2972cd421b8d1c0fa15a6a47546e8d (patch) | |
tree | 6cff17db2af5c1aa506c2794c2332bd420eccdd8 /server/Server.hs | |
parent | 8c02351376984147a3a630e1889e4d0095056aa6 (diff) |
server: add a "panic i'm on a train"-offline mode
(this also adds general cli arguments, but the main point is that
downloading monstrously large repositories is a silly idea when i'm on a
train with surprisingly bad wifi)
Diffstat (limited to '')
-rw-r--r-- | server/Server.hs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/server/Server.hs b/server/Server.hs index 3d783d7..3081997 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -24,6 +24,8 @@ module Server ( loadConfig , Org(..) , Sha1, toSha , Config, tmpdir, port, verbose, orgs, interval, exneuland, token + , CliOptions(..) + , OfflineException , RemoteRef(..) , ServerState, emptyState, unState , JobStatus(..) @@ -57,6 +59,7 @@ import Toml (BiMap (BiMap), TomlBiMap, TomlCodec, prettyTomlDecodeErrors, (.=)) import qualified Toml as T +import WithCli (HasArguments) -- | a reference in a remote git repository data RemoteRef = RemoteRef @@ -134,6 +137,13 @@ data Config (loaded :: Bool) = Config makeLenses ''Config +data CliOptions = CliOptions + { offline :: Bool + , config :: Maybe FilePath + } deriving (Show, Generic, HasArguments) + +data OfflineException = OfflineException + deriving (Show, Exception) remoteCodec :: TomlCodec RemoteRef remoteCodec = RemoteRef @@ -157,6 +167,7 @@ urlBimap = BiMap (Right . show) (mapLeft (ArbitraryError . show) . parseBaseUrl) + configCodec :: TomlCodec (Config False) configCodec = Config <$> T.string "tmpdir" .= _tmpdir @@ -171,7 +182,7 @@ configCodec = Config -- | loads a config, along with all things linked in it -- (e.g. linterconfigs for each org) loadConfig :: FilePath -> IO (Config True) -loadConfig path = do +loadConfig path = do res <- T.decodeFileEither configCodec path case res of Right config -> traverseOf orgs (mapM loadOrg) config @@ -183,10 +194,8 @@ loadConfig path = do eitherDecodeFileStrict' orgLintconfig >>= \case Right (c :: LintConfig Basic) -> pure c Left err -> error $ show err - let config = org { orgLintconfig = + pure $ org { orgLintconfig = feedConfig lintconfig (map reponame orgRepos) orgSlug } - print config - pure config data RealtimeMsg = RelintPending | Reload deriving (Generic, ToJSON) |