diff options
Diffstat (limited to '')
| -rw-r--r-- | app/Main.hs | 41 |
1 files changed, 27 insertions, 14 deletions
diff --git a/app/Main.hs b/app/Main.hs index ec4b5e7..204e4d7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,34 +1,47 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | The main module. Does little more than handle some basic ocnfic, then -- call the server module Main where - +import Conferer (fetch) +import Conferer.Config (addSource, emptyConfig) +import qualified Conferer.Source.Aeson as ConfAeson +import qualified Conferer.Source.CLIArgs as ConfCLI +import qualified Conferer.Source.Env as ConfEnv +import qualified Conferer.Source.Yaml as ConfYaml +import Control.Monad.Extra (ifM) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Logger (runStderrLoggingT) import Data.Default.Class (def) -import Database.Persist.Postgresql -import Network.Wai.Handler.Warp (run) +import Database.Persist.Postgresql (withPostgresqlPool) +import Network.Wai.Handler.Warp (runSettings) import Network.Wai.Middleware.RequestLogger (OutputFormat (..), RequestLoggerSettings (..), mkRequestLogger) -import System.Environment (getArgs) -import Data.Functor ((<&>)) -import Data.ByteString.Internal (packChars) - -import GTFS -import Server +import System.Directory (doesFileExist) +import Config (ServerConfig (..)) +import GTFS (loadGtfs) +import Server (application) main :: IO () main = do - connStr <- getArgs <&> \case {[str] -> packChars str; _ -> ""} + confconfig <- pure emptyConfig + >>= addSource ConfCLI.fromConfig + -- for some reason the yaml source fails if the file does not exist, but json works fine + >>= (\c -> ifM (doesFileExist "./config.yaml") + (addSource (ConfYaml.fromFilePath "./config.yaml") c) + (pure c)) + >>= addSource (ConfAeson.fromFilePath "./config.json") + >>= addSource (ConfEnv.fromConfig "tracktrain") + + ServerConfig{..} <- fetch confconfig - gtfs <- loadGtfs "./gtfs.zip" + gtfs <- loadGtfs serverConfigGtfs serverConfigZoneinfoPath loggerMiddleware <- mkRequestLogger $ def { outputFormat = Detailed True } - runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do + runStderrLoggingT $ withPostgresqlPool serverConfigDbString 10 $ \pool -> liftIO $ do app <- application gtfs pool putStrLn "starting server …" - run 4000 (loggerMiddleware app) + runSettings serverConfigWarp (loggerMiddleware app) |