magicbane 0.2.0 → 0.3.0
raw patch · 8 files changed
+70/−104 lines, 8 filesdep +exceptionsdep +riodep +rio-orphansdep −asyncdep −lifted-asyncdep −safe-exceptionsdep ~servant-server
Dependencies added: exceptions, rio, rio-orphans, unliftio, unliftio-core
Dependencies removed: async, lifted-async, safe-exceptions
Dependency ranges changed: servant-server
Files
- library/Magicbane.hs +5/−5
- library/Magicbane/App.hs +13/−39
- library/Magicbane/Async.hs +0/−21
- library/Magicbane/HTTPClient.hs +11/−10
- library/Magicbane/Logging.hs +25/−14
- library/Magicbane/Util.hs +3/−3
- library/Magicbane/Validation.hs +1/−1
- magicbane.cabal +12/−11
library/Magicbane.hs view
@@ -11,10 +11,11 @@ , module Magicbane ) where -import Control.Error.Util as X hiding (hoistEither, (??), tryIO, bool)+import Control.Error.Util as X hiding ((??), err, errLn, tryIO, handleExceptT, syncIO, bool) import Control.Monad.IO.Class-import Control.Monad.Trans.Control as X import Control.Monad.Trans.Maybe as X hiding (liftListen, liftPass, liftCallCC)+import UnliftIO.Exception as X hiding (Handler)+import UnliftIO.Concurrent as X import qualified System.Envy import System.Envy as X hiding ((.=), (.!=), decode) import qualified System.IO@@ -33,7 +34,6 @@ import Network.Wai as X (Application, Middleware) import Network.Wai.Cli as X hiding (port) import Magicbane.App as X hiding (Or)-import Magicbane.Async as X import Magicbane.Logging as X import Magicbane.Metrics as X import Magicbane.Validation as X@@ -61,10 +61,10 @@ hPutStrLn h s = liftIO $ System.IO.hPutStrLn h s type BasicContext = (ModHttpClient, ModLogger)-type BasicApp α = MagicbaneApp BasicContext α+type BasicApp α = RIO BasicContext α newBasicContext ∷ IO BasicContext newBasicContext = do http ← newHttpClient- (_, logg) ← newLogger $ LogStdout defaultBufSize+ (_, logg) ← newLogger (LogStdout defaultBufSize) simpleFormatter return (http, logg)
library/Magicbane/App.hs view
@@ -1,55 +1,29 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, CPP #-}+{-# LANGUAGE NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, TypeApplications, ScopedTypeVariables, CPP #-} --- | Extends Servant with context.--- Basically wrapping Servant in a ReaderT of your type.--- Which should be a tuple of all your moudles and configs and stuff, so that the Data.Has module would let you access these items by type.+-- | Extends Servant with context, based on RIO.+-- The context should be a tuple of all your moudles and configs and stuff, so that the Data.Has module would let you access these items by type. module Magicbane.App ( module X , module Magicbane.App+, RIO ) where -import Control.Exception.Safe hiding (Handler)-import Control.Monad.Base-import Control.Monad.Error.Class as X (MonadError, throwError)-import Control.Monad.IO.Class-import Control.Monad.Reader-import Control.Monad.Trans.Control-import Control.Monad.Trans.Except as X+import RIO+import RIO.Orphans as X ()+import Control.Monad.Trans.Except (ExceptT (..)) import Data.Proxy as X import Data.Has as X-import Servant as X hiding (And)--newtype MagicbaneApp β α = MagicbaneApp {- unMagicbaneApp ∷ ReaderT β Handler α-} deriving (Functor, Applicative, Monad, MonadIO, MonadBase IO,- MonadThrow, MonadCatch, MonadError ServantErr, MonadReader β)--instance MonadBaseControl IO (MagicbaneApp β) where- type StM (MagicbaneApp β) α = StM (ReaderT β Handler) α- liftBaseWith f = MagicbaneApp $ liftBaseWith $ \x → f $ x . unMagicbaneApp- restoreM = MagicbaneApp . restoreM--runMagicbaneHandler ∷ β → MagicbaneApp β α → Handler α-runMagicbaneHandler ctx a = Handler $ ExceptT $ liftIO $ runHandler $ runReaderT (unMagicbaneApp a) ctx+import Servant as X hiding (And, Handler)+import qualified Servant -#if MIN_VERSION_servant_server(0,12,0)-#else-magicbaneToHandler ∷ β → MagicbaneApp β :~> Handler-#if MIN_VERSION_servant_server(0,10,0)-magicbaneToHandler ctx = NT $ runMagicbaneHandler ctx-#else-magicbaneToHandler ctx = Nat $ runMagicbaneHandler ctx-#endif-#endif+runMagicbaneHandler ∷ β → RIO β α → Servant.Handler α+runMagicbaneHandler ctx a = Servant.Handler $ ExceptT $ try $ runReaderT (unRIO a) ctx -- | Constructs a WAI application from an API definition, a Servant context (used for auth mainly), the app context and the actual action handlers.+magicbaneApp ∷ forall β χ ψ. (HasServer χ ψ) ⇒ Proxy χ → Context ψ → β → ServerT χ (RIO β) → Application magicbaneApp api sctx ctx actions = serveWithContext api sctx $ srv ctx-#if MIN_VERSION_servant_server(0,12,0)- where srv c = hoistServer api (runMagicbaneHandler c) actions-#else- where srv c = enter (magicbaneToHandler c) actions-#endif+ where srv c = hoistServerWithContext api (Proxy @ψ) (runMagicbaneHandler c) actions -- | Gets a value of any type from the context. askObj ∷ (Has β α, MonadReader α μ) ⇒ μ β
− library/Magicbane/Async.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts #-}---- | 'Control.Monad.Except.ExceptT'-friendly concurrency--- The selection of exposed functions matches "ClassyPrelude", but uses--- "Control.Concurrent.Async.Lifted" instead of the 'Control.Monad.Except.ExceptT'-incompatible--- "Control.Concurrent.Async.Lifted.Safe".-module Magicbane.Async (- module Magicbane.Async-, module X-) where--import Control.Concurrent.Lifted as X hiding (yield, throwTo)-import qualified Control.Concurrent.Lifted as Conc (yield)-import Control.Concurrent.Async as X (Async, waitSTM, pollSTM, waitCatchSTM)-import Control.Concurrent.Async.Lifted as X (async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask, withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask, withAsyncOnWithUnmask, asyncThreadId, race, race_, concurrently, mapConcurrently, Concurrently (..))-import Control.Monad.Base---- | Originally 'Conc.yield'. Renamed to avoid conflict with streaming libraries.-yieldThread :: MonadBase IO m => m ()-yieldThread = Conc.yield-{-# INLINE yieldThread #-}
library/Magicbane/HTTPClient.hs view
@@ -3,17 +3,18 @@ -- | Provides an HTTP(S) client via http-client(-tls) in a Magicbane app context. -- Also provides a simple composable interface for making arbitrary requests, based on http-client-conduit.--- That lets you plug stream parsers (e.g. html-conduit: 'performWithFn ($$ sinkDoc)') directly into the reading of the response body.+-- That lets you plug stream parsers (e.g. html-conduit: 'performWithFn (.| sinkDoc)') directly into the reading of the response body. module Magicbane.HTTPClient ( module Magicbane.HTTPClient , module X ) where -import Control.Exception.Safe-import Control.Monad.IO.Class import Control.Monad.Reader-import Control.Monad.Trans.Control-import Control.Monad.Trans.Except+import Control.Monad.Catch as X (MonadCatch)+import Control.Monad.Trans.Except as X (ExceptT (..), runExceptT)+import qualified Control.Monad.Trans.Except as MTE+import Control.Monad.IO.Unlift as X (MonadUnliftIO)+import UnliftIO.Exception (tryAny) import Data.Has import Data.Bifunctor import Data.ByteString (ByteString)@@ -39,10 +40,10 @@ newHttpClient ∷ IO ModHttpClient newHttpClient = ModHttpClient <$> newTlsManager -type MonadHTTP ψ μ = (HasHttpManager ψ, MonadReader ψ μ, MonadIO μ, MonadBaseControl IO μ)+type MonadHTTP ψ μ = (HasHttpManager ψ, MonadReader ψ μ, MonadUnliftIO μ) runHTTP ∷ ExceptT ε μ α → μ (Either ε α)-runHTTP = runExceptT+runHTTP = MTE.runExceptT -- | Creates a request from a URI. reqU ∷ (MonadHTTP ψ μ) ⇒ URI → ExceptT Text μ Request@@ -64,10 +65,10 @@ , requestBody = RequestBodyBS $ writeForm form } -- | Performs the request, using a given function to read the body. This is what all other performWith functions are based on.-performWithFn ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ (ConduitM ι ByteString μ () → μ ρ) → Request → ExceptT Text μ (Response ρ)+performWithFn ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ (ConduitM ι ByteString μ () → ConduitT () Void μ ρ) → Request → ExceptT Text μ (Response ρ) performWithFn fn req = do res ← lift $ tryAny $ HCC.withResponse req $ \res → do- body ← fn $ responseBody res+ body ← runConduit $ fn $ responseBody res return res { responseBody = body } ExceptT $ return $ bimap (pack.show) id res @@ -77,4 +78,4 @@ -- | Performs the request, reading the body into a lazy ByteString. performWithBytes ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → ExceptT Text μ (Response L.ByteString)-performWithBytes = performWithFn ($$ C.sinkLazy)+performWithBytes = performWithFn (.| C.sinkLazy)
library/Magicbane/Logging.hs view
@@ -1,32 +1,43 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} --- | Provides logging via monad-logger/fast-logger in a Magicbane app context.+-- | Provides logging via fast-logger in a Magicbane app context. module Magicbane.Logging ( module Magicbane.Logging , module X ) where +import RIO import Data.Has-import Data.Monoid-import Control.Monad.IO.Class-import Control.Monad.Logger as X-import Control.Monad.Reader import System.Log.FastLogger import System.Log.FastLogger as X (LogType(..), defaultBufSize) -newtype ModLogger = ModLogger (Loc → LogSource → LogLevel → LogStr → IO ())+type ModLogger = LogFunc -instance (Has ModLogger α, Monad μ, MonadIO μ, MonadReader α μ) ⇒ MonadLogger μ where- monadLoggerLog loc src lvl msg = asks getter >>= \(ModLogger f) → liftIO (f loc src lvl $ toLogStr msg)+instance Has ModLogger α ⇒ HasLogFunc α where+ logFuncL = hasLens -instance (Has ModLogger α, MonadIO μ, MonadReader α μ) ⇒ MonadLoggerIO μ where- askLoggerIO = (\(ModLogger f) → f) <$> asks getter+type Formatter = TimedFastLogger → CallStack → LogSource → LogLevel → Utf8Builder → IO () --- | Creates a logger module. Also returns the logger itself for using outside of your Magicbane app (e.g. in some WAI middleware).-newLogger ∷ LogType → IO (TimedFastLogger, ModLogger)-newLogger logtype = do+-- | Creates a logger module using a given formatting function.+-- | Also returns the underlying TimedFastLogger for use outside of your Magicbane app (e.g. in some WAI middleware).+newLogger ∷ LogType → Formatter → IO (TimedFastLogger, ModLogger)+newLogger logtype formatter = do tc ← newTimeCache simpleTimeFormat' (fl, _) ← newTimedFastLogger tc logtype -- forget cleanup because the logger will exist for the lifetime of the (OS) process- return (fl, ModLogger $ \loc src lvl msg → fl (\t → toLogStr (t <> " ") <> defaultLogStr loc src lvl msg))+ return (fl, mkLogFunc $ formatter fl)++simpleFormatter ∷ Formatter+simpleFormatter logger cs src level msg =+ logger $ \t →+ toLogStr t <> " " <>+ toLogStr (utf8BuilderToText $ displayCallStack cs) <> " " <>+ toLogStr src <> " " <>+ toLogStr (showLevel level) <>+ toLogStr (utf8BuilderToText msg) <> "\n"+ where showLevel LevelDebug = "[DEBUG] "+ showLevel LevelInfo = "[ INFO] "+ showLevel LevelWarn = "[ WARN] "+ showLevel LevelError = "[ERROR] "+ showLevel (LevelOther t) = "[" <> t <> "] "
library/Magicbane/Util.hs view
@@ -3,9 +3,9 @@ -- | Various useful functions. module Magicbane.Util where +import RIO (MonadThrow, throwM) import Control.Arrow import Control.Monad-import Control.Monad.Except (MonadError) import Control.Error (hush) import qualified Data.ByteString.Lazy as L (ByteString) import qualified Data.HashMap.Strict as HMS@@ -89,5 +89,5 @@ , errBody = t } -- | Creates and throws a simple text/plain ServantErr.-throwErrText ∷ MonadError ServantErr μ ⇒ ServantErr → L.ByteString → μ α-throwErrText e t = throwError $ errText e t+throwErrText ∷ MonadThrow μ ⇒ ServantErr → L.ByteString → μ α+throwErrText e t = throwM $ errText e t
library/Magicbane/Validation.hs view
@@ -17,4 +17,4 @@ res ← parseJSON x case refine res of Right v → return v- Left e → fail e+ Left e → fail $ show e
magicbane.cabal view
@@ -1,14 +1,14 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 88e201dd0d795d1b2f734fac496dffd6df8421151ab0e9b88379490a2d4c5bfa+-- hash: 16f20d3488e7908f6f190f6fe542bac616d2a863b4cdb40a363c7a8c5fcadd95 name: magicbane-version: 0.2.0-synopsis: A web framework that integrates Servant, EKG, fast-logger, wai-cli…+version: 0.3.0+synopsis: A web framework that integrates Servant, RIO, EKG, fast-logger, wai-cli… -description: Inspired by Dropwizard, Magicbane provides a packaged framework for developing web services using the best available libraries, including Servant, Aeson, EKG/monad-metrics, fast-logger/monad-logger, wai-cli and others.+description: Inspired by Dropwizard, Magicbane provides a packaged framework for developing web services using the best available libraries, including Servant, RIO, Aeson, EKG/monad-metrics, fast-logger, wai-cli and others. category: Web homepage: https://github.com/myfreeweb/magicbane#readme bug-reports: https://github.com/myfreeweb/magicbane/issues@@ -16,7 +16,7 @@ maintainer: greg@unrelenting.technology copyright: 2017-2018 Greg V <greg@unrelenting.technology> license: PublicDomain-tested-with: GHC==8.2.1+tested-with: GHC==8.4.2 build-type: Simple cabal-version: >= 1.10 @@ -31,7 +31,6 @@ build-depends: aeson , aeson-qq- , async , attoparsec , base >=4.8.0.0 && <5 , bytestring@@ -43,6 +42,7 @@ , ekg-wai , envy , errors+ , exceptions , fast-logger , http-api-data , http-client@@ -50,7 +50,6 @@ , http-conduit , http-link-header , http-types- , lifted-async , lifted-base , monad-control , monad-logger@@ -60,13 +59,16 @@ , network-uri , raw-strings-qq , refined- , safe-exceptions- , servant-server+ , rio+ , rio-orphans+ , servant-server >=0.12 , split , string-conversions , text , transformers , transformers-base+ , unliftio+ , unliftio-core , unordered-containers , wai , wai-cli@@ -80,6 +82,5 @@ Magicbane.HTTPClient Magicbane.Util other-modules:- Magicbane.Async Paths_magicbane default-language: Haskell2010