module Development.Duplo.Server where import Control.Monad.Trans (liftIO) import Data.List (intercalate) import Data.Text (Text) import Data.Text.Lazy (Text) import Network.HTTP.Types (status200) import Network.Wai (pathInfo) import Network.Wai.Handler.Warp (Port) import System.Directory (doesFileExist) import System.Environment (getArgs) import System.FilePath.Posix (takeExtension) import Web.Scotty import qualified Data.Text as T import qualified Data.Text.Lazy as LT serve :: Port -> IO () serve port = do putStrLn $ "\n>> Starting server on port " ++ show port scotty port serve' serve' :: ScottyM () serve' = -- Always match because we're checking for files, not routes notFound $ do path <- fmap (intercalate "/" . fmap T.unpack . pathInfo) request -- Setting root let path' = "public/" ++ path exists <- liftIO $ doesFileExist path' status status200 if exists then normalFile path' else returnDefault path' normalFile :: FilePath -> ActionM () normalFile path = do let contentType = guessType path file path setHeader "Content-Type" $ LT.pack contentType -- | Return a default file depending on file type. Return the default HTML -- file otherwise. returnDefault :: FilePath -> ActionM () returnDefault path = do let extension = takeExtension path file $ case extension of ".css" -> "public/index.css" ".js" -> "public/index.js" _ -> "public/index.html" setHeader "Content-Type" $ case extension of ".css" -> "text/css" ".js" -> "text/javascript" _ -> "text/html" -- | "Guess" the content type from the path's file type guessType :: String -> String guessType path = case takeExtension path of ".htm" -> "text/html" ".html" -> "text/html" ".css" -> "text/css" ".js" -> "application/x-javascript" ".png" -> "image/png" ".jpeg" -> "image/jpeg" ".jpg" -> "image/jpeg" ".woff" -> "application/font-woff" ".ttf" -> "application/font-ttf" ".eot" -> "application/vnd.ms-fontobject" ".otf" -> "application/font-otf" ".svg" -> "image/svg+xml" otherwise -> "application/octet-stream"