{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.SSR.Boot (boot) where

import Control.Monad
import Data.ByteString.Lazy qualified as BL
import Data.Text (pack)
import Network.Wai.Handler.Warp
import Optics
import Relude
import WikiMusic.SSR.Config
import WikiMusic.SSR.Model.Config
import WikiMusic.SSR.Servant.ApiSetup

boot :: (MonadIO m) => m ()
boot :: forall (m :: * -> *). MonadIO m => m ()
boot = do
  [String]
args <- IO [String] -> m [String]
forall a. IO a -> m 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 -> m (Either Text AppConfig)
forall (m :: * -> *).
MonadIO m =>
Text -> m (Either Text AppConfig)
readConfig ([String] -> Text
cfg [String]
args)
  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
$ (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 AppConfig -> IO ()
forall (m :: * -> *). MonadIO m => AppConfig -> m ()
startWikiMusicSSR 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
pack String
x
      Maybe (NonEmpty String)
_ -> Text
"resources/config/run-local.toml"

startWikiMusicSSR :: (MonadIO m) => AppConfig -> m ()
startWikiMusicSSR :: forall (m :: * -> *). MonadIO m => AppConfig -> m ()
startWikiMusicSSR AppConfig
cfg = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BL.putStr (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString
"Starting WikiMusic SSR ..."
  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 -> IO ()) -> IO Application -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AppConfig -> IO Application
mkApp AppConfig
cfg
  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