feed-translator 0.1.0.1 → 0.1.0.2

raw patch · 4 files changed

+37/−8 lines, 4 filesdep +bytestringdep +cryptohash

Dependencies added: bytestring, cryptohash

Files

• feed-translator.cabal +3/−1
• src/Main.hs +4/−1
• src/Web/Feed/FeedTranslator.hs +5/−1
• src/Web/Feed/FeedTranslatorWai.hs +25/−5

@@ -1,5 +1,5 @@ name:                feed-translator-version:             0.1.0.1+version:             0.1.0.2 synopsis:            Translate syndication feeds homepage:            https://github.com/dahlia/feed-translator bug-reports:         https://github.com/dahlia/feed-translator/issues@@ -21,8 +21,10 @@   build-depends:       base             >=4.7      && <4.8,                        blaze-html       >=0.8.0.0  && <0.9.0.0,                        blaze-markup     >=0.7      && <0.8,+                       bytestring       >=0.10.0.0 && <0.11.0.0,                        cmdargs          >=0.10     && <0.11,                        containers,+                       cryptohash       >=0.11.0   && <0.12.0,                        feed             >=0.3.10.0 && <0.4.0.0,                        iso639,                        lens             >=4.5,

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}+import Data.IORef (newIORef) import Data.String (fromString) +import qualified Data.Map.Strict as M import Network.Wai.Handler.Warp ( HostPreference, Port                                 , defaultSettings, runSettings                                 , setHost, setPort, setTimeout@@ -26,7 +28,8 @@                        , timeout = 30 &= typ "SECONDS"                                       &= help "timeout in seconds [30]"                        } &= summary "Translate syndication feeds"-    app <- application+    cacheMapRef <- newIORef M.empty+    app <- application cacheMapRef     let settings = setHost (fromString $ host args) $                    setPort (port args) $                    setTimeout (timeout args) defaultSettings

@@ -1,4 +1,8 @@-module Web.Feed.FeedTranslator (Translator(..), translateFeed) where+module Web.Feed.FeedTranslator ( TextTranslator+                               , Translator(..)+                               , UrlTranslator+                               , translateFeed+                               ) where  import Control.Monad (liftM) import Data.Text (Text, pack, unpack)

@@ -2,12 +2,14 @@ module Web.Feed.FeedTranslatorWai (application) where  import Data.Maybe (catMaybes, listToMaybe)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import Control.Monad (liftM) import Control.Monad.IO.Class (liftIO)  import Control.Lens.Getter ((^.))+import Data.ByteString (ByteString) import Data.LanguageCodes (ISO639_1, fromChars)-import qualified Data.Map as M+import Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.Lazy as LT import Data.Text.Encoding (decodeUtf8)@@ -25,6 +27,7 @@                    regex, request, scottyApp, setHeader)  import Web.Feed.FeedTranslator (Translator(..), translateFeed)+import Web.Feed.FeedTranslatorCache (CacheMap, wrapTranslate) import Web.Feed.FeedTranslatorView (index)  -- | Return the Naver Translate engine that translates text from the@@ -65,9 +68,11 @@             Nothing -> next         _ -> next +type CacheKey = (ISO639_1, ISO639_1)+ -- | WAI web application.-application :: IO Application-application = scottyApp $ do+application :: IORef (M.Map CacheKey (IORef CacheMap)) -> IO Application+application cacheMapRef = scottyApp $ do     get "/" $         html $ renderHtml index     get "/query/" $ do@@ -87,10 +92,25 @@         scheme <- liftM LT.toStrict $ param "3"         path <- liftM LT.toStrict $ param "4"         query <- liftM (decodeUtf8 . rawQueryString) request+        let cacheKey :: CacheKey+            cacheKey = (source, target)+        cacheMap <- liftIO $ readIORef cacheMapRef+        cacheRef <- liftIO $ case M.lookup cacheKey cacheMap of+            Just ref -> return ref+            Nothing -> do+                ref <- newIORef M.empty+                atomicModifyIORef' cacheMapRef $ \cacheMap ->+                    (M.insert cacheKey ref cacheMap, ref)         let url :: String             url = T.unpack $ T.concat [scheme, "://", path, query]-        let translator = naverTranslator source target-        feed <- liftIO $ translateFeedUrl translator url+            translator :: Translator+            translator = naverTranslator source target+            cachedTranslator :: Translator+            cachedTranslator = translator {+                textTranslator = wrapTranslate cacheRef+                                               (textTranslator translator)+            }+        feed <- liftIO $ translateFeedUrl cachedTranslator url         let feedXml = LT.pack $ showElement $ xmlFeed feed         setHeader "Content-Type" "text/xml; charset=utf8"         raw $ LTE.encodeUtf8 feedXml