{-# 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 :: FilePath -> Controller a () serveStatic baseDir :: FilePath baseDir = do Request req <- Controller a Request forall s. Controller s Request request let fp :: FilePath fp = (FilePath -> FilePath -> FilePath) -> FilePath -> [FilePath] -> FilePath forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl FilePath -> FilePath -> FilePath (</>) FilePath baseDir ((Text -> FilePath) -> [Text] -> [FilePath] forall a b. (a -> b) -> [a] -> [b] map Text -> FilePath T.unpack ([Text] -> [FilePath]) -> [Text] -> [FilePath] forall a b. (a -> b) -> a -> b $ Request -> [Text] pathInfo Request req) Bool exists <- IO Bool -> ControllerT a IO Bool forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Bool -> ControllerT a IO Bool) -> IO Bool -> ControllerT a IO Bool forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool doesFileExist FilePath fp Bool -> Controller a () -> Controller a () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool exists (Controller a () -> Controller a ()) -> Controller a () -> Controller a () forall a b. (a -> b) -> a -> b $ do Response -> Controller a () forall s a. Response -> Controller s a respond (Response -> Controller a ()) -> Response -> Controller a () forall a b. (a -> b) -> a -> b $ Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile Status status200 [(HeaderName hContentType, Text -> MimeType defaultMimeLookup (Text -> MimeType) -> Text -> MimeType forall a b. (a -> b) -> a -> b $ FilePath -> Text T.pack (FilePath -> Text) -> FilePath -> Text forall a b. (a -> b) -> a -> b $ FilePath -> FilePath takeFileName FilePath fp)] FilePath fp Maybe FilePart forall a. Maybe a Nothing Bool -> Controller a () -> Controller a () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (FilePath -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (FilePath -> Bool) -> FilePath -> Bool forall a b. (a -> b) -> a -> b $ FilePath -> FilePath takeExtension FilePath fp) (Controller a () -> Controller a ()) -> Controller a () -> Controller a () forall a b. (a -> b) -> a -> b $ do let fpIdx :: FilePath fpIdx = FilePath fp FilePath -> FilePath -> FilePath </> "index.html" Bool existsIdx <- IO Bool -> ControllerT a IO Bool forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Bool -> ControllerT a IO Bool) -> IO Bool -> ControllerT a IO Bool forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool doesFileExist FilePath fpIdx Bool -> Controller a () -> Controller a () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when Bool existsIdx (Controller a () -> Controller a ()) -> Controller a () -> Controller a () forall a b. (a -> b) -> a -> b $ do Response -> Controller a () forall s a. Response -> Controller s a respond (Response -> Controller a ()) -> Response -> Controller a () forall a b. (a -> b) -> a -> b $ Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response responseFile Status status200 [(HeaderName hContentType, "text/html")] FilePath fpIdx Maybe FilePart forall a. Maybe a Nothing