{-# LANGUAGE OverloadedStrings #-} module Web.Spock.Internal.Util where import Data.Maybe import Network.HTTP.Types import Network.Wai.Internal import qualified Data.Text as T import qualified Data.HashMap.Strict as HM data ClientPreferredFormat = PrefJSON | PrefXML | PrefHTML | PrefText | PrefUnknown deriving (Show, Eq) mimeMapping :: HM.HashMap T.Text ClientPreferredFormat mimeMapping = HM.fromList [ ("application/json", PrefJSON) , ("text/javascript", PrefJSON) , ("text/json", PrefJSON) , ("application/javascript", PrefJSON) , ("application/xml", PrefXML) , ("text/xml", PrefXML) , ("text/plain", PrefText) , ("text/html", PrefHTML) , ("application/xhtml+xml", PrefHTML) ] detectPreferredFormat :: T.Text -> ClientPreferredFormat detectPreferredFormat t = let (mimeTypeStr, _) = T.breakOn ";" t mimeTypes = map (T.toLower . T.strip) $ T.splitOn "," mimeTypeStr firstMatch [] = PrefUnknown firstMatch (x:xs) = fromMaybe (firstMatch xs) (HM.lookup x mimeMapping) in firstMatch mimeTypes mapReqHeaders :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response mapReqHeaders f resp = case resp of (ResponseFile s h b1 b2) -> ResponseFile s (f h) b1 b2 (ResponseBuilder s h b) -> ResponseBuilder s (f h) b (ResponseStream s h b) -> ResponseStream s (f h) b (ResponseRaw x r) -> ResponseRaw x (mapReqHeaders f r)