{- |
Copyright: 2006, Bjorn Bringert
Copyright: 2009, Henning Thielemann

This is an extension of ServerContext,
which is used privately in the Server.
In addition to ServerContext it holds the module list,
which is not accessible by modules.
-}
module Network.MoHWS.Server.Environment where

import qualified Network.MoHWS.Server.Context as ServerContext
import qualified Network.MoHWS.Server.Options as Options
import qualified Network.MoHWS.Server.Request as ServerRequest
import qualified Network.MoHWS.Configuration as Config
import qualified Network.MoHWS.Module as Module
import qualified Network.MoHWS.Logger.Access as AccessLogger
import qualified Network.MoHWS.Logger.Error as ErrorLogger
import qualified Network.MoHWS.HTTP.MimeType as MimeType
import qualified Network.MoHWS.HTTP.Response as Response

import Control.Monad (foldM, msum, )
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT, )
import Network.BSD (HostEntry, )
import Network.Socket (PortNumber, )
import System.Time (TimeDiff, )


data T body ext = Cons
   {
      T body ext -> T ext
context :: ServerContext.T ext,
      T body ext -> PortNumber
port :: PortNumber,
      T body ext -> [T body]
modules :: [Module.T body]
   }

-- * Read accessors

options :: T body ext -> Options.T
options :: T body ext -> T
options = T ext -> T
forall ext. T ext -> T
ServerContext.options (T ext -> T) -> (T body ext -> T ext) -> T body ext -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context

config :: T body ext -> Config.T ext
config :: T body ext -> T ext
config = T ext -> T ext
forall ext. T ext -> T ext
ServerContext.config (T ext -> T ext) -> (T body ext -> T ext) -> T body ext -> T ext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context

hostName :: T body ext -> HostEntry
hostName :: T body ext -> HostEntry
hostName = T ext -> HostEntry
forall ext. T ext -> HostEntry
ServerContext.hostName (T ext -> HostEntry)
-> (T body ext -> T ext) -> T body ext -> HostEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context

mimeTypes :: T body ext -> MimeType.Dictionary
mimeTypes :: T body ext -> Dictionary
mimeTypes = T ext -> Dictionary
forall ext. T ext -> Dictionary
ServerContext.mimeTypes (T ext -> Dictionary)
-> (T body ext -> T ext) -> T body ext -> Dictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context

errorLogger :: T body ext -> ErrorLogger.Handle
errorLogger :: T body ext -> Handle
errorLogger = T ext -> Handle
forall ext. T ext -> Handle
ServerContext.errorLogger (T ext -> Handle) -> (T body ext -> T ext) -> T body ext -> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context

accessLoggers :: T body ext -> [AccessLogger.Handle]
accessLoggers :: T body ext -> [Handle]
accessLoggers = T ext -> [Handle]
forall ext. T ext -> [Handle]
ServerContext.accessLoggers (T ext -> [Handle])
-> (T body ext -> T ext) -> T body ext -> [Handle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context


-- * Loggers

instance ErrorLogger.HasHandle (T body ext) where
   getHandle :: T body ext -> Handle
getHandle = T body ext -> Handle
forall body ext. T body ext -> Handle
errorLogger

logAccess :: T body ext -> ServerRequest.T body -> Response.T body -> TimeDiff -> IO ()
logAccess :: T body ext -> T body -> T body -> TimeDiff -> IO ()
logAccess = T ext -> T body -> T body -> TimeDiff -> IO ()
forall ext body. T ext -> T body -> T body -> TimeDiff -> IO ()
ServerContext.logAccess (T ext -> T body -> T body -> TimeDiff -> IO ())
-> (T body ext -> T ext)
-> T body ext
-> T body
-> T body
-> TimeDiff
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T body ext -> T ext
forall body ext. T body ext -> T ext
context



-- * Modules

mapModules_ :: T body ext -> (Module.T body -> IO ()) -> IO ()
mapModules_ :: T body ext -> (T body -> IO ()) -> IO ()
mapModules_ T body ext
st T body -> IO ()
f = (T body -> IO ()) -> [T body] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ T body -> IO ()
f (T body ext -> [T body]
forall body ext. T body ext -> [T body]
modules T body ext
st)

foldModules :: T body ext -> (Module.T body -> a -> IO a) -> a -> IO a
foldModules :: T body ext -> (T body -> a -> IO a) -> a -> IO a
foldModules T body ext
st T body -> a -> IO a
f a
x = (a -> T body -> IO a) -> a -> [T body] -> IO a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((T body -> a -> IO a) -> a -> T body -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip T body -> a -> IO a
f) a
x (T body ext -> [T body]
forall body ext. T body ext -> [T body]
modules T body ext
st)

tryModules :: T body ext -> (Module.T body -> MaybeT IO a) -> IO (Maybe a)
tryModules :: T body ext -> (T body -> MaybeT IO a) -> IO (Maybe a)
tryModules T body ext
st T body -> MaybeT IO a
f = MaybeT IO a -> IO (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO a -> IO (Maybe a)) -> MaybeT IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ [MaybeT IO a] -> MaybeT IO a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO a] -> MaybeT IO a) -> [MaybeT IO a] -> MaybeT IO a
forall a b. (a -> b) -> a -> b
$ (T body -> MaybeT IO a) -> [T body] -> [MaybeT IO a]
forall a b. (a -> b) -> [a] -> [b]
map T body -> MaybeT IO a
f ([T body] -> [MaybeT IO a]) -> [T body] -> [MaybeT IO a]
forall a b. (a -> b) -> a -> b
$ T body ext -> [T body]
forall body ext. T body ext -> [T body]
modules T body ext
st