cedartrunk-scotty.hs

{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Network.Wai (requestHeaders, pathInfo)
import Data.Text (intercalate, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Lazy (fromStrict)
import Network.Mime (defaultMimeLookup)
import Control.Applicative ((<$>))
import Control.Monad.Trans (liftIO)

main = scotty 3000 $ do
    get anything $ do
        referer <- getReferer 
        path <- getPath
        case referer of
            Nothing -> file "index.html"
            Just _  -> do
                header "Content-Type" (lookupMime path)
                file (unpack path)
    where 
        getReferer = lookup "Referer" <$> requestHeaders <$> request
        getPath = intercalate "/" <$> pathInfo <$> request
        lookupMime = fromStrict . decodeUtf8 . defaultMimeLookup

-- matches anything
anything = function . const . Just $ []