{-# LANGUAGE OverloadedStrings #-} module Web.Simple.Static where import Control.Monad import Control.Monad.IO.Class import qualified Data.Text as T import Network.Wai import Network.HTTP.Types import Network.Mime import Web.Simple.Controller import System.Directory import System.FilePath serveStatic :: FilePath -> Controller a () serveStatic :: forall a. FilePath -> Controller a () serveStatic FilePath baseDir = do Request req <- forall s. Controller s Request request let fp :: FilePath fp = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl FilePath -> FilePath -> FilePath (</>) FilePath baseDir (forall a b. (a -> b) -> [a] -> [b] map Text -> FilePath T.unpack forall a b. (a -> b) -> a -> b $ Request -> [Text] pathInfo Request req) Bool exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool doesFileExist FilePath fp forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool exists forall a b. (a -> b) -> a -> b $ do forall s a. Response -> Controller s a respond forall a b. (a -> b) -> a -> b $ Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile Status status200 [(HeaderName hContentType, Text -> ByteString defaultMimeLookup forall a b. (a -> b) -> a -> b $ FilePath -> Text T.pack forall a b. (a -> b) -> a -> b $ FilePath -> FilePath takeFileName FilePath fp)] FilePath fp forall a. Maybe a Nothing forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (forall (t :: * -> *) a. Foldable t => t a -> Bool null forall a b. (a -> b) -> a -> b $ FilePath -> FilePath takeExtension FilePath fp) forall a b. (a -> b) -> a -> b $ do let fpIdx :: FilePath fpIdx = FilePath fp FilePath -> FilePath -> FilePath </> FilePath "index.html" Bool existsIdx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool doesFileExist FilePath fpIdx forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool existsIdx forall a b. (a -> b) -> a -> b $ do forall s a. Response -> Controller s a respond forall a b. (a -> b) -> a -> b $ Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile Status status200 [(HeaderName hContentType, ByteString "text/html")] FilePath fpIdx forall a. Maybe a Nothing