yam-datasource 0.5.17 → 0.6.0

raw patch · 2 files changed

+70/−43 lines, 2 filesdep +data-defaultdep +monad-loggerdep +salakdep ~persistentdep ~yamPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, monad-logger, salak, servant-server, text

Dependency ranges changed: persistent, yam

API changes (from Hackage documentation)

Files

• src/Yam/DataSource.hs +60/−38
• yam-datasource.cabal +10/−5

@@ -1,79 +1,101 @@+-- |+-- Module:      Yam.DataSource+-- Copyright:   (c) 2019 Daniel YU+-- License:     BSD3+-- Maintainer:  leptonyu@gmail.com+-- Stability:   experimental+-- Portability: portable+--+-- Datasource supports for [yam](https://hackage.haskell.org/package/yam).+-- module Yam.DataSource(   -- * DataSource Types     DataSourceProvider(..)   , DataSource   , DB-  -- * Primary DataSource Functions+  , HasDataSource+  , DataSourceConfig(..)   , runTrans-  , primaryDatasourceMiddleware-  -- * Secondary DataSource Functions-  , runTransWith   , datasourceMiddleware   -- * Sql Functions   , query   , selectValue   ) where +import           Control.Exception              (bracket) import           Control.Monad.IO.Unlift-import           Data.Acquire            (withAcquire)+import           Control.Monad.Logger.CallStack+import           Data.Acquire                   (withAcquire) import           Data.Conduit-import qualified Data.Conduit.List       as CL+import qualified Data.Conduit.List              as CL+import           Data.Default import           Data.Pool-import           Database.Persist.Sql    hiding (Key)-import           System.IO.Unsafe        (unsafePerformIO)-import           Yam                     hiding (LogFunc)+import qualified Data.Text                      as T+import           Database.Persist.Sql           hiding (Key)+import           Salak+import           Servant+import           Yam -type DataSource = Pool SqlBackend -{-# NOINLINE dataSourceKey #-}-dataSourceKey :: Key DataSource-dataSourceKey = unsafePerformIO newKey+data DataSourceConfig = DataSourceConfig+  { dsType  :: T.Text+  , dsUrl   :: T.Text+  , maxConn :: Int+  } deriving Show ++instance Default DataSourceConfig where+  def = DataSourceConfig "sqlite" ":memory:" 10++instance FromProp DataSourceConfig where+  fromProp = DataSourceConfig+    <$> "type"            .?: dsType+    <*> "url"             .?: dsUrl+    <*> "max-connections" .?: maxConn++-- | Middleware context type.+type DataSource = Pool SqlBackend+ data DataSourceProvider = DataSourceProvider   { datasource :: LoggingT IO DataSource   , migration  :: DB (LoggingT IO) ()-  , dbtype     :: Text+  , dbtype     :: T.Text   } -- SqlPersistT ~ ReaderT SqlBackend type DB = SqlPersistT  query   :: (MonadUnliftIO m)-  => Text+  => T.Text   -> [PersistValue]   -> DB m [[PersistValue]] query sql params = do   res <- rawQueryRes sql params   withAcquire res (\a -> runConduit $ a .| CL.fold (flip (:)) []) -selectValue :: (PersistField a, MonadUnliftIO m) => Text -> DB m [a]+selectValue :: (PersistField a, MonadUnliftIO m) => T.Text -> DB m [a] selectValue sql = fmap unSingle <$> rawSql sql [] -runTransWith :: Key DataSource -> DB App a -> App a-runTransWith k a = requireAttr k >>= (`runDB` a)--runTrans :: DB App a -> App a-runTrans = runTransWith dataSourceKey+-- | Middleware context.+type HasDataSource cxt = (HasLogger cxt, HasContextEntry cxt DataSource) -{-# INLINE runDB #-}-runDB :: (MonadLoggerIO m, MonadUnliftIO m) => DataSource -> DB m a -> m a-runDB pool db = do+runTrans+  :: ( HasDataSource cxt+     , MonadIO m+     , MonadUnliftIO m)+  => DB (AppT cxt m) a+  -> AppT cxt m a+runTrans a = do+  pool   <- getEntry   logger <- askLoggerIO-  withRunInIO $ \run -> withResource pool $ run . \c -> runSqlConn db c { connLogFunc = logger }--datasourceMiddleware :: Key DataSource -> DataSourceProvider -> AppMiddleware-datasourceMiddleware k DataSourceProvider{..} = simplePoolMiddleware (True, "database " <> dbtype) k open (liftIO . destroyAllResources)-  where-    {-# INLINE trans #-}-    trans :: LoggingT IO a -> App a-    trans a = askLoggerIO >>= liftIO . runLoggingT a-    {-# INLINE open #-}-    open = do-      a <- trans datasource-      trans $ runDB a migration-      return a+  withRunInIO $ \run -> withResource pool $ run . \c -> runSqlConn a c { connLogFunc = logger } -primaryDatasourceMiddleware = datasourceMiddleware dataSourceKey+datasourceMiddleware :: DataSourceProvider -> AppMiddleware a (DataSource ': a)+datasourceMiddleware DataSourceProvider{..} = AppMiddleware $ \c m f -> askLoggerIO >>= \lc ->+  liftIO $ bracket+    (runLoggingT datasource lc)+    destroyAllResources+    (\ds -> runLoggingT (f (ds :. c) m) lc)   

@@ -1,12 +1,12 @@ cabal-version: 1.12 name: yam-datasource-version: 0.5.17+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/yam-datasource#readme+homepage: https://github.com/leptonyu/yam#readme synopsis: Yam DataSource Middleware category: Web build-type: Simple@@ -32,12 +32,17 @@                         RecordWildCards ScopedTypeVariables StandaloneDeriving                         TupleSections TypeApplications TypeFamilies TypeOperators                         TypeSynonymInstances ViewPatterns-    ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+    ghc-options: -Wall     build-depends:         base >=4.10 && <5,         conduit >=1.3.1.1 && <1.4,-        persistent >=2.9.1 && <2.10,+        data-default >=0.7.1.1 && <0.8,+        monad-logger >=0.3.30 && <0.4,+        persistent >=2.8.0 && <2.11,         resource-pool >=0.2.3.2 && <0.3,         resourcet >=1.2.2 && <1.3,+        salak >=0.2.9 && <0.3,+        servant-server ==0.16.*,+        text >=1.2.3.1 && <1.3,         unliftio-core >=0.1.2.0 && <0.2,-        yam >=0.5.17 && <0.6+        yam >=0.6.0 && <0.7