git.iko.soy/typeable/http-api-data
on master help sign in
Merge pull request #34 from phadej/uuid

Add UUID instances

commit9ac24657aca220eeb60f618655bf679960075220 authorNickolay Kudasov <fizruk@users.noreply.github.com> dateMon 26 Sep 2016, 14:29 (10 years ago) parentdde6af32c31981
8 files changed+59−45
compare with master
unifiedsplit
CHANGELOG.md+6 http-api-data.cabal+5−2 src/Web/Internal/HttpApiData.hs+9 stack-ghc-7.10.yaml+2−1 stack-ghc-7.8.yaml+3 stack.yaml+2−1 test/Web/Internal/HttpApiDataSpec.hs+31−4 test/Web/Internal/TestInstances.hs+1−37
CHANGELOG.md+6
@@ -1,3 +1,9 @@
1+0.3.1
2+---
3+
4+* Minor changes
5+ * Add instances for `Data.UUID`
6+
170.3
28---
39* Major changes:
http-api-data.cabal+5−2
@@ -1,5 +1,5 @@
11name: http-api-data
2−version: 0.3
2+version: 0.3.1
33license: BSD3
44license-file: LICENSE
55author: Nickolay Kudasov <nickolay.kudasov@gmail.com>
@@ -33,6 +33,7 @@ library
3333 , time-locale-compat >=0.1.1.0 && <0.2
3434 , unordered-containers
3535 , uri-bytestring
36+ , uuid-types >= 1.0.2 && <1.1
3637 if flag(use-text-show)
3738 cpp-options: -DUSE_TEXT_SHOW
3839 build-depends: text-show >= 2
@@ -58,12 +59,14 @@ test-suite spec
5859 , hspec >= 1.3
5960 , base >= 4 && < 5
6061 , bytestring
61− , QuickCheck
62+ , QuickCheck >=2.9
63+ , quickcheck-instances >= 0.3.12
6264 , unordered-containers
6365 , http-api-data
6466 , text
6567 , time
6668 , bytestring
69+ , uuid
6770
6871test-suite doctest
6972 ghc-options: -Wall
src/Web/Internal/HttpApiData.hs+9
@@ -46,6 +46,8 @@ import Text.ParserCombinators.ReadP (readP_to_S)
4646import TextShow (TextShow, showt)
4747#endif
4848
49+import qualified Data.UUID.Types as UUID
50+
4951-- $setup
5052-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
5153-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
@@ -577,3 +579,10 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)
577579 Left _ <!> y = y
578580 x <!> _ = x
579581
582+instance ToHttpApiData UUID.UUID where
583+ toUrlPiece = UUID.toText
584+ toHeader = UUID.toASCIIBytes
585+
586+instance FromHttpApiData UUID.UUID where
587+ parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
588+ parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
stack-ghc-7.10.yaml+2−1
@@ -7,5 +7,6 @@ flags:
77 http-api-data:
88 use-text-show: false
99
10−extra-deps: []
10+extra-deps:
11+- QuickCheck-2.9.2
1112extra-package-dbs: []
stack-ghc-7.8.yaml+3
@@ -20,4 +20,7 @@ extra-deps:
2020- base-orphans-0.5.4
2121- generic-deriving-1.9.0
2222- doctest-0.11.0
23+- QuickCheck-2.9.2
24+- quickcheck-instances-0.3.12
25+- quickcheck-io-0.1.3
2326extra-package-dbs: []
stack.yaml+2−1
@@ -7,5 +7,6 @@ flags:
77 http-api-data:
88 use-text-show: false
99
10−extra-deps: []
10+extra-deps:
11+- QuickCheck-2.9.2
1112extra-package-dbs: []
test/Web/Internal/HttpApiDataSpec.hs+31−4
@@ -2,6 +2,7 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33module Web.Internal.HttpApiDataSpec (spec) where
44
5+import Control.Applicative
56import Data.Int
67import Data.Word
78import Data.Time
@@ -9,6 +10,7 @@ import qualified Data.Text as T
910import qualified Data.Text.Lazy as L
1011import qualified Data.ByteString as BS
1112import Data.Version
13+import qualified Data.UUID as UUID
1214
1315import Data.Proxy
1416
@@ -30,6 +32,10 @@ import Web.Internal.TestInstances
3032checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
3133checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool)
3234
35+-- | Check with given generator
36+checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec
37+checkUrlPiece' gen name = prop name $ forAll gen (toUrlPiece <=> parseUrlPiece)
38+
3339-- | Check case insensitivity for @parseUrlPiece@.
3440checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec
3541checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a))
@@ -56,11 +62,12 @@ spec = do
5662 checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict"
5763 checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy"
5864 checkUrlPiece (Proxy :: Proxy Day) "Day"
59− checkUrlPiece (Proxy :: Proxy LocalTime) "LocalTime"
60− checkUrlPiece (Proxy :: Proxy ZonedTime) "ZonedTime"
61− checkUrlPiece (Proxy :: Proxy UTCTime) "UTCTime"
62− checkUrlPiece (Proxy :: Proxy NominalDiffTime) "NominalDiffTime"
65+ checkUrlPiece' localTimeGen "LocalTime"
66+ checkUrlPiece' zonedTimeGen "ZonedTime"
67+ checkUrlPiece' utcTimeGen "UTCTime"
68+ checkUrlPiece' nominalDiffTimeGen "NominalDiffTime"
6369 checkUrlPiece (Proxy :: Proxy Version) "Version"
70+ checkUrlPiece' uuidGen "UUID"
6471
6572 checkUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String"
6673 checkUrlPieceI (Proxy :: Proxy (Maybe Integer)) "Maybe Integer"
@@ -80,3 +87,23 @@ spec = do
8087
8188 it "invalid utf8 is handled" $ do
8289 parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text)
90+
91+uuidGen :: Gen UUID.UUID
92+uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
93+
94+-- TODO: this generators don't generate full range items
95+localTimeGen :: Gen LocalTime
96+localTimeGen = LocalTime
97+ <$> arbitrary
98+ <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
99+
100+zonedTimeGen :: Gen ZonedTime
101+zonedTimeGen = ZonedTime
102+ <$> localTimeGen -- Note: not arbitrary!
103+ <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
104+
105+utcTimeGen :: Gen UTCTime
106+utcTimeGen = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
107+
108+nominalDiffTimeGen :: Gen NominalDiffTime
109+nominalDiffTimeGen = fromInteger <$> arbitrary
test/Web/Internal/TestInstances.hs+1−37
@@ -9,58 +9,22 @@ module Web.Internal.TestInstances
99 ) where
1010
1111import Control.Applicative
12−import qualified Data.ByteString.Lazy.Char8 as BSL
1312import Data.Char
1413import qualified Data.HashMap.Strict as HashMap
1514import qualified Data.Text as T
16−import qualified Data.Text.Lazy as L
1715import Data.Time
18−import Data.Version
1916import GHC.Exts (fromList)
2017import GHC.Generics
2118
2219import Test.QuickCheck
20+import Test.QuickCheck.Instances ()
2321
2422import Web.Internal.FormUrlEncoded
2523import Web.Internal.HttpApiData
2624
27−instance Arbitrary T.Text where
28− arbitrary = T.pack <$> arbitrary
29−
30−instance Arbitrary L.Text where
31− arbitrary = L.pack <$> arbitrary
32−
33−instance Arbitrary BSL.ByteString where
34− arbitrary = BSL.pack <$> arbitrary
35−
36−instance Arbitrary Day where
37− arbitrary = liftA3 fromGregorian (fmap abs arbitrary) arbitrary arbitrary
38−
39−instance Arbitrary LocalTime where
40− arbitrary = LocalTime
41− <$> arbitrary
42− <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60))
43−
4425instance Eq ZonedTime where
4526 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
4627
47−instance Arbitrary ZonedTime where
48− arbitrary = ZonedTime
49− <$> arbitrary
50− <*> liftA3 TimeZone arbitrary arbitrary (vectorOf 3 (elements ['A'..'Z']))
51−
52−instance Arbitrary UTCTime where
53− arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
54−
55−instance Arbitrary NominalDiffTime where
56− arbitrary = fromInteger <$> arbitrary
57−
58−instance Arbitrary Version where
59− arbitrary = (version . map abs) <$> nonempty
60− where
61− version branch = Version branch []
62− nonempty = liftA2 (:) arbitrary arbitrary
63−
6428instance Arbitrary Form where
6529 arbitrary = fromList <$> arbitrary
6630