yam 0.5.0 → 0.5.1
raw patch · 6 files changed
+9/−126 lines, 6 filesdep −conduitdep −persistentdep −persistent-sqlite
Dependencies removed: conduit, persistent, persistent-sqlite, resource-pool, resourcet, time
Files
- README.md +3/−0
- demo/Main.hs +2/−18
- src/Yam.hs +2/−2
- src/Yam/DataSource.hs +0/−71
- test/Spec.hs +0/−17
- yam.cabal +2/−18
README.md view
@@ -1,5 +1,8 @@ # yam +[](https://hackage.haskell.org/package/yam)+[](https://travis-ci.org/leptonyu/yam)+ Servant based Web Wrapper for Production in Haskell.
demo/Main.hs view
@@ -2,8 +2,6 @@ import Control.Monad.Logger.CallStack import qualified Data.Salak as S-import Data.Time-import Database.Persist.Sqlite import Servant import Yam @@ -11,10 +9,9 @@ = "users" :> Get '[JSON] Text :<|> "users" :> "error" :> Get '[JSON] Text :<|> "users" :> "servant" :> Get '[JSON] Text- :<|> "users" :> "db" :> Get '[JSON] Text service :: ServerT UserApi App-service = userService :<|> errorService :<|> servantService :<|> dbService+service = userService :<|> errorService :<|> servantService userService :: App Text userService = do@@ -27,20 +24,7 @@ servantService :: App Text servantService = throwS err401 "Servant" -dbService :: App Text-dbService = do- str <- runTrans $ do- (time:_) :: [UTCTime] <- selectValue "SELECT CURRENT_TIMESTAMP"- let timeStr = showText time- logWarn timeStr- return timeStr- logInfo str- return str--db :: DataSourceProvider-db = createSqlitePool ":memory:" 10- main :: IO () main = do p <- S.defaultPropertiesWithFile "yam_test.yml"- start p [primaryDatasourceMiddleware db] (Proxy :: Proxy UserApi) service+ start p [] (Proxy :: Proxy UserApi) service
src/Yam.hs view
@@ -1,7 +1,7 @@ module Yam( module Yam.Internal- , module Yam.DataSource+ -- , module Yam.DataSource ) where -import Yam.DataSource+-- import Yam.DataSource import Yam.Internal
− src/Yam/DataSource.hs
@@ -1,71 +0,0 @@-module Yam.DataSource(- -- * DataSource Types- DataSourceProvider- , DataSource- , DB- -- * Primary DataSource Functions- , 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 Data.Conduit-import qualified Data.Conduit.List as CL-import Data.Pool-import Database.Persist.Sql hiding (Key)-import System.IO.Unsafe (unsafePerformIO)-import Yam.Types hiding (LogFunc)--type DataSource = ConnectionPool--{-# NOINLINE dataSourceKey #-}-dataSourceKey :: Key DataSource-dataSourceKey = unsafePerformIO newKey--type DataSourceProvider = LoggingT IO DataSource--- SqlPersistT ~ ReaderT SqlBackend-type DB = SqlPersistT--query- :: (MonadUnliftIO m)- => 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 sql = fmap unSingle <$> rawSql sql []--runTransWith :: (MonadUnliftIO m) => Key DataSource -> DB (AppM m) a -> AppM m a-runTransWith k a = requireAttr k >>= (`runDB` a)--runTrans :: (MonadUnliftIO m) => DB (AppM m) a -> AppM m a-runTrans = runTransWith dataSourceKey--{-# INLINE runDB #-}-runDB :: (MonadLoggerIO m, MonadUnliftIO m) => DataSource -> DB m a -> m a-runDB pool db = do- logger <- askLoggerIO- withRunInIO $ \run -> withResource pool $ run . \c -> runSqlConn db c { connLogFunc = logger }--{-# INLINE runInDB #-}-runInDB :: LogFunc -> DataSourceProvider -> (DataSource -> IO a) -> IO a-runInDB logfunc f g = bracket (runLoggingT f logfunc) destroyAllResources g--datasourceMiddleware :: Key DataSource -> DataSourceProvider -> AppMiddleware-datasourceMiddleware k dsp = AppMiddleware $ \env f -> do- lf <- askLoggerIO- logInfo "Datasource Initialized..."- liftIO $ runInDB lf dsp $ \ds -> runLoggingT (f (setAttr k ds env, id)) lf--primaryDatasourceMiddleware = datasourceMiddleware dataSourceKey
test/Spec.hs view
@@ -4,15 +4,8 @@ module Main where --import Control.Monad.IO.Class-import Data.Aeson-import Data.Maybe-import qualified Data.Salak as S-import Data.Text (Text) import qualified Data.Text as T import Test.Hspec-import Test.QuickCheck import Test.QuickCheck.Monadic import Yam @@ -23,16 +16,6 @@ describe "Yam.Config" specConfig specConfig = do- context "configuration" $ do- it "load" $ do- p <- S.defaultPropertiesWithFile "yam_test.yml"- let get :: S.FromProperties a => Text -> Maybe a- get = flip S.lookup p- -- let dsf = get "yam.datasource" :: Maybe DataSourceConfig- -- shouldSatisfy dsf isJust- let conf = get "yam.application" :: Maybe AppConfig- shouldSatisfy conf isJust- -- datasource <$> conf `shouldBe` dsf context "randomTest" $ do it "random" $ do monadicIO $ do
yam.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f9fe2bcda9477157917b0e18eb2cc0dedfe7d1737dda59d00077e97f6f8b0882+-- hash: 7dcbc1f022111b764d8abc3792f3a3aba5cd1e9dd501a85c2e76d07305d9899c name: yam-version: 0.5.0+version: 0.5.1 synopsis: Yam Web category: Web homepage: https://github.com/leptonyu/yam#readme@@ -24,7 +24,6 @@ library exposed-modules: Yam- Yam.DataSource Yam.Internal other-modules: Yam.Types@@ -39,16 +38,12 @@ aeson , base >=4.7 && <5 , bytestring- , conduit , data-default , fast-logger , monad-logger , mtl- , persistent , random , reflection- , resource-pool- , resourcet , salak , servant-server , servant-swagger@@ -72,23 +67,17 @@ aeson , base >=4.7 && <5 , bytestring- , conduit , data-default , fast-logger , monad-logger , mtl- , persistent- , persistent-sqlite , random , reflection- , resource-pool- , resourcet , salak , servant-server , servant-swagger , servant-swagger-ui , text- , time , unliftio-core , vault , wai@@ -102,7 +91,6 @@ main-is: Spec.hs other-modules: Yam- Yam.DataSource Yam.Internal Yam.Logger Yam.Swagger@@ -119,17 +107,13 @@ , aeson , base >=4.7 && <5 , bytestring- , conduit , data-default , fast-logger , hspec ==2.* , monad-logger , mtl- , persistent , random , reflection- , resource-pool- , resourcet , salak , servant-server , servant-swagger