apiary 1.4.2 → 1.4.3

raw patch · 12 files changed

+65/−46 lines, 12 filesdep ~HUnitdep ~basedep ~blaze-htmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HUnit, base, blaze-html, blaze-markup, bytestring-read, template-haskell

API changes (from Hackage documentation)

Files

• apiary.cabal +6/−7
• src/Control/Monad/Apiary/Action/Internal.hs +7/−3
• src/Control/Monad/Apiary/Filter.hs +10/−11
• src/Control/Monad/Apiary/Filter/Capture.hs +4/−4
• src/Control/Monad/Apiary/Filter/Internal.hs +1/−1
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +4/−5
• src/Control/Monad/Apiary/Internal.hs +5/−3
• src/Data/Apiary/Document/Internal.hs +3/−5
• src/Data/Apiary/Extension/Internal.hs +8/−0
• src/Data/Apiary/Param.hs +11/−6
• src/Web/Apiary/Heroku.hs +3/−0
• tests/Application.hs +3/−1

@@ -1,5 +1,5 @@ name:                apiary-version:             1.4.2+version:             1.4.3 synopsis:            Simple and type safe web framework that generate web API documentation. description:   Simple and type safe web framework that can be automatically generate API documentation.@@ -88,8 +88,8 @@                        Control.Monad.Apiary.Filter.Internal                        Control.Monad.Apiary.Action.Internal                        Control.Monad.Apiary.Filter.Internal.Capture.TH-  build-depends:       base                 >=4.6   && <4.8-                     , template-haskell     >=2.8   && <2.10+  build-depends:       base                 >=4.6   && <4.9+                     , template-haskell     >=2.8   && <2.11                       , transformers         >=0.2   && <0.5                      , transformers-base    >=0.4   && <0.5@@ -104,8 +104,8 @@                      , bytestring           >=0.10  && <0.11                      , bytestring-read      >=0.2   && <0.3                      , blaze-builder        >=0.3   && <0.5-                     , blaze-html           >=0.7   && <0.8-                     , blaze-markup         >=0.6   && <0.7+                     , blaze-html           >=0.7   && <0.9+                     , blaze-markup         >=0.6   && <0.8                      , case-insensitive     >=1.1   && <1.3                      , vault                >=0.3   && <0.4 @@ -122,7 +122,6 @@                      , web-routing          >=0.6   && <0.7                      , types-compat         >=0.1   && <0.2 -  default-extensions:  OverlappingInstances   hs-source-dirs:      src   ghc-options:         -O2 -Wall   ghc-prof-options:    -O2 -Wall -auto-all@@ -133,7 +132,7 @@   other-modules:       Application                      , Method   type:                exitcode-stdio-1.0-  build-depends:       base                      >=4.6   && <4.8+  build-depends:       base                      >=4.6   && <4.9                      , mtl                       >=2.1   && <2.3                      , tasty                     >=0.10  && <0.11                      , tasty-hunit               >=0.9   && <0.10

@@ -94,7 +94,12 @@  import qualified System.PosixCompat.Files as Files +#if MIN_VERSION_base(4,8,0)+import Control.Applicative (Alternative(..))+#else+import Data.Monoid(Monoid(..)) import Control.Applicative (Applicative(..), Alternative(..), (<$>))+#endif import Control.Monad (MonadPlus(..), liftM) import Control.Monad.Trans(MonadIO(..), MonadTrans(..)) import Control.Monad.Base(MonadBase(..), liftBaseDefault)@@ -111,7 +116,6 @@ import qualified Network.Wai as Wai import qualified Network.Wai.Parse as P -import Data.Monoid(Monoid(..), (<>)) import qualified Network.Routing.Dict as Dict import Data.Apiary.Param(Param, File(..)) import Data.Apiary.SProxy(SProxy(..))@@ -178,7 +182,7 @@  instance Monoid ResponseBody where     mempty = ResponseBuilder mempty-    ResponseBuilder a `mappend` ResponseBuilder b = ResponseBuilder $ a <> b+    ResponseBuilder a `mappend` ResponseBuilder b = ResponseBuilder $ a `mappend` b     _ `mappend` b = b  toResponse :: ActionState -> Wai.Response@@ -694,7 +698,7 @@  -- | append response body from builder. since 1.2.0. appendBuilder :: Monad m => Builder -> ActionT exts prms m ()-appendBuilder b = modifyState (\s -> s { actionResponse = actionResponse s <> ResponseBuilder b } )+appendBuilder b = modifyState (\s -> s { actionResponse = actionResponse s `mappend` ResponseBuilder b } )  -- | append response body from strict bytestring. since 1.2.0. appendBytes :: Monad m => S.ByteString -> ActionT exts prms m ()

@@ -43,7 +43,6 @@ import Network.Wai.Parse (parseContentType, parseHttpAccept) import qualified Network.HTTP.Types as HTTP -import Control.Applicative((<$>)) import Control.Monad(mzero) import Control.Monad.Trans(MonadIO) @@ -112,7 +111,7 @@ -- | filter by 'Control.Monad.Apiary.Action.rootPattern' of 'Control.Monad.Apiary.Action.ApiaryConfig'. root :: (Monad m, Monad actM) => Filter' exts actM m root = focus DocRoot Nothing $ R.raw "ROOT" $ \d r -> do-    roots <- rootPattern <$> getConfig+    roots <- rootPattern `fmap` getConfig     case r of         [] -> return (d, [])         [p] | p `elem` roots -> return (d, [])@@ -160,7 +159,7 @@ -- [key|key|] =: pInt -- @ (=:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)-     => query k -> proxy v -> Filter exts actM m prms (k := v ': prms)+     => query k -> proxy v -> Filter exts actM m prms (k ':= v ': prms) k =: v = query k (pFirst v)  -- | get one matched paramerer. since 0.5.0.0.@@ -171,7 +170,7 @@ -- [key|key|] =!: pInt -- @ (=!:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)-      => query k -> proxy v -> Filter exts actM m prms (k := v ': prms)+      => query k -> proxy v -> Filter exts actM m prms (k ':= v ': prms) k =!: t = query k (pOne t)  -- | get optional first paramerer. since 0.5.0.0.@@ -182,7 +181,7 @@ -- [key|key|] =?: pInt -- @ (=?:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)-      => query k -> proxy v -> Filter exts actM m prms (k := Maybe v ': prms)+      => query k -> proxy v -> Filter exts actM m prms (k ':= Maybe v ': prms) k =?: t = query k (pOption t)  -- | get optional first paramerer with default. since 0.16.0.@@ -193,7 +192,7 @@ -- [key|key|] =!?: (0 :: Int) -- @ (=?!:) :: forall query k v exts prms actM m. (HasDesc query, MonadIO actM, Show v, ReqParam v, KnownSymbol k, k </ prms)-       => query k -> v -> Filter exts actM m prms (k := v ': prms)+       => query k -> v -> Filter exts actM m prms (k ':= v ': prms) k =?!: v = query k (pOptional v)  -- | get many paramerer. since 0.5.0.0.@@ -202,7 +201,7 @@ -- [key|key|] =*: pInt -- @ (=*:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)-      => query k -> proxy v -> Filter exts actM m prms (k := [v] ': prms)+      => query k -> proxy v -> Filter exts actM m prms (k ':= [v] ': prms) k =*: t = query k (pMany t)  -- | get some paramerer. since 0.5.0.0.@@ -211,12 +210,12 @@ -- [key|key|] =+: pInt -- @ (=+:) :: (HasDesc query, MonadIO actM, ReqParam v, KnownSymbol k, k </ prms)-      => query k -> proxy v -> Filter exts actM m prms (k := [v] ': prms)+      => query k -> proxy v -> Filter exts actM m prms (k ':= [v] ': prms) k =+: t = query k (pSome t)  -- | get existance of key only query parameter. since v0.17.0. switchQuery :: (HasDesc proxy, MonadIO actM, KnownSymbol k, k </ prms)-            => proxy k -> Filter exts actM m prms (k := Bool ': prms)+            => proxy k -> Filter exts actM m prms (k ':= Bool ': prms) switchQuery k = focus doc Nothing $ R.raw "switch" $ \d t -> do     qs      <- getQueryParams     (ps,fs) <- getRequestBody@@ -229,7 +228,7 @@  -- | filter by header and get first. since 0.6.0.0. header :: (KnownSymbol k, Monad actM, k </ prms)-       => proxy k -> Filter exts actM m prms (k := SC.ByteString ': prms)+       => proxy k -> Filter exts actM m prms (k ':= SC.ByteString ': prms) header k = focus doc Nothing $ R.raw "header" $ \d t -> do     n <- maybe mzero return . lookup (CI.mk . SC.pack $ symbolVal k) . Wai.requestHeaders =<< getRequest     return (Dict.add k n d, t)@@ -248,7 +247,7 @@ -- | require Accept header and set response Content-Type. since 0.16.0. accept :: Monad actM => ContentType -> Filter' exts actM m accept ect = focus (DocAccept ect) Nothing $ R.raw "accept" $ \d t ->-    (lookup "Accept" . Wai.requestHeaders <$> getRequest) >>= \case+    fmap (lookup "Accept" . Wai.requestHeaders) getRequest >>= \case         Nothing -> mzero         Just ac ->             let ex@(et, _) = parseContentType ect

@@ -31,12 +31,12 @@  -- | get first path and drill down. since 0.11.0. fetch' :: (k Dict.</ prms, KnownSymbol k, Path p, Monad actM) => proxy k -> proxy' p -> Maybe Html-       -> Filter exts actM m prms (k := p ': prms)+       -> Filter exts actM m prms (k ':= p ': prms) fetch' k p h = focus (DocFetch (T.pack $ symbolVal k) (pathRep p) h) Nothing $ R.fetch k (readPathAs p)  fetch :: forall proxy k p exts prms actM m. (k Dict.</ prms, KnownSymbol k, Path p, Monad actM)-      => proxy (k := p) -> Maybe Html-      -> Filter exts actM m prms (k := p ': prms)+      => proxy (k ':= p) -> Maybe Html+      -> Filter exts actM m prms (k ':= p ': prms) fetch _ h = fetch' k p h   where     k = Proxy :: Proxy k@@ -47,5 +47,5 @@  restPath :: (k Dict.</ prms, KnownSymbol k, Monad m, Monad actM)          => proxy k -> Maybe Html-         -> Filter exts actM m prms (k := [T.Text] ': prms)+         -> Filter exts actM m prms (k ':= [T.Text] ': prms) restPath k h = focus (DocRest (T.pack $ symbolVal k) h) Nothing (R.rest k)

@@ -34,7 +34,7 @@  -- | filter and append argument. function' :: (KnownSymbol key, Monad actM, key </ prms) => (Doc -> Doc) -> (Wai.Request -> Maybe (proxy key, prm))-          -> Filter exts actM m prms (key := prm ': prms)+          -> Filter exts actM m prms (key ':= prm ': prms) function' d f = function d $ \c r -> f r >>= \(k, p) -> return $ Dict.add k p c  -- | filter only(not modify arguments).

@@ -6,7 +6,6 @@ module Control.Monad.Apiary.Filter.Internal.Capture.TH(capture) where  import Control.Arrow(first)-import Control.Applicative((<$>))  import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote(QuasiQuoter(..))@@ -29,9 +28,9 @@ splitPath = map T.unpack . T.splitOn "/" . T.pack  description :: String -> TH.Q (String, TH.ExpQ)-description s = case break (`elem` "([") s of+description s = case break (`elem` ("([" :: String)) s of     (t, []) -> return (t, [|Nothing|])-    (t, st) -> case break (`elem` ")]") st of+    (t, st) -> case break (`elem` (")]" :: String)) st of         (_:'$':b, ")") -> do             TH.reportWarning "DEPRECATED () description. use []."             v <- TH.lookupValueName b@@ -51,8 +50,8 @@     (k, d) <- description tS     [|Capture.restPath (SProxy :: SProxy $(TH.litT $ TH.strTyLit k)) $d . $(mkCap as) |] mkCap (str:as)-    | "::" `isInfixOf` fst (break (`elem` "([") str) = do-        (key, d) <- first T.pack <$> description str+    | "::" `isInfixOf` fst (break (`elem` ("([" :: String)) str) = do+        (key, d) <- first T.pack `fmap` description str         let v = T.unpack . T.strip . fst $ T.breakOn    "::" key             t = T.unpack . T.strip . snd $ T.breakOnEnd "::" key         ty <- TH.lookupTypeName t >>= maybe (fail $ t ++ " not found.") return

@@ -35,7 +35,10 @@  import qualified Network.Wai as Wai +#if !MIN_VERSION_base(4,8,0)+import Data.Monoid(Monoid(..)) import Control.Applicative(Applicative(..), (<$>))+#endif import Control.Monad(liftM) import Control.Monad.Trans(MonadIO(liftIO), MonadTrans(lift)) import Control.Monad.Trans.Control@@ -54,7 +57,6 @@ import Data.Apiary.Extension ( Has, MonadExts(..), getExt, noExtension ) import Data.Apiary.Extension.Internal(Initializer(..), allMiddleware, allMiddleware') import Data.Apiary.Document.Internal(Doc(..), docsToDocuments)-import Data.Monoid(Monoid(..), (<>))  import Text.Blaze.Html(Html) import qualified Data.Text as T@@ -150,7 +152,7 @@     mf <*> ma = ApiaryT $ \env cont ->         unApiaryT mf env $ \f hdr  ->         unApiaryT ma env $ \a hdr' ->-        let hdr'' = hdr <> hdr'+        let hdr'' = hdr `mappend` hdr'         in hdr'' `seq` cont (f a) hdr''  instance Monad actM => Monad (ApiaryT exts prms actM m) where@@ -158,7 +160,7 @@     m >>= k = ApiaryT $ \env cont ->         unApiaryT    m  env $ \a hdr  ->         unApiaryT (k a) env $ \b hdr' -> -        let hdr'' = hdr <> hdr'+        let hdr'' = hdr `mappend` hdr'         in hdr'' `seq` cont b hdr''  instance Monad actM => MonadTrans (ApiaryT exts prms actM) where

@@ -12,8 +12,6 @@     , docsToDocuments     ) where -import Control.Applicative((<$>))- import Data.Typeable(TypeRep) import Data.Maybe(mapMaybe) import Data.List(groupBy)@@ -100,9 +98,9 @@  docToDocument :: Doc -> Maybe (Maybe T.Text, PathDoc) docToDocument = \case-    (DocGroup "" d') -> (Nothing,) <$> loop initialToDocumentState d'-    (DocGroup g  d') -> (Just  g,) <$> loop initialToDocumentState d'-    d'               -> (Nothing,) <$> loop initialToDocumentState d'+    (DocGroup "" d') -> (Nothing,) `fmap` loop initialToDocumentState d'+    (DocGroup g  d') -> (Just  g,) `fmap` loop initialToDocumentState d'+    d'               -> (Nothing,) `fmap` loop initialToDocumentState d'   where     loop st (DocDropNext       d) = loop st (dropNext d)     loop st (DocPath         p d) = loop st { toDocumentPath = toDocumentPath st . Path p } d

@@ -7,6 +7,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif+ module Data.Apiary.Extension.Internal     ( Initializer(..)     , Has(..)@@ -28,7 +32,11 @@ instance Has a (a ': as) where     getExtension _ (AddExtension a _) = a +#if __GLASGOW_HASKELL__ >= 710+instance {-# OVERLAPPABLE #-} Has a as => Has a (a' ': as) where+#else instance Has a as => Has a (a' ': as) where+#endif     getExtension p (AddExtension _ as) = getExtension p as  newtype Initializer m i o = Initializer 

@@ -7,6 +7,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-}  module Data.Apiary.Param     ( -- * route path parameter@@ -55,7 +56,11 @@ import qualified Network.HTTP.Types as HTTP  import Data.Int(Int8, Int16, Int32, Int64)+#if MIN_VERSION_base(4,8,0)+import Data.Word(Word8, Word16, Word32, Word64)+#else import Data.Word(Word, Word8, Word16, Word32, Word64)+#endif import Data.Maybe(isJust, catMaybes) import Network.Routing.Dict(KV((:=)), type (</), Store) import qualified Network.Routing.Dict as Dict@@ -338,34 +343,34 @@  data First a = First instance Strategy First where-    type SNext First k a ps = k := a ': ps+    type SNext First k a ps = k ':= a ': ps     strategy _ k (Just a:_) d = return $ Dict.add k a d     strategy _ _ _          _ = mzero     strategyRep _ = StrategyRep "first"  data One a = One instance Strategy One where-    type SNext One k a ps = k := a ': ps+    type SNext One k a ps = k ':= a ': ps     strategy _ k [Just a] d = return $ Dict.add k a d     strategy _ _ _        _ = mzero     strategyRep _ = StrategyRep "one"  data Many a = Many instance Strategy Many where-    type SNext Many k a ps = k := [a] ': ps+    type SNext Many k a ps = k ':= [a] ': ps     strategy _ k as d = if all isJust as then return $ Dict.add k (catMaybes as) d else mzero     strategyRep _ = StrategyRep "many"  data Some a = Some instance Strategy Some where-    type SNext Some k a ps = k := [a] ': ps+    type SNext Some k a ps = k ':= [a] ': ps     strategy _ _ [] _ = mzero     strategy _ k as d = if all isJust as then return $ Dict.add k (catMaybes as) d else mzero     strategyRep _ = StrategyRep "some"  data Option a = Option instance Strategy Option where-    type SNext Option k a ps = k := Maybe a ': ps+    type SNext Option k a ps = k ':= Maybe a ': ps     strategy _ k (Just a:_)  d = return $ Dict.add k (Just a) d     strategy _ _ (Nothing:_) _ = mzero     strategy _ k []          d = return $ Dict.add k Nothing d@@ -373,7 +378,7 @@  data Optional a = Optional T.Text a instance Strategy Optional where-    type SNext Optional k a ps = k := a ': ps+    type SNext Optional k a ps = k ':= a ': ps     strategy _              k (Just a:_)  d = return $ Dict.add k a d     strategy _              _ (Nothing:_) _ = mzero     strategy (Optional _ a) k []          d = return $ Dict.add k a d

@@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-}  module Web.Apiary.Heroku     ( Heroku@@ -25,7 +26,9 @@  import Control.Exception(catch, try, SomeException) import Control.Arrow(second)+#if !MIN_VERSION_base(4,8,0) import Control.Applicative((<$>), (<$), Applicative(..))+#endif import Control.Monad.Trans(MonadIO(..))  import Data.IORef(IORef, newIORef, readIORef, writeIORef)

@@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE QuasiQuotes #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE DataKinds #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}  module Application(test) where