yam-redis (empty) → 0.6.0

raw patch · 5 files changed

+161/−0 lines, 5 filesdep +basedep +data-defaultdep +hedissetup-changed

Dependencies added: base, data-default, hedis, menshen, monad-logger, mtl, salak, servant-server, yam

Files

• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• src/Yam/Redis.hs +81/−0
• yam-redis.cabal +45/−0

@@ -0,0 +1,30 @@+Copyright Daniel YU (c) 2019++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 Daniel YU 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.

@@ -0,0 +1,3 @@+# yam-redis++

@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain

@@ -0,0 +1,81 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module:      Yam.Redis+-- Copyright:   (c) 2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- Redis supports for [yam](https://hackage.haskell.org/package/yam).+--+module Yam.Redis(+    RedisConfig(..)+  , HasRedis+  , redisMiddleware+  , ttlOpts+  , runR+  , REDIS+  ) where++import           Control.Exception              (bracket)+import           Control.Monad.IO.Class         (MonadIO)+import           Control.Monad.Logger.CallStack+import           Control.Monad.Reader+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 RedisConfig where+  def = RedisConfig "redis://localhost/0" 50++instance FromProp RedisConfig where+  fromProp = RedisConfig+    <$> "url"       .?: url ? pattern "^redis://"+    <*> "max-conns" .?: maxConnections++-- | Middleware context type.+newtype REDIS = REDIS Connection+-- | Middleware context.+type HasRedis cxt = (HasLogger cxt, HasContextEntry cxt REDIS)++instance (HasRedis cxt, MonadIO m) => MonadRedis (AppT cxt m) where+  liftRedis a = do+    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 a = do+  cxt <- ask+  v   <- liftRedis (runAppT cxt 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++ttlOpts :: Integer -> SetOpts+ttlOpts seconds = SetOpts (Just seconds) Nothing Nothing

@@ -0,0 +1,45 @@+cabal-version: 1.12+name: yam-redis+version: 0.6.0+license: BSD3+license-file: LICENSE+copyright: (c) Daniel YU+maintainer: Daniel YU <leptonyu@gmail.com>+author: Daniel YU+homepage: https://github.com/leptonyu/yam#readme+synopsis: Yam Redis Middleware+category: Web+build-type: Simple+extra-source-files:+    README.md++library+    exposed-modules:+        Yam.Redis+    hs-source-dirs: src+    other-modules:+        Paths_yam_redis+    default-language: Haskell2010+    default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals+                        ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable+                        DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable+                        DuplicateRecordFields DoAndIfThenElse EmptyDataDecls+                        ExistentialQuantification FlexibleContexts FlexibleInstances+                        FunctionalDependencies GADTs GeneralizedNewtypeDeriving+                        InstanceSigs KindSignatures LambdaCase MonadFailDesugaring+                        MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings+                        PartialTypeSignatures PatternGuards PolyKinds RankNTypes+                        RecordWildCards ScopedTypeVariables StandaloneDeriving+                        TupleSections TypeApplications TypeFamilies TypeOperators+                        TypeSynonymInstances ViewPatterns+    ghc-options: -Wall+    build-depends:+        base >=4.10 && <5,+        data-default >=0.7.1.1 && <0.8,+        hedis >=0.12.1 && <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,+        servant-server ==0.16.*,+        yam >=0.6.0 && <0.7