{- |
Copyright: 2002, Simon Marlow.
Copyright: 2006, Bjorn Bringert.
Copyright: 2009, Henning Thielemann.

Show @index.html@ or another configured file
whenever the URI path is a directory.
However, this module gets only active
if the directory path is terminated with a slash.
Without a slash the relative paths will not be processed correct by the web clients
(they will consider relative paths as relative to the superdirectory).
See also "Network.MoHWS.Part.AddSlash".
-}
module Network.MoHWS.Part.Index (Configuration, desc, ) where

import qualified Network.MoHWS.Module as Module
import qualified Network.MoHWS.Module.Description as ModuleDesc
import qualified Network.MoHWS.Server.Request as ServerRequest
import qualified Network.MoHWS.Server.Context as ServerContext
import Network.MoHWS.Logger.Error (debug, )

import qualified Network.MoHWS.Configuration as Config
import qualified Network.MoHWS.Configuration.Accessor as ConfigA
import qualified Network.MoHWS.Configuration.Parser as ConfigParser
import qualified Data.Accessor.Basic as Accessor
import Data.Accessor.Basic ((.>))

import Network.MoHWS.Utility (statFile, hasTrailingSlash, )
import Data.Maybe (fromMaybe, )
import Control.Monad.Trans.Maybe (runMaybeT, )
import Control.Monad.Trans.Class (lift, )
import Control.Monad (guard, )

import qualified System.FilePath as FilePath
import System.Posix (isDirectory, )



desc :: ModuleDesc.T body Configuration
desc :: T body Configuration
desc =
   T Any Any
forall body ext. T body ext
ModuleDesc.empty {
      name :: String
ModuleDesc.name = String
"index",
      load :: T Configuration -> IO (T body)
ModuleDesc.load = T body -> IO (T body)
forall (m :: * -> *) a. Monad m => a -> m a
return (T body -> IO (T body))
-> (T Configuration -> T body) -> T Configuration -> IO (T body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Configuration -> T body
forall body. T Configuration -> T body
funs,
      configParser :: T () Configuration
ModuleDesc.configParser = T () Configuration
forall st. T st Configuration
parser,
      setDefltConfig :: Configuration -> Configuration
ModuleDesc.setDefltConfig = Configuration -> Configuration -> Configuration
forall a b. a -> b -> a
const Configuration
defltConfig
   }

data Configuration =
   Configuration {
      Configuration -> String
index_ :: String
   }

defltConfig :: Configuration
defltConfig :: Configuration
defltConfig =
   Configuration :: String -> Configuration
Configuration {
      index_ :: String
index_ = String
"index.html"
   }

index :: Accessor.T Configuration String
index :: T Configuration String
index =
   (String -> Configuration -> Configuration)
-> (Configuration -> String) -> T Configuration String
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\String
x Configuration
c -> Configuration
c{index_ :: String
index_ = String
x}) Configuration -> String
index_

parser :: ConfigParser.T st Configuration
parser :: T st Configuration
parser =
   String -> T st Configuration -> T st Configuration
forall st ext. String -> T st ext -> T st ext
ConfigParser.field String
"directoryindex" T st Configuration
forall st. T st Configuration
p_index

p_index :: ConfigParser.T st Configuration
p_index :: T st Configuration
p_index =
   T (T Configuration) String
-> GenParser Char st String -> T st Configuration
forall r a st.
T r a -> GenParser Char st a -> GenParser Char st (r -> r)
ConfigParser.set (T (T Configuration) Configuration
forall ext. T (T ext) ext
ConfigA.extension T (T Configuration) Configuration
-> T Configuration String -> T (T Configuration) String
forall a b c. T a b -> T b c -> T a c
.> T Configuration String
index) (GenParser Char st String -> T st Configuration)
-> GenParser Char st String -> T st Configuration
forall a b. (a -> b) -> a -> b
$ GenParser Char st String
forall st. GenParser Char st String
ConfigParser.stringLiteral

funs :: ServerContext.T Configuration -> Module.T body
funs :: T Configuration -> T body
funs T Configuration
st =
   T body
forall body. T body
Module.empty {
      tweakRequest :: T body -> IO (T body)
Module.tweakRequest = T Configuration -> T body -> IO (T body)
forall body. T Configuration -> T body -> IO (T body)
tweakRequest T Configuration
st
   }

tweakRequest :: ServerContext.T Configuration -> ServerRequest.T body -> IO (ServerRequest.T body)
tweakRequest :: T Configuration -> T body -> IO (T body)
tweakRequest = (T Configuration -> String -> IO String)
-> T Configuration -> T body -> IO (T body)
forall server body.
(server -> String -> IO String) -> server -> T body -> IO (T body)
Module.tweakFilename T Configuration -> String -> IO String
fixPath

fixPath :: ServerContext.T Configuration -> FilePath -> IO FilePath
fixPath :: T Configuration -> String -> IO String
fixPath T Configuration
st String
filename =
  let conf :: T Configuration
conf = T Configuration -> T Configuration
forall ext. T ext -> T ext
ServerContext.config T Configuration
st
  in  (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
filename) (IO (Maybe String) -> IO String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$
      MaybeT IO String -> IO (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO String -> IO (Maybe String))
-> MaybeT IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
      do Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Bool
hasTrailingSlash String
filename)
         FileStatus
stat <- String -> MaybeT IO FileStatus
statFile String
filename
         Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FileStatus -> Bool
isDirectory FileStatus
stat)
         let indexFilename :: String
indexFilename = String -> String -> String
FilePath.combine String
filename (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Configuration -> String
index_ (Configuration -> String) -> Configuration -> String
forall a b. (a -> b) -> a -> b
$ T Configuration -> Configuration
forall ext. T ext -> ext
Config.extension T Configuration
conf
         IO () -> MaybeT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ T Configuration -> String -> IO ()
forall h (io :: * -> *).
(HasHandle h, MonadIO io) =>
h -> String -> io ()
debug T Configuration
st (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"indexFilename = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
indexFilename
         FileStatus
_ <- String -> MaybeT IO FileStatus
statFile String
indexFilename -- check whether file exists
         String -> MaybeT IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
indexFilename