wai-accept-language (empty) → 0.1.0.0
raw patch · 5 files changed
+166/−0 lines, 5 filesdep +basedep +bytestringdep +file-embedsetup-changed
Dependencies added: base, bytestring, file-embed, http-types, text, wai, wai-accept-language, wai-app-static, wai-extra, warp, word8
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +39/−0
- src/Network/Wai/Middleware/Multilingual.hs +44/−0
- wai-accept-language.cabal +51/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Takamasa Mitsuji (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.String (fromString)+import System.Environment (getArgs)+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai as Wai+import qualified Network.Wai.Application.Static as Static+import Data.Maybe (fromJust)+import Data.FileEmbed (embedDir)+import WaiAppStatic.Types (toPieces)+import Network.Wai.Middleware.Multilingual(rewriteByAcceptLanguage)++++main :: IO ()+main = do+ host:port:_ <- getArgs+ Warp.runSettings (+ Warp.setHost (fromString host) $+ Warp.setPort (read port) $+ Warp.defaultSettings+ ) $ (rewriteByAcceptLanguage [+ ([],["en","ja"])+ ,(["index.htm"],["en","ja"])+ ,(["sub","sub.htm"],["en","ja"])+ ]) $ staticHttpApp++++staticHttpApp :: Wai.Application+staticHttpApp = Static.staticApp $ settings { Static.ssIndices = indices }+ where+ settings = Static.embeddedSettings $(embedDir "static") -- embed contents as ByteString+ indices = fromJust $ toPieces ["index.htm"] -- default content++
+ src/Network/Wai/Middleware/Multilingual.hs view
@@ -0,0 +1,44 @@+module Network.Wai.Middleware.Multilingual+ ( contentLanguage, rewriteByAcceptLanguage+ ) where++++import qualified Network.Wai as Wai+import Network.HTTP.Types.Header(hAcceptLanguage)+import Network.Wai.Middleware.Rewrite(rewritePure)+import Network.Wai.Parse(parseHttpAccept)+import Data.Text.Encoding(decodeLatin1)+import Data.Maybe(fromMaybe)+import Data.List(find)+import qualified Data.Text as T+import qualified Data.ByteString as BS+import Data.Word8(_hyphen)++++-- | rewrite based on content:language list and Accept-Language header +rewriteByAcceptLanguage :: [([T.Text],[BS.ByteString])] -> Wai.Middleware+rewriteByAcceptLanguage preparedContents = rewritePure trans+ where+ trans path headers =+ let path' = do+ preparedLanguages <- lookup path preparedContents+ acceptLanguageHeaderValue <- lookup hAcceptLanguage headers+ language <- contentLanguage preparedLanguages acceptLanguageHeaderValue+ return $ decodeLatin1 language : path+ in fromMaybe path path'++++-- | determine language based on language list and Accept-Language header +contentLanguage :: [BS.ByteString] -> BS.ByteString -> Maybe BS.ByteString+contentLanguage preparedLanguages acceptLanguageHeaderValue = + let+ acceptLanguages = parseHttpAccept acceptLanguageHeaderValue+ acceptLanguages' = map takeWhileNotHyphen acceptLanguages+ in find (\al -> elem al preparedLanguages) acceptLanguages'+ where+ takeWhileNotHyphen = BS.takeWhile (_hyphen /=)++
+ wai-accept-language.cabal view
@@ -0,0 +1,51 @@+name: wai-accept-language+version: 0.1.0.0+synopsis: Rewrite based on Accept-Language header+description: Please see README.md+homepage: https://github.com/mitsuji/wai-accept-language+license: BSD3+license-file: LICENSE+author: Takamasa Mitsuji+maintainer: tkms@mitsuji.org+--copyright: 2010 Author Here+category: Web+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.Wai.Middleware.Multilingual + build-depends: base >= 4.7 && < 5+ , text+ , bytestring+ , word8+ , http-types+ , wai+ , wai-extra+ default-language: Haskell2010++executable wai-accept-language-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , wai-accept-language+ , wai+ , wai-app-static+ , file-embed+ , warp+ default-language: Haskell2010++--test-suite wai-accept-language-test+-- type: exitcode-stdio-1.0+-- hs-source-dirs: test+-- main-is: Spec.hs+-- build-depends: base+-- , wai-accept-language+-- ghc-options: -threaded -rtsopts -with-rtsopts=-N+-- default-language: Haskell2010+--+source-repository head+ type: git+ location: https://github.com/mitsuji/wai-accept-language.git