Merge pull request #34 from phadej/uuid

Add UUID instances

Author: fizruk

CHANGELOG.md

@@ -1,3 +1,9 @@
+0.3.1
+---
+
+* Minor changes
+    * Add instances for `Data.UUID`
+
 0.3
 ---
 * Major changes:

http-api-data.cabal

@@ -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 @@ library
                    , 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 @@ test-suite spec
                    , 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

@@ -46,6 +46,8 @@ import Text.ParserCombinators.ReadP (readP_to_S)
 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 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)
       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

stack-ghc-7.10.yaml

@@ -7,5 +7,6 @@ flags:
   http-api-data:
     use-text-show: false
 
-extra-deps: []
+extra-deps:
+- QuickCheck-2.9.2
 extra-package-dbs: []

stack-ghc-7.8.yaml

@@ -20,4 +20,7 @@ extra-deps:
 - base-orphans-0.5.4
 - generic-deriving-1.9.0
 - doctest-0.11.0
+- QuickCheck-2.9.2
+- quickcheck-instances-0.3.12
+- quickcheck-io-0.1.3
 extra-package-dbs: []

stack.yaml

@@ -7,5 +7,6 @@ flags:
   http-api-data:
     use-text-show: false
 
-extra-deps: []
+extra-deps:
+- QuickCheck-2.9.2
 extra-package-dbs: []

test/Web/Internal/HttpApiDataSpec.hs

@@ -2,13 +2,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Web.Internal.HttpApiDataSpec (spec) where
 
+import Control.Applicative
 import Data.Int
 import Data.Word
 import Data.Time
 import qualified Data.Text as T
 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 @@ import Web.Internal.TestInstances
 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 @@ spec = do
     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 @@ spec = do
 
   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

@@ -9,58 +9,22 @@ module Web.Internal.TestInstances
    ) 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