diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 1.4.0 +* remove Data.Apiary.Compat module +* remove bytestring-lexing(and alex) dependency + # 1.3.0 * new router(web-routing package) * new dictionary diff --git a/apiary.cabal b/apiary.cabal --- a/apiary.cabal +++ b/apiary.cabal @@ -1,5 +1,5 @@ name: apiary -version: 1.3.0 +version: 1.4.0 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. @@ -38,11 +38,11 @@ . * Type safe route filter. . - * Auto generate API documentation(example: ). + * Auto generate API documentation(example: ). . - more examples: + more examples: . - live demo: (source code: ) + live demo: (source code: ) license: MIT license-file: LICENSE @@ -76,12 +76,12 @@ Data.Apiary.Extension Data.Apiary.Param Data.Apiary.Method - Data.Apiary.Compat Data.Apiary.Document Data.Apiary.Document.Html other-modules: Web.Apiary.TH Network.Wai.Parse + Data.Apiary.SProxy Data.Apiary.Document.Internal Data.Apiary.Extension.Internal Control.Monad.Apiary.Internal @@ -95,15 +95,15 @@ , transformers-base >=0.4 && <0.5 , mtl >=2.1 && <2.3 , monad-control >=0.3 && <1.1 - , exceptions >=0.6 && <0.7 + , exceptions >=0.6 && <0.9 , http-types >=0.8 && <0.9 , mime-types >=0.1 && <0.2 , text >=1.1 && <1.3 , bytestring >=0.10 && <0.11 - , bytestring-lexing >=0.4 && <0.5 - , blaze-builder >=0.3 && <0.4 + , bytestring-read >=0.2 && <0.3 + , blaze-builder >=0.3 && <0.5 , blaze-html >=0.7 && <0.8 , blaze-markup >=0.6 && <0.7 , case-insensitive >=1.1 && <1.3 @@ -119,7 +119,8 @@ , wai >=3.0 && <3.1 , stringsearch >=0.3 && <0.4 - , web-routing >=0.4 && <0.5 + , web-routing >=0.6 && <0.7 + , types-compat >=0.1 && <0.2 default-extensions: OverlappingInstances hs-source-dirs: src @@ -127,17 +128,16 @@ ghc-prof-options: -O2 -Wall -auto-all default-language: Haskell2010 -test-suite test-framework +test-suite tasty main-is: main.hs other-modules: Application , Method type: exitcode-stdio-1.0 build-depends: base >=4.6 && <4.8 , mtl >=2.1 && <2.3 - , QuickCheck >=1.2 && <1.3 - , test-framework >=0.8 && <0.9 - , test-framework-hunit >=0.3 && <0.4 - , test-framework-quickcheck >=0.3 && <0.4 + , tasty >=0.10 && <0.11 + , tasty-hunit >=0.9 && <0.10 + , tasty-quickcheck >=0.8 && <0.9 , apiary , bytestring >=0.10 && <0.11 , http-types >=0.8 && <0.9 diff --git a/src/Control/Monad/Apiary/Action/Internal.hs b/src/Control/Monad/Apiary/Action/Internal.hs --- a/src/Control/Monad/Apiary/Action/Internal.hs +++ b/src/Control/Monad/Apiary/Action/Internal.hs @@ -114,7 +114,7 @@ import Data.Monoid(Monoid(..), (<>)) import qualified Network.Routing.Dict as Dict import Data.Apiary.Param(Param, File(..)) -import Data.Apiary.Compat(SProxy(..)) +import Data.Apiary.SProxy(SProxy(..)) import Data.Apiary.Document(Documents) import Data.Apiary.Document.Html(defaultDocumentToHtml, DefaultDocumentConfig(..)) import Data.Default.Class(Default(..)) diff --git a/src/Control/Monad/Apiary/Filter.hs b/src/Control/Monad/Apiary/Filter.hs --- a/src/Control/Monad/Apiary/Filter.hs +++ b/src/Control/Monad/Apiary/Filter.hs @@ -66,7 +66,9 @@ import qualified Data.Text as T import qualified Data.CaseInsensitive as CI import Data.Monoid((<>)) -import Data.Apiary.Compat(KnownSymbol, Symbol, symbolVal, Proxy(..), SProxy(..)) +import Data.Proxy.Compat(Proxy(..)) +import GHC.TypeLits.Compat(KnownSymbol, Symbol, symbolVal) +import Data.Apiary.SProxy(SProxy(..)) import Network.Routing.Dict(type ( [String] preCap "" = [] diff --git a/src/Data/Apiary/Compat.hs b/src/Data/Apiary/Compat.hs deleted file mode 100644 --- a/src/Data/Apiary/Compat.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE CPP #-} - --- | compatibility module for ghc-7.8 & ghc-7.6. -module Data.Apiary.Compat - ( -- * type level string literal - Symbol, KnownSymbol, symbolVal - , SProxy(..) - - -- * Data.Typeables - , module Data.Typeable -#if !MIN_VERSION_base(4,7,0) - , typeRep - , Proxy(..) -#endif - ) where - -import GHC.TypeLits -import Data.Typeable -#if !MIN_VERSION_base(4,7,0) - -typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep -typeRep _ = typeOf (undefined :: a) -{-# INLINE typeRep #-} - -type KnownSymbol (n :: Symbol) = SingRep n String - -symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String -symbolVal _ = fromSing (sing :: Sing n) -{-# INLINE symbolVal #-} - -data Proxy (a :: k) = Proxy -#endif - --- | Symbol Proxy for ghc-7.6 Template Haskell. -data SProxy (a :: Symbol) = SProxy diff --git a/src/Data/Apiary/Param.hs b/src/Data/Apiary/Param.hs --- a/src/Data/Apiary/Param.hs +++ b/src/Data/Apiary/Param.hs @@ -59,11 +59,11 @@ import Data.Maybe(isJust, catMaybes) import Network.Routing.Dict(KV((:=)), type ( a -> Bool jsToBool = flip notElem jsFalse @@ -180,13 +179,13 @@ _ -> Nothing readBSInt :: Integral a => S.ByteString -> Maybe a -readBSInt = readBS (SL.readSigned SL.readDecimal) +readBSInt = readBS (SL.signed SL.integral) readBSWord :: Integral a => S.ByteString -> Maybe a -readBSWord = readBS SL.readDecimal +readBSWord = readBS SL.integral readBSDouble :: S.ByteString -> Maybe Double -readBSDouble = readBS SL.readDouble +readBSDouble = readBS (SL.signed SL.double) -- | javascript boolean. -- when \"false\", \"0\", \"-0\", \"\", \"null\", \"undefined\", \"NaN\" then False, else True. since 0.6.0.0. @@ -241,11 +240,11 @@ -- * 14.2.05 instance Query Day where readQuery = (>>= \s0 -> do - (y, s1) <- SL.readDecimal s0 + (y, s1) <- SL.integral s0 when (S.null s1) Nothing - (m, s2) <- SL.readDecimal (S.tail s1) + (m, s2) <- SL.integral $ S.tail s1 when (S.null s2) Nothing - (d, s3) <- SL.readDecimal (S.tail s2) + (d, s3) <- SL.integral $ S.tail s2 unless (S.null s3) Nothing let y' = if y < 100 then 2000 + y else y return $ fromGregorian y' m d) diff --git a/src/Data/Apiary/SProxy.hs b/src/Data/Apiary/SProxy.hs new file mode 100644 --- /dev/null +++ b/src/Data/Apiary/SProxy.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} + +module Data.Apiary.SProxy(SProxy(..)) where + +import GHC.TypeLits.Compat(Symbol) + +data SProxy (k :: Symbol) = SProxy diff --git a/src/Network/Wai/Parse.hs b/src/Network/Wai/Parse.hs --- a/src/Network/Wai/Parse.hs +++ b/src/Network/Wai/Parse.hs @@ -4,9 +4,10 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} + -- | Some helpers for parsing data out of a raw WAI 'Request'. -- --- copy from wai-extra 3.0.4.1. +-- copy from wai-extra 3.0.4.5. module Network.Wai.Parse ( parseHttpAccept diff --git a/src/Web/Apiary/Heroku.hs b/src/Web/Apiary/Heroku.hs --- a/src/Web/Apiary/Heroku.hs +++ b/src/Web/Apiary/Heroku.hs @@ -39,7 +39,7 @@ ( Has, Extension, Extensions, getExtension, noExtension , Initializer, Initializer', initializer', (+>) ) -import Data.Apiary.Compat(Proxy(..)) +import Data.Proxy.Compat(Proxy(..)) data Heroku = Heroku { herokuEnv :: IORef (Maybe (H.HashMap T.Text T.Text)) diff --git a/src/Web/Apiary/TH.hs b/src/Web/Apiary/TH.hs --- a/src/Web/Apiary/TH.hs +++ b/src/Web/Apiary/TH.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Web.Apiary.TH(key) where -import Data.Apiary.Compat(SProxy(..)) +import Data.Apiary.SProxy(SProxy(..)) import Language.Haskell.TH.Quote (QuasiQuoter(..)) import qualified Language.Haskell.TH as TH diff --git a/tests/Application.hs b/tests/Application.hs --- a/tests/Application.hs +++ b/tests/Application.hs @@ -5,8 +5,8 @@ module Application(test) where -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) +import Test.Tasty(TestTree, testGroup) +import Test.Tasty.HUnit(testCase) import Control.Monad(when) import Control.Monad.Identity(Identity(..)) @@ -20,7 +20,7 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as S -testReq :: String -> (Request -> IO ()) -> Test +testReq :: String -> (Request -> IO ()) -> TestTree testReq str f = let (meth, other) = break (== ' ') str (p, version) = break (== ' ') (tail other) @@ -61,7 +61,7 @@ contentType "text/plain" bytes "hello" -helloWorldAllTest :: Test +helloWorldAllTest :: TestTree helloWorldAllTest = testGroup "helloWorld" $ map ($ helloWorldApp) [ testReq "GET /" . assertPlain200 "hello" , testReq "GET /foo" . assert404 @@ -75,7 +75,7 @@ method "GET" . action $ contentType "text/plain" >> bytes "GET" method POST . action $ contentType "text/plain" >> bytes "POST" -methodFilterTest :: Test +methodFilterTest :: TestTree methodFilterTest = testGroup "methodFilter" $ map ($methodFilterApp) [ testReq "GET /" . assertPlain200 "GET" , testReq "POST /" . assertPlain200 "POST" @@ -91,7 +91,7 @@ http10 . action $ contentType "text/plain" >> bytes "10" http11 . action $ contentType "text/plain" >> bytes "11" -httpVersionTest :: Test +httpVersionTest :: TestTree httpVersionTest = testGroup "httpVersionFilter" $ map ($ httpVersionApp) [ testReq "GET / HTTP/0.9" . assertPlain200 "09" , testReq "GET / HTTP/1.0" . assertPlain200 "10" @@ -105,7 +105,7 @@ contentType "text/html" bytes "root" -rootFilterTest :: Test +rootFilterTest :: TestTree rootFilterTest = testGroup "rootFilter" $ map ($ rootFilterApp) [ testReq "GET /" . assertHtml200 "root" , testReq "POST /" . assertHtml200 "root" @@ -120,7 +120,7 @@ [capture|/test/**rest|] . action $ contentType "text/plain" >> param [key|rest|] >>= showing [capture|/test/neko|] . action $ contentType "text/plain" >> bytes "nyan" -restFilterTest :: Test +restFilterTest :: TestTree restFilterTest = testGroup "rest capture" $ map ($ restFilterApp) [ testReq "GET /" . assert404 , testReq "GET /test" . assertPlain200 "[]" @@ -139,7 +139,7 @@ [capture|/bar/s::L.ByteString/i::Int|] . action $ contentType "text/plain" >> param [key|s|] >>= lazyBytes >> appendChar ' ' >> param [key|i|] >>= appendShowing [capture|/s::L.ByteString|] . action $ contentType "text/plain" >> bytes "fall " >> param [key|s|] >>= appendLazyBytes -captureTest :: Test +captureTest :: TestTree captureTest = testGroup "capture" $ map ($ captureApp) [ testReq "GET /foo" . assertPlain200 "foo" , testReq "GET /12" . assertPlain200 "Int 12" @@ -164,7 +164,7 @@ ([key|foo|] =?!: ("bar" :: String)) . action $ contentType "text/plain" >> bytes "foo String " >> param [key|foo|] >>= appendShowing ([key|foo|] =?!: (Just "baz" :: Maybe String)) . action $ contentType "text/plain" >> bytes "foo Maybe String " >> param [key|foo|] >>= appendShowing -queryFirstTest :: Test +queryFirstTest :: TestTree queryFirstTest = testGroup "First" $ map ($ queryApp (=:) (=:) (=:)) [ testReq "GET /" . assert404 , testReq "GET /?foo" . assertPlain200 "foo Maybe String Nothing" @@ -175,7 +175,7 @@ , testReq "GET /?foo=12&foo=b" . assertPlain200 "foo Int 12" ] -queryOneTest :: Test +queryOneTest :: TestTree queryOneTest = testGroup "One" $ map ($ queryApp (=!:) (=!:) (=!:)) [ testReq "GET /" . assert404 , testReq "GET /?foo" . assertPlain200 "foo Maybe String Nothing" @@ -186,7 +186,7 @@ , testReq "GET /?foo=12&foo=b" . assert404 ] -queryOptionTest :: Test +queryOptionTest :: TestTree queryOptionTest = testGroup "Option" $ map ($ queryApp (=?:) (=?:) (=?:)) [ testReq "GET /" . assertPlain200 "foo Int Nothing" , testReq "GET /?foo" . assertPlain200 "foo Maybe String Just Nothing" @@ -197,7 +197,7 @@ , testReq "GET /?foo=12&foo=b" . assertPlain200 "foo Int Just 12" ] -queryOptionalTest :: Test +queryOptionalTest :: TestTree queryOptionalTest = testGroup "Optional" $ map ($ queryOptionalApp) [ testReq "GET /" . assertPlain200 "foo Int 5" , testReq "GET /?foo" . assertPlain200 "foo Maybe String Nothing" @@ -208,7 +208,7 @@ , testReq "GET /?foo=12&foo=b" . assertPlain200 "foo Int 12" ] -queryManyTest :: Test +queryManyTest :: TestTree queryManyTest = testGroup "Many" $ map ($ queryApp (=*:) (=*:) (=*:)) [ testReq "GET /" . assertPlain200 "foo Int []" , testReq "GET /?foo" . assertPlain200 "foo Maybe String [Nothing]" @@ -219,7 +219,7 @@ , testReq "GET /?foo=12&foo=b" . assertPlain200 "foo String [\"12\",\"b\"]" ] -querySomeTest :: Test +querySomeTest :: TestTree querySomeTest = testGroup "Some" $ map ($ queryApp (=+:) (=+:) (=+:)) [ testReq "GET /" . assert404 , testReq "GET /?foo" . assertPlain200 "foo Maybe String [Nothing]" @@ -237,7 +237,7 @@ param [key|foo|] >>= showing param [key|bar|] >>= appendShowing -switchQueryTest :: Test +switchQueryTest :: TestTree switchQueryTest = testGroup "switch" $ map ($ switchQueryApp) [ testReq "GET /" . assertPlain200 "FalseFalse" , testReq "GET /?foo" . assertPlain200 "TrueFalse" @@ -249,7 +249,7 @@ , testReq "GET /?foo=1&bar=0" . assertPlain200 "TrueFalse" ] -queryTest :: Test +queryTest :: TestTree queryTest = testGroup "query" [ queryFirstTest , queryOneTest @@ -271,7 +271,7 @@ when (i == 2) stop appendBytes "after stop" -stopTest :: Test +stopTest :: TestTree stopTest = testGroup "stop" $ map ($ stopApp) [ testReq "GET /a/0" . assertPlain200 "even\nafter stop" , testReq "GET /a/1" . assertPlain200 "one\nodd\nafter stop" @@ -288,7 +288,7 @@ accept "text/html" . action $ bytes "html" action $ bytes "other" -acceptTest :: Test +acceptTest :: TestTree acceptTest = testGroup "accept" $ map ($ acceptApp) [ testReq "GET / application/json" . (\a r -> assertJson200 "json" a $ addA "application/json" r) , testReq "GET / text/html" . (\a r -> assertHtml200 "html" a $ addA "text/html" r) @@ -314,7 +314,7 @@ method DELETE . action $ contentType "text/plain" >> bytes "DELETE ANY" -multipleFilter1Test :: Test +multipleFilter1Test :: TestTree multipleFilter1Test = testGroup "multiple test1: root, method" [ testReq "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App , testReq "POST /" $ assertHtml200 "POST /" multipleFilter1App @@ -324,7 +324,7 @@ -------------------------------------------------------------------------------- -test :: Test +test :: TestTree test = testGroup "Application" [ helloWorldAllTest , methodFilterTest diff --git a/tests/Method.hs b/tests/Method.hs --- a/tests/Method.hs +++ b/tests/Method.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module Method(test) where -import Test.Framework(Test, testGroup) -import Test.Framework.Providers.HUnit(testCase) +import Test.Tasty(TestTree, testGroup) +import Test.Tasty.HUnit(testCase) import Test.HUnit(assertBool) import Data.Apiary.Method @@ -21,7 +21,7 @@ , "PATCH" ] -test :: Test +test :: TestTree test = testGroup "Method" [ testCase "renderMethod . parseMethod == id" $ mapM_ (\s -> diff --git a/tests/main.hs b/tests/main.hs --- a/tests/main.hs +++ b/tests/main.hs @@ -1,11 +1,11 @@ -import Test.Framework +import Test.Tasty import qualified Application import qualified Method main :: IO () -main = defaultMain +main = defaultMain $ testGroup "/" [ Application.test , Method.test ]