{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Com.MusicMeetsComics.Server.Config where

import           Com.MusicMeetsComics.Server.Logger
import           Control.Concurrent             ( ThreadId )
import           Control.Monad.Except           ( ExceptT
                                                , MonadError
                                                )
import           Control.Monad.IO.Class
import           Control.Monad.Logger           ( MonadLogger(..) )
import           Control.Monad.Metrics          ( Metrics
                                                , MonadMetrics
                                                , getMetrics
                                                )
import qualified Control.Monad.Metrics         as M
import           Control.Monad.Reader           ( MonadIO
                                                , MonadReader
                                                , ReaderT
                                                , asks
                                                )
import           Data.Text                      ( pack )
import           GHC.Base                       ( String )
import           Network.Wai                    ( Middleware )
import           Network.Wai.Handler.Warp       ( Port )
import           Network.Wai.Middleware.RequestLogger
                                                ( logStdout
                                                , logStdoutDev
                                                )
import           Protolude
import           Safe                           ( readMay )
import           Servant                        ( ServerError )
import           System.Environment             ( lookupEnv )
import           System.Remote.Monitoring       ( forkServer
                                                , serverMetricStore
                                                , serverThreadId
                                                )

-- | This type represents the effects we want to have for our application.
-- We wrap the standard Servant monad with 'ReaderT Config', which gives us
-- access to the application configuration using the 'MonadReader'
-- interface's 'ask' function.
--
-- By encapsulating the effects in our newtype, we can add layers to the
-- monad stack without having to modify code that uses the current layout.
newtype AppT m a = AppT
  { runApp :: ReaderT Config (ExceptT ServerError m) a
  }
  deriving (Functor, Applicative, Monad, MonadReader Config, MonadError
    ServerError, MonadIO)

type App = AppT IO

-- | The Config for our application is (for now) the 'Environment' we're
-- running in and a Persistent 'ConnectionPool'.
data Config = Config
  { configEnv :: Environment
  , configMetrics :: Metrics
  , configEkgServer :: ThreadId
  , configLogEnv :: LogEnv
  , configPort :: Port
  , configClient :: FilePath
  }

instance Monad m => MonadMetrics (AppT m) where
  getMetrics = asks configMetrics

-- | Katip instance for @AppT m@
instance MonadIO m => Katip (AppT m) where
  getLogEnv   = asks configLogEnv
  localLogEnv = panic "not implemented"

-- | MonadLogger instance to use within @AppT m@
instance MonadIO m => MonadLogger (AppT m) where
  monadLoggerLog = adapt logMsg

-- | MonadLogger instance to use in @makePool@
instance MonadIO m => MonadLogger (KatipT m) where
  monadLoggerLog = adapt logMsg

-- | Right now, we're distinguishing between three environments. We could
-- also add a @Staging@ environment if we needed to.
data Environment
  = Development
  | Test
  | Production
  deriving (Eq, Show, Read)

-- | This returns a 'Middleware' based on the environment that we're in.
setLogger :: Environment -> Middleware
setLogger Test        = identity
setLogger Development = logStdoutDev
setLogger Production  = logStdout

-- | Web request logger (currently unimplemented and unused). For inspiration
-- see ApacheLogger from wai-logger package.
katipLogger :: LogEnv -> Middleware
katipLogger env app req respond = runKatipT env $ do
  logMsg "web" InfoS "todo: received some request"
  -- todo: log proper request data
  liftIO $ app req respond

-- | The number of pools to use for a given environment.
envPool :: Environment -> Int
envPool Test        = 1
envPool Development = 1
envPool Production  = 8

-- | Allocates resources for 'Config'
acquire :: IO Config
acquire = do
  port      <- lookupSetting "PORT" 3001
  clientDir <- lookupSetting "CLIENT_DIR"
                             "_bild/Com.MusicMeetsComics.Client/static"
  env       <- lookupSetting "ENV" Development
  logEnv    <- defaultLogEnv
  ekgServer <- forkServer "localhost" 8000
  let store = serverMetricStore ekgServer
  metr <- M.initializeWith store
  pure Config { configEnv       = env
              , configMetrics   = metr
              , configLogEnv    = logEnv
              , configPort      = port
              , configEkgServer = serverThreadId ekgServer
              , configClient    = clientDir
              }

-- | Looks up a setting in the environment, with a provided default, and
-- 'read's that information into the inferred type.
lookupSetting :: Read a => String -> a -> IO a
lookupSetting env def_ = do
  maybeValue <- lookupEnv env
  case maybeValue of
    Nothing  -> return def_
    Just str -> maybe (handleFailedRead str) return (readMay str)
 where
  handleFailedRead str = panic $ mconcat
    ["Failed to read [[", pack str, "]] for environment variable ", pack env]