{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

module M where

import Control.Concurrent.STM
import Control.Exception (bracket)
import Control.Lens (over, view)
import Control.Lens.TH (makeFields)
import Control.Monad.Base (MonadBase)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, local, runReaderT)
import Control.Monad.Trans.Control (MonadBaseControl)
import Creds
import GHC.Generics (Generic)
import HTTP (HTTPMetric (HTTPMetric))
import Katip qualified as K
import System.IO (stdout)
import System.Metrics qualified as EKG
import UnliftIO (MonadUnliftIO)
import Wallabag.Auth (Auth, Auth' (..))
import qualified Data.HashMap.Strict as HM

data S = S
  { _sTokenCache :: Auth,
    _sLogNamespace :: K.Namespace,
    _sLogEnv :: K.LogEnv,
    _sLogContext :: K.LogContexts,
    _sCreds :: Creds,
    _sWallabagMetrics :: HTTPMetric,
    _sOpenrouterMetrics :: HTTPMetric
  }
  deriving (Generic)

makeFields ''S

newtype M a = M (ReaderT S IO a)
  deriving
    ( Functor,
      Applicative,
      Monad,
      MonadReader S,
      MonadIO,
      MonadUnliftIO,
      MonadThrow,
      MonadCatch,
      MonadBaseControl IO,
      MonadBase IO
    )

runM :: S -> M a -> IO a
runM s (M m) = runReaderT m s

instance K.Katip M where
  getLogEnv = view logEnv
  localLogEnv = local . over logEnv

instance K.KatipContext M where
  getKatipContext = view logContext
  localKatipContext = local . over logContext
  getKatipNamespace = view logNamespace
  localKatipNamespace = local . over logNamespace

initialS :: K.Severity -> (S -> IO a) -> IO a
initialS severity f = do
  store <- EKG.newStore
  wbMetrics <-
    HTTPMetric
      <$> EKG.createDistribution "wallabag.requests" store
      <*> EKG.createCounter "wallabag.retries" store
      <*> EKG.createCounter "wallabag.failures" store
  orMetrics <-
    HTTPMetric
      <$> EKG.createDistribution "openrouter.requests" store
      <*> EKG.createCounter "openrouter.retries" store
      <*> EKG.createCounter "openrouter.failures" store
  c <- getCreds
  handleScribe <- K.mkHandleScribe K.ColorIfTerminal stdout (K.permitItem severity) K.V2
  let makeLogEnv = K.registerScribe "stdout" handleScribe K.defaultScribeSettings =<< K.initLogEnv "wallabag" "production"
  res <- bracket makeLogEnv K.closeScribes $ \le -> do
    cache <- newTVarIO Unauthenticated
    f (S cache "main" le mempty c wbMetrics orMetrics)
  -- TODO: This is just for debug purposes
  EKG.sampleAll store >>= mapM_ print . HM.toList
  pure res