wai-middleware-content-type 0.4.1 → 0.5.0
raw patch · 4 files changed
+43/−41 lines, 4 filesdep +wai-middleware-content-type
Dependencies added: wai-middleware-content-type
Files
- src/Network/Wai/Middleware/ContentType.hs +4/−1
- src/Network/Wai/Middleware/ContentType/Types.hs +33/−22
- test/Network/Wai/Middleware/ContentTypeSpec.hs +2/−2
- wai-middleware-content-type.cabal +4/−16
src/Network/Wai/Middleware/ContentType.hs view
@@ -49,6 +49,8 @@ import Data.Monoid import Control.Monad ++ -- | Given an HTTP @Accept@ header and a content type to base lookups off of, and -- a map of responses, find a response. lookupFileExt :: Maybe AcceptHeader@@ -59,13 +61,14 @@ getFirst . foldMap (\fe -> First $ runResponseVia <$> HM.lookup fe m) . findFE- $ maybe allFileExts possibleFileExts mAcceptBS+ $ maybe (HM.keys m) possibleFileExts mAcceptBS where findFE :: [FileExt] -> [FileExt] findFE xs = case mFe of Nothing -> xs Just fe -> fe <$ guard (fe `elem` xs)+ fileExtsToMiddleware :: Monad m => FileExtListenerT m a -> MiddlewareT m fileExtsToMiddleware xs app req respond = do
src/Network/Wai/Middleware/ContentType/Types.hs view
@@ -85,6 +85,7 @@ | Json | Text | Markdown+ | Other T.Text -- ^ incliding prefix period, i.e. `.foo` deriving (Show, Eq, Ord, Generic) instance Hashable FileExt@@ -99,27 +100,31 @@ getFileExt :: [T.Text] -> Maybe FileExt getFileExt chunks = case chunks of [] -> Nothing- xs -> toExt . snd . T.breakOn "." $ last xs+ xs -> toExt . T.breakOnEnd "." $ last xs {-# INLINEABLE getFileExt #-} -- | matches a file extension (__including__ it's prefix dot - @.html@ for example) -- to a known one.-toExt :: T.Text -> Maybe FileExt-toExt x | x `elem` htmls = Just Html- | x `elem` csss = Just Css- | x `elem` javascripts = Just JavaScript- | x `elem` jsons = Just Json- | x `elem` texts = Just Text- | x `elem` markdowns = Just Markdown- | otherwise = Nothing+toExt :: (T.Text, T.Text) -> Maybe FileExt+toExt (y,x)+ | x == ""+ || T.length y == 0+ || T.last y /= '.' = Nothing+ | x `elem` htmls = Just Html+ | x `elem` csss = Just Css+ | x `elem` javascripts = Just JavaScript+ | x `elem` jsons = Just Json+ | x `elem` texts = Just Text+ | x `elem` markdowns = Just Markdown+ | otherwise = Just $ Other x where- htmls = [".htm", ".html"]- csss = [".css"]- javascripts = [".js", ".javascript"]- jsons = [".json"]- texts = [".txt"]- markdowns = [".md", ".markdown"]+ htmls = ["htm", "html"]+ csss = ["css"]+ javascripts = ["js", "javascript"]+ jsons = ["json"]+ texts = ["txt"]+ markdowns = ["md", "markdown"] {-# INLINEABLE toExt #-} @@ -127,7 +132,7 @@ -- ayy, lamo. Basically. data ResponseVia = forall a. ResponseVia { responseData :: !a- , responseStatus :: !Status+ , responseStatus :: {-# UNPACK #-} !Status , responseHeaders :: !ResponseHeaders , responseFunction :: !(a -> Status -> ResponseHeaders -> Response) }@@ -215,16 +220,22 @@ where computed :: [FileExt] computed = concat $- catMaybes [ mapAccept [ ("application/json" :: BS.ByteString, [Json])- , ("application/javascript" :: BS.ByteString, [JavaScript,Json])+ catMaybes [ mapAccept [ ( "application/json" :: BS.ByteString+ , [Json])+ , ( "application/javascript" :: BS.ByteString+ , [JavaScript,Json]) ] accept- , mapAccept [ ("text/html" :: BS.ByteString, [Html])+ , mapAccept [ ( "text/html" :: BS.ByteString+ , [Html]) ] accept- , mapAccept [ ("text/plain" :: BS.ByteString, [Text, Markdown])+ , mapAccept [ ( "text/plain" :: BS.ByteString+ , [Text, Markdown]) ] accept- , mapAccept [ ("text/markdown" :: BS.ByteString, [Markdown])+ , mapAccept [ ( "text/markdown" :: BS.ByteString+ , [Markdown]) ] accept- , mapAccept [ ("text/css" :: BS.ByteString, [Css])+ , mapAccept [ ( "text/css" :: BS.ByteString+ , [Css]) ] accept ]
test/Network/Wai/Middleware/ContentTypeSpec.hs view
@@ -162,8 +162,8 @@ fileExtsToMiddleware allExamples $ (\req respond -> respond (textOnly "Something went wrong" status406 [])) -allExamples :: FileExtListenerT Response IO ()-allExamples = mapResponse (\f -> f status200 []) $ do+allExamples :: FileExtListenerT IO ()+allExamples = do text "Text!" json ("Json!" :: T.Text) lucid (L.toHtmlRaw ("Html!" :: T.Text))
wai-middleware-content-type.cabal view
@@ -1,5 +1,5 @@ Name: wai-middleware-content-type-Version: 0.4.1+Version: 0.5.0 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: BSD3@@ -61,24 +61,12 @@ Test-Suite test Type: exitcode-stdio-1.0 Default-Language: Haskell2010- HS-Source-Dirs: src- , test+ HS-Source-Dirs: test GHC-Options: -Wall -threaded Main-Is: Spec.hs- Other-Modules: Network.Wai.Middleware.ContentType- Network.Wai.Middleware.ContentType.Types- Network.Wai.Middleware.ContentType.Blaze- Network.Wai.Middleware.ContentType.ByteString- Network.Wai.Middleware.ContentType.Cassius- Network.Wai.Middleware.ContentType.Clay- Network.Wai.Middleware.ContentType.Json- Network.Wai.Middleware.ContentType.Julius- Network.Wai.Middleware.ContentType.Lucid- Network.Wai.Middleware.ContentType.Lucius- Network.Wai.Middleware.ContentType.Pandoc- Network.Wai.Middleware.ContentType.Text- Network.Wai.Middleware.ContentTypeSpec+ Other-Modules: Network.Wai.Middleware.ContentTypeSpec Build-Depends: base >= 4.8 && < 5+ , wai-middleware-content-type , aeson , blaze-builder , blaze-html