http-api-data 0.3 → 0.3.1
raw patch · 5 files changed
+52/−43 lines, 5 filesdep +quickcheck-instancesdep +uuiddep +uuid-typesdep ~QuickCheck
Dependencies added: quickcheck-instances, uuid, uuid-types
Dependency ranges changed: QuickCheck
Files
- CHANGELOG.md +6/−0
- http-api-data.cabal +5/−2
- src/Web/Internal/HttpApiData.hs +9/−0
- test/Web/Internal/HttpApiDataSpec.hs +31/−4
- test/Web/Internal/TestInstances.hs +1/−37
CHANGELOG.md view
@@ -1,3 +1,9 @@+0.3.1+---++* Minor changes+ * Add instances for `Data.UUID`+ 0.3 --- * Major changes:
http-api-data.cabal view
@@ -1,5 +1,5 @@ name: http-api-data-version: 0.3+version: 0.3.1 license: BSD3 license-file: LICENSE author: Nickolay Kudasov <nickolay.kudasov@gmail.com>@@ -33,6 +33,7 @@ , time-locale-compat >=0.1.1.0 && <0.2 , unordered-containers , uri-bytestring+ , uuid-types >= 1.0.2 && <1.1 if flag(use-text-show) cpp-options: -DUSE_TEXT_SHOW build-depends: text-show >= 2@@ -58,12 +59,14 @@ , hspec >= 1.3 , base >= 4 && < 5 , bytestring- , QuickCheck+ , QuickCheck >=2.9+ , quickcheck-instances >= 0.3.12 , unordered-containers , http-api-data , text , time , bytestring+ , uuid test-suite doctest ghc-options: -Wall
src/Web/Internal/HttpApiData.hs view
@@ -46,6 +46,8 @@ import TextShow (TextShow, showt) #endif +import qualified Data.UUID.Types as UUID+ -- $setup -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p@@ -577,3 +579,10 @@ Left _ <!> y = y x <!> _ = x +instance ToHttpApiData UUID.UUID where+ toUrlPiece = UUID.toText+ toHeader = UUID.toASCIIBytes++instance FromHttpApiData UUID.UUID where+ parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText+ parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
test/Web/Internal/HttpApiDataSpec.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Web.Internal.HttpApiDataSpec (spec) where +import Control.Applicative import Data.Int import Data.Word import Data.Time@@ -9,6 +10,7 @@ import qualified Data.Text.Lazy as L import qualified Data.ByteString as BS import Data.Version+import qualified Data.UUID as UUID import Data.Proxy @@ -30,6 +32,10 @@ checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool) +-- | Check with given generator+checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)+ -- | Check case insensitivity for @parseUrlPiece@. checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))@@ -56,11 +62,12 @@ checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" checkUrlPiece (Proxy :: Proxy Day) "Day"- checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"- checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"- checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"- checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"+ checkUrlPiece' localTimeGen "LocalTime"+ checkUrlPiece' zonedTimeGen "ZonedTime"+ checkUrlPiece' utcTimeGen "UTCTime"+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime" checkUrlPiece (Proxy :: Proxy Version) "Version"+ checkUrlPiece' uuidGen "UUID" checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"@@ -80,3 +87,23 @@ it "invalid utf8 is handled" $ do parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)++uuidGen :: Gen UUID.UUID+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++-- TODO: this generators don't generate full range items+localTimeGen :: Gen LocalTime+localTimeGen = LocalTime+ <$> arbitrary+ <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))++zonedTimeGen :: Gen ZonedTime+zonedTimeGen = ZonedTime+ <$> localTimeGen -- Note: not arbitrary!+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))++utcTimeGen :: Gen UTCTime+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))++nominalDiffTimeGen :: Gen NominalDiffTime+nominalDiffTimeGen = fromInteger <$> arbitrary
test/Web/Internal/TestInstances.hs view
@@ -9,57 +9,21 @@ ) where import Control.Applicative-import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Char import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as T-import qualified Data.Text.Lazy as L import Data.Time-import Data.Version import GHC.Exts (fromList) import GHC.Generics import Test.QuickCheck+import Test.QuickCheck.Instances () import Web.Internal.FormUrlEncoded import Web.Internal.HttpApiData -instance Arbitrary T.Text where- arbitrary = T.pack <$> arbitrary--instance Arbitrary L.Text where- arbitrary = L.pack <$> arbitrary--instance Arbitrary BSL.ByteString where- arbitrary = BSL.pack <$> arbitrary--instance Arbitrary Day where- arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary--instance Arbitrary LocalTime where- arbitrary = LocalTime- <$> arbitrary- <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))- instance Eq ZonedTime where ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y--instance Arbitrary ZonedTime where- arbitrary = ZonedTime- <$> arbitrary- <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))--instance Arbitrary UTCTime where- arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))--instance Arbitrary NominalDiffTime where- arbitrary = fromInteger <$> arbitrary--instance Arbitrary Version where- arbitrary = (version . map abs) <$> nonempty- where- version branch = Version branch []- nonempty = liftA2 (:) arbitrary arbitrary instance Arbitrary Form where arbitrary = fromList <$> arbitrary