{-# LANGUAGE ImportQualifiedPost #-}

-- Module     : Hsm.Core.App
-- Maintainer : contact@pauloliver.dev
module Hsm.Core.App
  ( launch
  )
where

import Control.Applicative ((<**>))
import Data.Aeson (FromJSON, Result (Error, Success), Value, fromJSON)
import Data.Aeson.Key (fromString)
import Data.Aeson.KeyMap (KeyMap, (!?))
import Data.Maybe (fromMaybe)
import Data.Text (pack, unpack)
import Data.Yaml (decodeFileThrow)
import Effectful.Log (LogLevel (LogInfo), Logger, readLogLevelEither, showLogLevel)
import Log.Backend.StandardOutput (withStdOutLogger)
import Options.Applicative qualified as P
import System.IO.Echo (withoutInputEcho)

data Options = Options String LogLevel

parser :: P.Parser Options
parser =
  Options
    <$> P.strOption
      ( P.help "Path to services config file"
          <> P.short 'c'
          <> P.long "config"
          <> P.metavar "PATH"
          <> P.value "config.yaml"
          <> P.showDefault
      )
    <*> P.option
      (P.eitherReader $ readLogLevelEither . pack)
      ( P.help "Log level"
          <> P.short 'l'
          <> P.long "log-level"
          <> P.metavar "LEVEL"
          <> P.value LogInfo
          <> P.showDefaultWith (unpack . showLogLevel)
      )

-- Bootstraps an application by reading its settings from a provided
-- configuration file. A configuration must exist in the config file for the name
-- provided. A logger object, log level and read-only configuration are passed
-- down to the provided application.
launch :: FromJSON e => String -> (Logger -> LogLevel -> e -> IO a) -> IO a
launch name app =
  P.execParser info >>= \(Options path level) ->
    returnEnv path >>= \env ->
      withoutInputEcho $ withStdOutLogger $ \logger -> app logger level env
 where
  title :: String
  title = "Launch " <> name <> " service"

  description :: P.InfoMod Options
  description = P.fullDesc <> P.progDesc title

  info :: P.ParserInfo Options
  info = P.info (parser <**> P.helper) description

  err :: String
  err = "Service configuration for " <> name <> " not found"

  load :: KeyMap Value -> Value
  load configs = fromMaybe (error err) $ configs !? fromString name

  check :: Result e -> e
  check (Success e) = e
  check (Error str) = error str

  returnEnv :: FromJSON e => String -> IO e
  returnEnv = fmap (check . fromJSON . load) . decodeFileThrow