yam-redis 0.6.0 → 0.6.1
raw patch · 2 files changed
+44/−36 lines, 2 filesdep +bytestringdep +textdep ~hedisdep ~salakdep ~yamPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bytestring, text
Dependency ranges changed: hedis, salak, yam
API changes (from Hackage documentation)
- Yam.Redis: RedisConfig :: String -> Word16 -> RedisConfig
- Yam.Redis: [$sel:maxConnections:RedisConfig] :: RedisConfig -> Word16
- Yam.Redis: [$sel:url:RedisConfig] :: RedisConfig -> String
- Yam.Redis: data RedisConfig
- Yam.Redis: instance Data.Default.Class.Default Yam.Redis.RedisConfig
- Yam.Redis: instance GHC.Classes.Eq Yam.Redis.RedisConfig
- Yam.Redis: instance GHC.Show.Show Yam.Redis.RedisConfig
- Yam.Redis: instance Salak.Prop.FromProp Yam.Redis.RedisConfig
- Yam.Redis: instance Yam.Redis.HasRedis cxt => Database.Redis.Core.RedisCtx (Yam.App.AppT cxt Database.Redis.Core.Redis) (Data.Either.Either Database.Redis.Protocol.Reply)
- Yam.Redis: instance Yam.Redis.HasRedis cxt => Database.Redis.Core.RedisCtx (Yam.App.AppT cxt Database.Redis.Transactions.RedisTx) Database.Redis.Transactions.Queued
+ Yam.Redis: instance Data.Default.Class.Default Database.Redis.Core.ConnectInfo
+ Yam.Redis: instance Salak.Prop.FromProp Database.Redis.Core.ConnectInfo
+ Yam.Redis: instance Salak.Prop.FromProp Database.Redis.ProtocolPipelining.PortID
+ Yam.Redis: multiE :: RedisTx (Queued a) -> Redis (Either Reply a)
- Yam.Redis: redisMiddleware :: RedisConfig -> AppMiddleware a (REDIS : a)
+ Yam.Redis: redisMiddleware :: RunSalak (AppMiddleware a (REDIS : a))
- Yam.Redis: runR :: (MonadIO m, HasRedis cxt) => AppT cxt Redis (Either Reply a) -> AppT cxt m a
+ Yam.Redis: runR :: (MonadIO m, HasRedis cxt) => Redis (Either Reply a) -> AppT cxt m a
Files
- src/Yam/Redis.hs +38/−32
- yam-redis.cabal +6/−4
src/Yam/Redis.hs view
@@ -10,38 +10,42 @@ -- Redis supports for [yam](https://hackage.haskell.org/package/yam). -- module Yam.Redis(- RedisConfig(..)- , HasRedis+ HasRedis+ , REDIS , redisMiddleware , ttlOpts , runR- , REDIS+ , multiE ) where import Control.Exception (bracket) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger.CallStack import Control.Monad.Reader+import qualified Data.ByteString.Char8 as BC import Data.Default-import Data.Menshen import Data.Word import Database.Redis import Salak import Servant import Yam -data RedisConfig = RedisConfig- { url :: String- , maxConnections :: Word16- } deriving (Eq, Show)+instance Default ConnectInfo where+ def = defaultConnectInfo -instance Default RedisConfig where- def = RedisConfig "redis://localhost/0" 50+instance FromProp ConnectInfo where+ fromProp = ConnInfo+ <$> "host" .?: connectHost+ <*> "port" .?: connectPort+ <*> "password" .?: connectAuth+ <*> "database" .?: connectDatabase+ <*> "max-conns" .?: connectMaxConnections+ <*> "max-idle" .?: connectMaxIdleTime+ <*> return Nothing+ <*> return Nothing -instance FromProp RedisConfig where- fromProp = RedisConfig- <$> "url" .?: url ? pattern "^redis://"- <*> "max-conns" .?: maxConnections+instance FromProp PortID where+ fromProp = PortNumber . fromIntegral <$> (fromProp :: Prop Word16) -- | Middleware context type. newtype REDIS = REDIS Connection@@ -53,29 +57,31 @@ REDIS conn <- getEntry liftIO $ runRedis conn a -instance HasRedis cxt => RedisCtx (AppT cxt Redis) (Either Reply) where- returnDecode = lift . returnDecode--instance HasRedis cxt => RedisCtx (AppT cxt RedisTx) Queued where- returnDecode = lift . returnDecode--runR :: (MonadIO m, HasRedis cxt) => AppT cxt Redis (Either Reply a) -> AppT cxt m a+runR :: (MonadIO m, HasRedis cxt) => Redis (Either Reply a) -> AppT cxt m a runR a = do- cxt <- ask- v <- liftRedis (runAppT cxt a)+ v <- liftRedis a case v of Left e -> throwS err400 $ showText e Right e -> return e -redisMiddleware :: RedisConfig -> AppMiddleware a (REDIS : a)-redisMiddleware RedisConfig{..} = AppMiddleware $ \cxt m f -> do- logInfo "Redis loaded"- lf <- askLoggerIO- case parseConnectInfo url of- Left er -> error er- Right c -> liftIO- $ bracket (connect c { connectMaxConnections = fromIntegral maxConnections }) disconnect- $ \conn -> runLoggingT (f (REDIS conn :. cxt) m) lf+multiE :: RedisTx (Queued a) -> Redis (Either Reply a)+multiE a = go <$> multiExec a+ where+ go (TxSuccess o) = Right o+ go (TxAborted ) = Left $ Error "RedisTx aborted"+ go (TxError e) = Left $ Error $ BC.pack e++redisMiddleware :: RunSalak (AppMiddleware a (REDIS : a))+redisMiddleware = do+ ci <- require "redis"+ return $ AppMiddleware $ \cxt m h f -> do+ logInfo "Redis loaded"+ lf <- askLoggerIO+ liftIO+ $ bracket (connect ci) disconnect+ $ \conn -> runLoggingT (f (REDIS conn :. cxt) m (mergeHealth (go conn) "redis" h)) lf+ where+ go c = runRedis c ping >> return UP ttlOpts :: Integer -> SetOpts ttlOpts seconds = SetOpts (Just seconds) Nothing Nothing
yam-redis.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: yam-redis-version: 0.6.0+version: 0.6.1 license: BSD3 license-file: LICENSE copyright: (c) Daniel YU@@ -35,11 +35,13 @@ ghc-options: -Wall build-depends: base >=4.10 && <5,+ bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8,- hedis >=0.12.1 && <0.13,+ hedis >=0.12.2 && <0.13, menshen >=0.0.3 && <0.1, monad-logger >=0.3.30 && <0.4, mtl >=2.2.2 && <2.3,- salak >=0.2.9 && <0.3,+ salak >=0.2.9.3 && <0.3, servant-server ==0.16.*,- yam >=0.6.0 && <0.7+ text >=1.2.3.1 && <1.3,+ yam >=0.6.1 && <0.7