apiary 1.0.0 → 1.1.0
raw patch · 7 files changed
+63/−32 lines, 7 files
Files
- CHANGELOG.md +4/−0
- apiary.cabal +4/−4
- src/Control/Monad/Apiary/Action/Internal.hs +33/−18
- src/Control/Monad/Apiary/Internal.hs +2/−2
- src/Data/Apiary/Extension.hs +6/−5
- src/Data/Apiary/Extension/Internal.hs +12/−3
- src/Web/Apiary/Heroku.hs +2/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.1.0+* Added Extension class. now Extension can add middleware.+* Added apiary-helics submodule.+ # 1.0.0 * included named parameter. motivation:
apiary.cabal view
@@ -1,5 +1,5 @@ name: apiary-version: 1.0.0+version: 1.1.0 synopsis: Simple and type safe web framework that can be automatically generate API documentation. description: Simple and type safe web framework that can be automatically generate API documentation.@@ -32,15 +32,15 @@ 404 Page Notfound. @ .- * High performance(benchmark: <https://github.com/philopon/apiary-benchmark/tree/v1.0.0>).+ * High performance(benchmark: <https://github.com/philopon/apiary-benchmark>). . * Nestable route handling(Apiary Monad; capture, method and more.). . * Type safe route filter. .- * Auto generate API documentation(example: <https://github.com/philopon/apiary/blob/v1.0.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v1.0.0/examples/api.html>).+ * Auto generate API documentation(example: <https://github.com/philopon/apiary/blob/v1.1.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v1.1.0/examples/api.html>). .- more examples: <https://github.com/philopon/apiary/blob/v1.0.0/examples/>+ more examples: <https://github.com/philopon/apiary/blob/v1.1.0/examples/> . live demo: <http://best-haskell.herokuapp.com/> (source code: <https://github.com/philopon/best-haskell>)
src/Control/Monad/Apiary/Action/Internal.hs view
@@ -69,6 +69,7 @@ , defaultStatus :: Status -- | initial headers. , defaultHeaders :: ResponseHeaders+ , defaultContentType :: S.ByteString , failStatus :: Status , failHeaders :: ResponseHeaders -- | used by 'Control.Monad.Apiary.Filter.root' filter.@@ -95,6 +96,7 @@ { notFound = defaultNotFound , defaultStatus = ok200 , defaultHeaders = []+ , defaultContentType = "text/plain" , failStatus = internalServerError500 , failHeaders = [] , rootPattern = ["index.html", "index.htm"]@@ -115,34 +117,37 @@ ResponseBuilder a `mappend` ResponseBuilder b = ResponseBuilder $ a <> b _ `mappend` b = b - toResponse :: ActionState -> Response toResponse ActionState{..} = case actionResponse of- ResponseFile f p -> responseFile actionStatus actionHeaders f p- ResponseBuilder b -> responseBuilder actionStatus actionHeaders b+ ResponseFile f p -> responseFile actionStatus headers f p+ ResponseBuilder b -> responseBuilder actionStatus headers b #ifdef WAI3- ResponseStream s -> responseStream actionStatus actionHeaders s+ ResponseStream s -> responseStream actionStatus headers s #else- ResponseStream s -> responseSource actionStatus actionHeaders s+ ResponseStream s -> responseSource actionStatus headers s #endif ResponseRaw f r -> responseRaw f r- ResponseFunc f -> f actionStatus actionHeaders+ ResponseFunc f -> f actionStatus headers+ where+ headers = ("Content-Type", actionContentType) : actionHeaders data ActionState = ActionState- { actionResponse :: ResponseBody- , actionStatus :: Status- , actionHeaders :: ResponseHeaders- , actionReqBody :: Maybe ([Param], [File])- , actionFetches :: [T.Text]+ { actionResponse :: ResponseBody+ , actionStatus :: Status+ , actionHeaders :: ResponseHeaders+ , actionContentType :: S.ByteString+ , actionReqBody :: Maybe ([Param], [File])+ , actionFetches :: [T.Text] } initialState :: ApiaryConfig -> ActionState initialState conf = ActionState- { actionResponse = ResponseBuilder mempty- , actionStatus = defaultStatus conf- , actionHeaders = defaultHeaders conf- , actionReqBody = Nothing- , actionFetches = []+ { actionResponse = ResponseBuilder mempty+ , actionStatus = defaultStatus conf+ , actionHeaders = defaultHeaders conf+ , actionContentType = defaultContentType conf+ , actionReqBody = Nothing+ , actionFetches = [] } {-# INLINE initialState #-} @@ -242,6 +247,8 @@ unActionT' mf env st $ \f !st' -> unActionT' ma env st' $ \a !st'' -> cont (f a) st''+ {-# INLINE pure #-}+ {-# INLINE (<*>) #-} instance Monad m => Monad (ActionT' exts m) where return x = ActionT' $ \_ !st cont -> cont x st@@ -250,6 +257,8 @@ unActionT' (k a) env st' cont fail s = ActionT' $ \(ActionEnv{actionConfig = c}) _ _ -> return $ Stop (responseLBS (failStatus c) (failHeaders c) $ LC.pack s)+ {-# INLINE return #-}+ {-# INLINE (>>=) #-} instance (Monad m, Functor m) => Alternative (ActionT' exts m) where empty = mzero@@ -440,24 +449,30 @@ getHeaders = requestHeaders `liftM` getRequest -- | modify response header. since 0.1.0.0.+--+-- Don't set Content-Type using this function. Use @contentType@. modifyHeader :: Monad m => (ResponseHeaders -> ResponseHeaders) -> ActionT exts prms m () modifyHeader f = modifyState (\s -> s {actionHeaders = f $ actionHeaders s } ) -- | add response header. since 0.1.0.0.+--+-- Don't set Content-Type using this function. Use @contentType@. addHeader :: Monad m => HeaderName -> S.ByteString -> ActionT exts prms m () addHeader h v = modifyHeader ((h,v):) -- | set response headers. since 0.1.0.0.+--+-- Don't set Content-Type using this function. Use @contentType@. setHeaders :: Monad m => ResponseHeaders -> ActionT exts prms m () setHeaders hs = modifyHeader (const hs) type ContentType = S.ByteString -- | set content-type header.+-- -- if content-type header already exists, replace it. since 0.1.0.0. contentType :: Monad m => ContentType -> ActionT exts prms m ()-contentType c = modifyHeader- (\h -> ("Content-Type", c) : filter (("Content-Type" /=) . fst) h)+contentType c = modifyState (\s -> s { actionContentType = c } ) --------------------------------------------------------------------------------
src/Control/Monad/Apiary/Internal.hs view
@@ -158,9 +158,9 @@ wtr <- unApiaryT m (initialEnv conf exts) (\_ w -> return w) let doc = docsToDocuments $ writerDoc wtr [] rtr = writerRouter wtr emptyRouter- mw = writerMw wtr+ mw = allMiddleware exts . writerMw wtr app = mw $ execActionT' conf exts doc (hoistActionT' runAct $ routerToAction rtr)- run app+ run $! app runApiaryWith :: Monad m => (Application -> m a)
src/Data/Apiary/Extension.hs view
@@ -5,6 +5,7 @@ module Data.Apiary.Extension ( Has(getExtension)+ , Extension(..) , Extensions , noExtension -- * initializer constructor@@ -21,22 +22,22 @@ type Initializer' m a = forall i. Initializer m i (a ': i) -addExtension :: e -> Extensions es -> Extensions (e ': es)+addExtension :: Extension e => e -> Extensions es -> Extensions (e ': es) addExtension = AddExtension -initializer :: Monad m => (Extensions es -> m e) -> Initializer m es (e ': es)+initializer :: (Extension e, Monad m) => (Extensions es -> m e) -> Initializer m es (e ': es) initializer m = Initializer $ \es n -> do e <- m es n (addExtension e es) -initializer' :: Monad m => m e -> Initializer' m e+initializer' :: (Extension e, Monad m) => m e -> Initializer' m e initializer' m = initializer (const m) -initializerBracket :: (forall a. Extensions es -> (e -> m a) -> m a) -> Initializer m es (e ': es)+initializerBracket :: Extension e => (forall a. Extensions es -> (e -> m a) -> m a) -> Initializer m es (e ': es) initializerBracket b = Initializer $ \es n -> b es $ \e -> n (addExtension e es) -initializerBracket' :: (forall a. (e -> m a) -> m a) -> Initializer m es (e ': es)+initializerBracket' :: Extension e => (forall a. (e -> m a) -> m a) -> Initializer m es (e ': es) initializerBracket' m = initializerBracket (const m) -- | combine two Initializer. since 0.16.0.
src/Data/Apiary/Extension/Internal.hs view
@@ -10,11 +10,12 @@ module Data.Apiary.Extension.Internal where -import Control.Category+import Network.Wai+import qualified Control.Category as Cat data Extensions (es :: [*]) where NoExtension :: Extensions '[]- AddExtension :: (e :: *) -> Extensions es -> Extensions (e ': es)+ AddExtension :: Extension e => (e :: *) -> Extensions es -> Extensions (e ': es) class Has a (as :: [*]) where getExtension :: proxy a -> Extensions as -> a@@ -28,8 +29,16 @@ newtype Initializer m i o = Initializer {unInitializer :: forall a. Extensions i -> (Extensions o -> m a) -> m a} +class Extension a where+ extMiddleware :: a -> Middleware+ extMiddleware _ = id++allMiddleware :: Extensions es -> Middleware+allMiddleware NoExtension = id+allMiddleware (AddExtension e es) = extMiddleware e . allMiddleware es+ #if __GLASGOW_HASKELL__ >= 708-instance Monad m => Category (Initializer m) where+instance Monad m => Cat.Category (Initializer m) where id = Initializer $ \es m -> m es Initializer a . Initializer b = Initializer $ \e m -> b e (\e' -> a e' m) #endif
src/Web/Apiary/Heroku.hs view
@@ -41,6 +41,8 @@ , herokuConfig :: HerokuConfig } +instance Extension Heroku+ data HerokuConfig = HerokuConfig { defaultPort :: Int , herokuExecutableName :: String