magicbane 0.1.4 → 0.2.0
raw patch · 9 files changed
+87/−45 lines, 9 filesdep +asyncdep +bytestringdep +lifted-basedep −classy-preludedep −http-datedep −http-media
Dependencies added: async, bytestring, lifted-base, mono-traversable, safe-exceptions, transformers-base
Dependencies removed: classy-prelude, http-date, http-media, mime-types, network, servant
Files
- library/Magicbane.hs +6/−5
- library/Magicbane/App.hs +7/−3
- library/Magicbane/Async.hs +21/−0
- library/Magicbane/HTTPClient.hs +13/−6
- library/Magicbane/Logging.hs +5/−3
- library/Magicbane/Metrics.hs +4/−2
- library/Magicbane/Util.hs +18/−12
- library/Magicbane/Validation.hs +1/−3
- magicbane.cabal +12/−11
library/Magicbane.hs view
@@ -1,19 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-signatures #-}-{-# LANGUAGE Trustworthy, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, LambdaCase #-}+{-# LANGUAGE Trustworthy, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, LambdaCase #-} -- | A Dropwizard-inspired web framework that integrates -- Servant, monad-metrics/EKG, monad-logger/fast-logger, and other useful libraries -- to provide a smooth web service development experience. ----- This module provides a ClassyPrelude based prelude with all the stuff you need reexported.+-- This module provides all the stuff you need. module Magicbane ( module X , module Magicbane ) where -import ClassyPrelude as X hiding (fromString, Handler, Concurrently, runConcurrently, concurrently, mapConcurrently, async, asyncWithUnmask, asyncBound, asyncOn, asyncOnWithUnmask, race, race_, withAsync, withAsyncBound, withAsyncOn, withAsyncOnWithUnmask, withAsyncWithUnmask, cancel, cancelWith)-import Control.Concurrent.Async.Lifted as X -- Classy reexports …Lifted.Safe which doesn't work with ExceptT import Control.Error.Util as X hiding (hoistEither, (??), tryIO, 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 qualified System.Envy@@ -25,6 +24,7 @@ import Data.String.Conversions.Monomorphic as X import Data.Aeson as X import Data.Aeson.QQ as X+import Data.Text (Text) import Text.RawString.QQ as X import Network.URI as X import qualified Network.HTTP.Link@@ -33,6 +33,7 @@ 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@@ -54,7 +55,7 @@ -- (Does environment variable reading ever fail in practice? Probably not.) withEnvConfig ∷ FromEnv α ⇒ (α → IO ()) → IO () withEnvConfig a = decodeEnv >>= \case- Left e → hPutStrLn stderr ("error reading env: " ++ e)+ Left e → hPutStrLn System.IO.stderr ("error reading env: " ++ e) Right c → a c hPutStrLn h s = liftIO $ System.IO.hPutStrLn h s
library/Magicbane/App.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, CPP #-}+{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, CPP #-} -- | Extends Servant with context. -- Basically wrapping Servant in a ReaderT of your type.@@ -9,9 +9,13 @@ , module Magicbane.App ) where -import ClassyPrelude hiding (Handler)-import Control.Monad.Trans.Except as X+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 Data.Proxy as X import Data.Has as X import Servant as X hiding (And)
+ library/Magicbane/Async.hs view
@@ -0,0 +1,21 @@+{-# 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
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances, ConstraintKinds #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances, ConstraintKinds #-} -- | 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.@@ -9,12 +9,19 @@ , module X ) where -import ClassyPrelude+import Control.Exception.Safe+import Control.Monad.IO.Class+import Control.Monad.Reader+import Control.Monad.Trans.Control import Control.Monad.Trans.Except import Data.Has+import Data.Bifunctor+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as L (ByteString) import Data.Conduit import qualified Data.Conduit.Combinators as C import Data.String.Conversions+import Data.Text (Text, pack) import Network.URI as X import Network.HTTP.Types import Network.HTTP.Conduit as HC@@ -39,11 +46,11 @@ -- | Creates a request from a URI. reqU ∷ (MonadHTTP ψ μ) ⇒ URI → ExceptT Text μ Request-reqU uri = ExceptT $ return $ bimap tshow id $ setUri defaultRequest uri+reqU uri = ExceptT $ return $ bimap (pack.show) id $ setUri defaultRequest uri -- | Creates a request from a string of any type, parsing it into a URI. reqS ∷ (MonadHTTP ψ μ, ConvertibleStrings σ String) ⇒ σ → ExceptT Text μ Request-reqS uri = ExceptT $ return $ bimap tshow id $ parseUrlThrow $ cs uri+reqS uri = ExceptT $ return $ bimap (pack.show) id $ parseUrlThrow $ cs uri -- | Configures the request to not throw errors on error status codes. anyStatus ∷ (MonadHTTP ψ μ) ⇒ Request → ExceptT Text μ Request@@ -62,12 +69,12 @@ res ← lift $ tryAny $ HCC.withResponse req $ \res → do body ← fn $ responseBody res return res { responseBody = body }- ExceptT $ return $ bimap tshow id res+ ExceptT $ return $ bimap (pack.show) id res -- | Performs the request, ignoring the body. performWithVoid ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → ExceptT Text μ (Response ()) performWithVoid = performWithFn (const $ return ()) -- | Performs the request, reading the body into a lazy ByteString.-performWithBytes ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → ExceptT Text μ (Response LByteString)+performWithBytes ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → ExceptT Text μ (Response L.ByteString) performWithBytes = performWithFn ($$ C.sinkLazy)
library/Magicbane/Logging.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} -- | Provides logging via monad-logger/fast-logger in a Magicbane app context. module Magicbane.Logging (@@ -7,9 +7,11 @@ , module X ) where -import ClassyPrelude 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) @@ -27,4 +29,4 @@ 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, ModLogger $ \loc src lvl msg → fl (\t → toLogStr (t <> " ") <> defaultLogStr loc src lvl msg))
library/Magicbane/Metrics.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} -- | Provides metrics via monad-metrics/EKG in a Magicbane app context. -- Also reexports Wai metrics middleware.@@ -8,7 +8,6 @@ , module X ) where -import ClassyPrelude import Data.Has import qualified Control.Monad.Metrics import Control.Monad.Metrics as X hiding (initialize, initializeWith, run, run')@@ -16,6 +15,9 @@ import qualified System.Remote.Monitoring.Wai import System.Remote.Monitoring.Wai as X (serverMetricStore) import Network.Wai.Metrics as X+-- replacing ClassyPrelude+import Control.Monad.Reader+import Data.ByteString (ByteString) newtype ModMetrics = ModMetrics Metrics
library/Magicbane/Util.hs view
@@ -1,17 +1,24 @@-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} -- | Various useful functions. module Magicbane.Util where -import ClassyPrelude+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+import qualified Data.Sequences as S import qualified Data.Text as T+import Data.Text (Text) import Data.Char (isSpace)+import Data.Foldable+import Data.HashMap.Strict (insertWith)+import Data.Maybe+import Data.MonoTraversable import Data.String.Conversions import Data.String.Conversions.Monomorphic-import Data.Maybe (fromJust) import Data.Attoparsec.Text as AP import Data.Aeson import Network.URI@@ -19,18 +26,17 @@ import Web.FormUrlEncoded hiding (parseMaybe) import Servant - -- | Merges two JSON objects recursively. When the values are not objects, just returns the left one. mergeVal ∷ Value → Value → Value mergeVal (Object x) (Object y) = Object $ HMS.unionWith mergeVal x y mergeVal x _ = x -- | Encodes key-value data as application/x-www-form-urlencoded.-writeForm ∷ (ConvertibleStrings α Text, ConvertibleStrings β Text, ConvertibleStrings LByteString γ) ⇒ [(α, β)] → γ+writeForm ∷ (ConvertibleStrings α Text, ConvertibleStrings β Text, ConvertibleStrings L.ByteString γ) ⇒ [(α, β)] → γ writeForm = fromLBS . mimeRender (Proxy ∷ Proxy FormUrlEncoded) . map (toST *** toST) -- | Decodes key-value data from application/x-www-form-urlencoded.-readForm ∷ (ConvertibleStrings Text α, ConvertibleStrings Text β, ConvertibleStrings γ LByteString) ⇒ γ → Maybe [(α, β)]+readForm ∷ (ConvertibleStrings Text α, ConvertibleStrings Text β, ConvertibleStrings γ L.ByteString) ⇒ γ → Maybe [(α, β)] readForm x = map (fromST *** fromST) <$> hush (mimeUnrender (Proxy ∷ Proxy FormUrlEncoded) $ toLBS x) -- | Reads a Servant incoming form as a list of key-value pairs (for use in FromForm instances).@@ -44,7 +50,7 @@ assignProp (Object o) ([k], v) = Object $ insertWith concatJSON k (toJSON [ v ]) o assignProp (Object o) (k : k' : ks, v) = Object $ insertWith (\_ o' → assignProp o' (k' : ks, v)) k (assignProp (object []) (k' : ks, v)) o assignProp x _ = x- concatJSON (Array v1) (Array v2) = Array $ v1 ++ v2+ concatJSON (Array v1) (Array v2) = Array $ v1 <> v2 concatJSON (Array v1) _ = Array v1 concatJSON _ (Array v2) = Array v2 concatJSON _ _ = Null@@ -58,7 +64,7 @@ void $ char ']' return s void $ option '_' $ char '[' >> char ']'- return $ firstKey : filter (not . null) restKeys+ return $ firstKey : S.filter (not . T.null) restKeys -- | Parses any string into a URI. parseUri ∷ ConvertibleStrings α String ⇒ α → URI@@ -70,18 +76,18 @@ -- >>> slugify "Hello & World!" -- "hello-and-world" slugify ∷ Text → Text-slugify = filter (not . isSpace) . intercalate "-" . words .+slugify = T.filter (not . isSpace) . T.intercalate "-" . T.words . T.replace "&" "and" . T.replace "+" "plus" . T.replace "%" "percent" . T.replace "<" "lt" . T.replace ">" "gt" . T.replace "=" "eq" . T.replace "#" "hash" . T.replace "@" "at" . T.replace "$" "dollar" .- filter (`onotElem` asString "!^*?()[]{}`./\\'\"~|") .+ T.filter (`onotElem` ("!^*?()[]{}`./\\'\"~|"::String)) . T.toLower . T.strip -- | Creates a simple text/plain ServantErr.-errText ∷ ServantErr → LByteString → ServantErr+errText ∷ ServantErr → L.ByteString → ServantErr errText e t = e { errHeaders = [ (hContentType, "text/plain; charset=utf-8") ] , errBody = t } -- | Creates and throws a simple text/plain ServantErr.-throwErrText ∷ MonadError ServantErr μ ⇒ ServantErr → LByteString → μ α+throwErrText ∷ MonadError ServantErr μ ⇒ ServantErr → L.ByteString → μ α throwErrText e t = throwError $ errText e t
library/Magicbane/Validation.hs view
@@ -1,13 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-} -- | Integrates the refinement types from the refined library with aeson. module Magicbane.Validation ( module Refined ) where --import ClassyPrelude import Refined import Data.Aeson
magicbane.cabal view
@@ -2,19 +2,19 @@ -- -- see: https://github.com/sol/hpack ----- hash: d745301cacd1d82cdb20fad978024069617cdb814742a11f1fda1ea280068d7b+-- hash: 88e201dd0d795d1b2f734fac496dffd6df8421151ab0e9b88379490a2d4c5bfa name: magicbane-version: 0.1.4-synopsis: A web framework that integrates Servant, ClassyPrelude, EKG, fast-logger, wai-cli…+version: 0.2.0+synopsis: A web framework that integrates Servant, 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, ClassyPrelude, 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, Aeson, EKG/monad-metrics, fast-logger/monad-logger, wai-cli and others. category: Web homepage: https://github.com/myfreeweb/magicbane#readme bug-reports: https://github.com/myfreeweb/magicbane/issues author: Greg V maintainer: greg@unrelenting.technology-copyright: 2017 Greg V <greg@unrelenting.technology>+copyright: 2017-2018 Greg V <greg@unrelenting.technology> license: PublicDomain tested-with: GHC==8.2.1 build-type: Simple@@ -31,9 +31,10 @@ build-depends: aeson , aeson-qq+ , async , attoparsec , base >=4.8.0.0 && <5- , classy-prelude+ , bytestring , conduit , conduit-combinators , data-default@@ -47,26 +48,25 @@ , http-client , http-client-tls , http-conduit- , http-date , http-link-header- , http-media , http-types , lifted-async- , mime-types+ , lifted-base , monad-control , monad-logger , monad-metrics+ , mono-traversable , mtl- , network , network-uri , raw-strings-qq , refined- , servant+ , safe-exceptions , servant-server , split , string-conversions , text , transformers+ , transformers-base , unordered-containers , wai , wai-cli@@ -80,5 +80,6 @@ Magicbane.HTTPClient Magicbane.Util other-modules:+ Magicbane.Async Paths_magicbane default-language: Haskell2010