module Mensam.Server.Server.Route.Haddock where

import Mensam.API.Route.Static
import Mensam.Server.Application.Configured.Class
import Mensam.Server.Configuration
import Mensam.Server.Server.Err404
import Mensam.Server.Server.FileServer

import Control.Monad.IO.Unlift
import Control.Monad.Logger.CallStack
import Network.Wai.Application.Static
import Network.Wai.Trans
import Servant
import Servant.RawM.Server qualified as RawM

handler ::
  (MonadConfigured m, MonadLogger m, MonadUnliftIO m) =>
  ServerT API m
handler :: forall (m :: * -> *).
(MonadConfigured m, MonadLogger m, MonadUnliftIO m) =>
ServerT API m
handler = do
  Maybe FilePath
maybeDirectory <- Configuration -> Maybe FilePath
configDirectoryHaddock (Configuration -> Maybe FilePath)
-> m Configuration -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Configuration
forall (m :: * -> *). MonadConfigured m => m Configuration
configuration
  Application
fallbackApplication <- ApplicationT m -> m Application
forall (m :: * -> *).
MonadUnliftIO m =>
ApplicationT m -> m Application
runApplicationT ApplicationT m
forall (m :: * -> *).
(MonadConfigured m, MonadLogger m) =>
ApplicationT m
application404
  case Maybe FilePath
maybeDirectory of
    Maybe FilePath
Nothing -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn Text
"No haddock files configured. Serving fallback application."
      Application -> m Application
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
fallbackApplication
    Just FilePath
directory -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Serve haddock file download."
      StaticSettings
settings <- FilePath -> m StaticSettings
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
FilePath -> m StaticSettings
fileServerSettings FilePath
directory
      StaticSettings -> ServerT (RawM' Any) m
forall (m :: * -> *) serverType.
Applicative m =>
StaticSettings -> ServerT (RawM' serverType) m
RawM.serveDirectoryWith StaticSettings
settings {ss404Handler = Just fallbackApplication}