{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoFieldSelectors #-} module WikiMusic.SSR.Boot (boot) where import Network.Wai.Handler.Warp import Network.Wai.Logger (ApacheLogger, withStdoutLogger) import Principium import Prometheus qualified as P import Prometheus.Metric.GHC qualified as P import WikiMusic.SSR.Config import WikiMusic.SSR.Servant.ApiSetup boot :: (MonadIO m) => m () boot :: forall (m :: * -> *). MonadIO m => m () boot = IO () -> m () forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ (ApacheLogger -> IO ()) -> IO () forall a. (ApacheLogger -> IO a) -> IO a withStdoutLogger ((ApacheLogger -> IO ()) -> IO ()) -> (ApacheLogger -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \ApacheLogger logger' -> ( do GHCMetrics _ <- IO GHCMetrics -> IO GHCMetrics forall a. IO a -> IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO GHCMetrics -> IO GHCMetrics) -> IO GHCMetrics -> IO GHCMetrics forall a b. (a -> b) -> a -> b $ Metric GHCMetrics -> IO GHCMetrics forall (m :: * -> *) s. MonadIO m => Metric s -> m s P.register Metric GHCMetrics P.ghcMetrics [String] args <- IO [String] -> IO [String] forall a. IO a -> IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO [String] forall (m :: * -> *). MonadIO m => m [String] getArgs Either Text AppConfig maybeCfg <- Text -> IO (Either Text AppConfig) forall (m :: * -> *). MonadIO m => Text -> m (Either Text AppConfig) readConfig ([String] -> Text cfg [String] args) IO () -> IO () forall a. IO a -> IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ (Text -> IO ()) -> (AppConfig -> IO ()) -> Either Text AppConfig -> IO () forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either Text -> IO () forall {a} {a}. Show a => a -> a crashWithBadConfig (ApacheLogger -> AppConfig -> IO () forall (m :: * -> *). MonadIO m => ApacheLogger -> AppConfig -> m () startWikiMusicSSR ApacheLogger logger') Either Text AppConfig maybeCfg ) where crashWithBadConfig :: a -> a crashWithBadConfig a e = Text -> a forall a t. (HasCallStack, IsText t) => t -> a error (Text "Bad config could not be parsed! " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> a -> Text forall b a. (Show a, IsString b) => a -> b show a e) cfg :: [String] -> Text cfg [String] args = case [String] -> Maybe (NonEmpty String) forall a. [a] -> Maybe (NonEmpty a) nonEmpty [String] args of Just (String x :| []) -> String -> Text packText String x Maybe (NonEmpty String) _ -> Text "resources/config/run-local.toml" startWikiMusicSSR :: (MonadIO m) => ApacheLogger -> AppConfig -> m () startWikiMusicSSR :: forall (m :: * -> *). MonadIO m => ApacheLogger -> AppConfig -> m () startWikiMusicSSR ApacheLogger logger' AppConfig cfg = do IO () -> m () forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> IO () forall (m :: * -> *). MonadIO m => Text -> m () putTextLn (Text -> m ()) -> Text -> m () forall a b. (a -> b) -> a -> b $ Text "Starting WikiMusic SSR..." Application app <- IO Application -> m Application forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Application -> m Application) -> IO Application -> m Application forall a b. (a -> b) -> a -> b $ ApacheLogger -> AppConfig -> IO Application mkApp ApacheLogger logger' AppConfig cfg IO () -> m () forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ Settings -> Application -> IO () runSettings Settings apiSettings Application app where apiSettings :: Settings apiSettings = Port -> Settings -> Settings setPort (AppConfig cfg AppConfig -> Optic' A_Lens NoIx AppConfig Port -> Port forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx AppConfig AppConfig ServantConfig ServantConfig #servant Optic A_Lens NoIx AppConfig AppConfig ServantConfig ServantConfig -> Optic A_Lens NoIx ServantConfig ServantConfig Port Port -> Optic' A_Lens NoIx AppConfig Port forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx ServantConfig ServantConfig Port Port #port) Settings defaultSettings