44 lines
1.3 KiB
Haskell
44 lines
1.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Data.List as List
|
|
import qualified Data.Text as T
|
|
import Network.Wai
|
|
import Network.Wai.Middleware.Static
|
|
import Network.HTTP.Types (status404)
|
|
import Network.Wai.Handler.Warp (run)
|
|
import System.Environment (lookupEnv)
|
|
import Text.Read (readMaybe)
|
|
|
|
indexHTML :: T.Text -> Middleware
|
|
indexHTML indexFile app req respond =
|
|
let path = pathInfo req
|
|
in flip app respond $ req { pathInfo = fixPath path }
|
|
where
|
|
fixPath path = case path of
|
|
[] -> [indexFile]
|
|
[""] -> [indexFile]
|
|
[x] -> if "." `T.isInfixOf` x then [x] else [x, indexFile]
|
|
(x:xs) -> x : fixPath xs
|
|
|
|
notFoundHandler notFoundFile _ respond = respond $
|
|
responseFile status404 [("Content-Type", "text/html")] notFoundFile Nothing
|
|
|
|
main = do
|
|
mPort <- lookupEnv "PORT"
|
|
let port = fromMaybe 3000 (readMaybe =<< mPort)
|
|
mNotFoundFile <- lookupEnv "NF_FILE"
|
|
let notFoundFile = fromMaybe "404.html" mNotFoundFile
|
|
mIndexFile <- lookupEnv "IDX_FILE"
|
|
let indexFile = T.pack $ fromMaybe "index.html" mIndexFile
|
|
|
|
cache <- initCaching PublicStaticCaching
|
|
putStrLn $ "Starting server on port: " <> show port
|
|
run port
|
|
$ indexHTML indexFile
|
|
$ staticPolicy' cache (predicate noDot)
|
|
$ notFoundHandler notFoundFile
|
|
where
|
|
noDot = not . List.isPrefixOf "."
|