module Network.Wai.Middleware.ContentType
( module X
, fileExtsToMiddleware
, lookupResponse
, possibleFileExts
) where
import Network.Wai.Middleware.ContentType.Types as X hiding (tell)
import Network.Wai.Middleware.ContentType.Blaze as X
import Network.Wai.Middleware.ContentType.Builder as X
import Network.Wai.Middleware.ContentType.ByteString as X
import Network.Wai.Middleware.ContentType.Cassius as X
import Network.Wai.Middleware.ContentType.Clay as X
import Network.Wai.Middleware.ContentType.Json as X
import Network.Wai.Middleware.ContentType.Julius as X
import Network.Wai.Middleware.ContentType.Lucid as X
import Network.Wai.Middleware.ContentType.Lucius as X
import Network.Wai.Middleware.ContentType.Text as X
import Network.Wai.Trans
import Network.HTTP.Types (HeaderName)
import Network.HTTP.Media (mapAccept)
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Data.List (intersect, nub)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Monoid
import Control.Monad.Trans
type AcceptHeader = BS.ByteString
fileExtsToMiddleware :: MonadIO m =>
FileExtListenerT (MiddlewareT m) m ()
-> MiddlewareT m
fileExtsToMiddleware contentRoutes app req respond = do
let mAcceptBS = Prelude.lookup ("Accept" :: HeaderName) $ requestHeaders req
fe = getFileExt req
mMiddleware <- lookupResponse mAcceptBS fe contentRoutes
fromMaybe (app req respond) $ do
m <- mMiddleware
return $ m app req respond
lookupResponse :: Monad m =>
Maybe AcceptHeader
-> FileExt
-> FileExtListenerT a m ()
-> m (Maybe a)
lookupResponse mAcceptBS f fexts = do
femap <- execFileExtListenerT fexts
return $ lookupFileExt mAcceptBS f femap
where
lookupFileExt mAccept k (FileExts xs) =
let attempts = maybe [Html,Text,Json,JavaScript,Css]
(possibleFileExts k) mAccept
in getFirst $ foldMap (\f' -> First $ Map.lookup f' xs) attempts
possibleFileExts :: FileExt -> AcceptHeader -> [FileExt]
possibleFileExts fe accept =
let computed = sortFE fe $ nub $ concat $
catMaybes [ mapAccept [ ("application/json" :: BS.ByteString, [Json])
, ("application/javascript" :: BS.ByteString, [Json,JavaScript])
] accept
, mapAccept [ ("text/html" :: BS.ByteString, [Html])
] accept
, mapAccept [ ("text/plain" :: BS.ByteString, [Text])
] accept
, mapAccept [ ("text/css" :: BS.ByteString, [Css])
] accept
]
wildcard = concat $
catMaybes [ mapAccept [ ("*/*" :: BS.ByteString, [Html,Text,Json,JavaScript,Css])
] accept
]
in if not (null wildcard) then wildcard else computed
where
sortFE Html xs = [Html, Text] `intersect` xs
sortFE JavaScript xs = [JavaScript, Text] `intersect` xs
sortFE Json xs = [Json, JavaScript, Text] `intersect` xs
sortFE Css xs = [Css, Text] `intersect` xs
sortFE Text xs = [Text] `intersect` xs