packages feed

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 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