apiary 0.9.0.0 → 0.10.0

raw patch · 3 files changed

+67/−41 lines, 3 filesdep ~wai-extradep ~wai-testPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: wai-extra, wai-test

API changes (from Hackage documentation)

Files

• apiary.cabal +7/−4
• src/Control/Monad/Apiary/Action.hs +6/−0
• src/Control/Monad/Apiary/Action/Internal.hs +54/−37

@@ -1,5 +1,5 @@ name:                apiary-version:             0.9.0.0+version:             0.10.0 synopsis:            Simple web framework inspired by scotty. description:   Simple web framework inspired by scotty.@@ -52,7 +52,7 @@  flag wai3   description: use wai-3.0-  default: False+  default: True  library   exposed-modules:     Web.Apiary@@ -90,12 +90,15 @@                      , bytestring         >=0.10 && <0.11                      , blaze-builder      >=0.3 && <0.4                      , data-default-class >=0.0 && <0.1-                     , tagged             >=0.7 && <0.8                      , reflection         >=1.4 && <1.5                       , http-types        >=0.8 && <0.9                      , mime-types        >=0.1 && <0.2                      , exceptions        >=0.6 && <0.7++  if impl(ghc < 7.8)+    build-depends:     tagged             >=0.7 && <0.8+   if flag(wai3)     build-depends:     wai               >=3.0 && <3.1                      , wai-extra         >=3.0 && <3.1@@ -120,7 +123,7 @@                      , http-types           >=0.8  && <0.9   if flag(wai3)     build-depends:     wai               >=3.0 && <3.1-                     , wai-test          >=3.0 && <3.1+                     , wai-extra         >=3.0 && <3.1   else     build-depends:     wai               >=2.1 && <2.2                      , wai-test          >=2.0 && <2.1

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Control.Monad.Apiary.Action      (       ActionT@@ -22,7 +24,11 @@     , builder     , lbs     , stream+    , response++#ifndef WAI3     , StreamingBody+#endif      -- ** monolithic action     -- *** redirect

@@ -7,6 +7,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}  module Control.Monad.Apiary.Action.Internal where @@ -61,36 +62,24 @@  data ActionState      = ActionState-        { actionStatus  :: Status-        , actionHeaders :: ResponseHeaders-        , actionBody    :: Body-        , actionReqBody :: Maybe ([Param], [File L.ByteString])+        { actionResponse :: Response+        , actionStatus   :: Status+        , actionHeaders  :: ResponseHeaders+        , actionReqBody  :: Maybe ([Param], [File L.ByteString])         } +initialState :: ApiaryConfig -> ActionState+initialState conf = ActionState+    { actionResponse = responseLBS (defaultStatus conf) (defaultHeader conf) ""+    , actionStatus   = defaultStatus conf+    , actionHeaders  = defaultHeader conf+    , actionReqBody  = Nothing+    }+ #ifndef WAI3 type StreamingBody = Source IO (Flush Builder) #endif -data Body -    = File FilePath (Maybe FilePart)-    | Builder Builder-    | LBS L.ByteString-    | Str StreamingBody--actionStateToResponse :: ActionState -> Response-actionStateToResponse as = case actionBody as of-    File f p  -> responseFile st hd f p-    Builder b -> responseBuilder st hd b-    LBS l     -> responseLBS st hd l-#ifdef WAI3-    Str    s  -> responseStream st hd s-#else-    Str    s  -> responseSource st hd s-#endif-  where-    st = actionStatus  as-    hd = actionHeaders as- data Action a      = Continue a     | Pass@@ -134,11 +123,26 @@     throwM e = ActionT $ \_ _ st cont ->         throwM e >>= \a -> cont a st +instance MonadCatch m => MonadCatch (ActionT m) where+    catch m h = actionT $ \conf req st -> +        catch (runActionT m conf req st) (\e -> runActionT (h e) conf req st)++instance MonadMask m => MonadMask (ActionT m) where+    mask a = actionT $ \conf req st ->+        mask $ \u -> runActionT (a $ q u) conf req st+      where+        q u m = actionT $ \conf req st -> u (runActionT m conf req st)+    uninterruptibleMask a = actionT $ \conf req st ->+        uninterruptibleMask $ \u -> runActionT (a $ q u) conf req st+      where+        q u m = actionT $ \conf req st -> u (runActionT m conf req st)+ runActionT :: Monad m => ActionT m a            -> ApiaryConfig -> Request -> ActionState            -> m (Action (a, ActionState)) runActionT m conf req st = unActionT m conf req st $ \a st' ->     st' `seq` return (Continue (a, st'))+{-# INLINE runActionT #-}  actionT :: Monad m          => (ApiaryConfig -> Request -> ActionState -> m (Action (a, ActionState)))@@ -147,6 +151,7 @@     Pass             -> return Pass     Stop s           -> return $ Stop s     Continue (a,st') -> st' `seq` cont a st'+{-# INLINE actionT #-}  -- | n must be Monad, so cant be MFunctor. hoistActionT :: (Monad m, Monad n)@@ -156,19 +161,15 @@ execActionT :: ApiaryConfig -> ActionT IO () -> Application  #ifdef WAI3-execActionT config m request send = runActionT m config request resp >>= \case+execActionT config m request send = runActionT m config request (initialState config) >>= \case         Pass           -> notFound config request send         Stop s         -> send s-        Continue (_,r) -> send $ actionStateToResponse r-  where-    resp = ActionState (defaultStatus config) (defaultHeader config) (LBS "") Nothing+        Continue (_,r) -> send $ actionResponse r #else-execActionT config m request = runActionT m config request resp >>= \case+execActionT config m request = runActionT m config request (initialState config) >>= \case         Pass           -> notFound config request         Stop s         -> return s-        Continue (_,r) -> return $ actionStateToResponse r-  where-    resp = ActionState (defaultStatus config) (defaultHeader config) (LBS "") Nothing+        Continue (_,r) -> return $ actionResponse r #endif  instance (Monad m, Functor m) => Alternative (ActionT m) where@@ -202,7 +203,7 @@  -- | stop handler and send current state. since 0.3.3.0. stop :: Monad m => ActionT m a-stop = ActionT $ \_ _ s _ -> return $ Stop (actionStateToResponse s)+stop = ActionT $ \_ _ s _ -> return $ Stop (actionResponse s)  -- | stop with response. since 0.4.2.0. stopWith :: Monad m => Response -> ActionT m a@@ -318,21 +319,37 @@     contentType (mime f)     file' f p +-- | Raw response constructor. since 0.10.+--+-- example(use pipes-wai)+--+-- @+-- producer :: Monad m => Producer (Flush Builder) IO () -> ActionT m ()+-- producer = response (\s h -> responseProducer s h)+-- @+--+response :: Monad m => (Status -> ResponseHeaders -> Response) -> ActionT m ()+response f = modifyState (\s -> s { actionResponse = f (actionStatus s) (actionHeaders s)} )+ -- | set response body file content, without set Content-Type. since 0.1.0.0. file' :: Monad m => FilePath -> Maybe FilePart -> ActionT m ()-file' f p = modifyState (\s -> s { actionBody = File f p } )+file' f p = response (\s h -> responseFile s h f p)  -- | set response body builder. since 0.1.0.0. builder :: Monad m => Builder -> ActionT m ()-builder b = modifyState (\s -> s { actionBody = Builder b } )+builder b = response (\s h -> responseBuilder s h b)  -- | set response body lazy bytestring. since 0.1.0.0. lbs :: Monad m => L.ByteString -> ActionT m ()-lbs l = modifyState (\s -> s { actionBody = LBS l } )+lbs l = response (\s h -> responseLBS s h l)  -- | set response body source. since 0.9.0.0. stream :: Monad m => StreamingBody -> ActionT m ()-stream str = modifyState (\s -> s { actionBody = Str str })+#ifdef WAI3+stream str = response (\s h -> responseStream s h str)+#else+stream str = response (\s h -> responseSource s h str)+#endif  {-# DEPRECATED source "use stream" #-} source :: Monad m => StreamingBody -> ActionT m ()