{-# 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