Add UUID instances

Data/Aeson/Types/FromJSON.hs

@@ -123,6 +123,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as LT
 import qualified Data.Tree as Tree
+import qualified Data.UUID.Types as UUID
 import qualified Data.Vector as V
 import qualified Data.Vector.Generic as VG
 import qualified Data.Vector.Primitive as VP
@@ -1486,6 +1487,18 @@ instance (FromJSON v) => FromJSON (Tree.Tree v) where
     parseJSON = parseJSON1
     {-# INLINE parseJSON #-}
 
+-------------------------------------------------------------------------------
+-- uuid
+-------------------------------------------------------------------------------
+
+instance FromJSON UUID.UUID where
+    parseJSON = withText "UUID" $
+        maybe (fail "Invalid UUID") pure . UUID.fromText
+
+instance FromJSONKey UUID.UUID where
+    fromJSONKey = FromJSONKeyTextParser $
+        maybe (fail "Invalid UUID") pure . UUID.fromText
+
 -------------------------------------------------------------------------------
 -- vector
 -------------------------------------------------------------------------------

Data/Aeson/Types/ToJSON.hs

@@ -113,13 +113,17 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as LT
 import qualified Data.Tree as Tree
+import qualified Data.UUID.Types as UUID
 import qualified Data.Vector as V
 import qualified Data.Vector.Generic as VG
 import qualified Data.Vector.Mutable as VM
 import qualified Data.Vector.Primitive as VP
 import qualified Data.Vector.Storable as VS
 import qualified Data.Vector.Unboxed as VU
 
+import qualified Data.Aeson.Encoding.Builder as EB
+import qualified Data.ByteString.Builder as B
+
 #if !(MIN_VERSION_bytestring(0,10,0))
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Marshal.Utils (copyBytes)
@@ -1857,6 +1861,17 @@ instance (ToJSON v) => ToJSON (Tree.Tree v) where
     toEncoding = toEncoding1
     {-# INLINE toEncoding #-}
 
+-------------------------------------------------------------------------------
+-- uuid
+-------------------------------------------------------------------------------
+
+instance ToJSON UUID.UUID where
+    toJSON = toJSON . UUID.toText
+    toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
+
+instance ToJSONKey UUID.UUID where
+    toJSONKey = ToJSONKeyText UUID.toText $
+        E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes
 
 -------------------------------------------------------------------------------
 -- vector

aeson.cabal

@@ -117,6 +117,7 @@ library
     time >= 1.1.1.4,
     time-locale-compat >= 0.1.1 && < 0.2,
     unordered-containers >= 0.2.5.0,
+    uuid-types >= 1.0.3 && <1.1,
     vector >= 0.8
 
   if flag(bytestring-builder)
@@ -198,6 +199,7 @@ test-suite tests
     time,
     time-locale-compat,
     unordered-containers,
+    uuid-types,
     vector,
     quickcheck-instances >=0.3.12
 

benchmarks/aeson-benchmarks.cabal

@@ -53,6 +53,7 @@ library
     time,
     transformers,
     unordered-containers >= 0.2.3.0,
+    uuid-types >= 1.0.3 && <1.1,
     vector >= 0.7.1
 
   if flag(bytestring-builder)

tests/Instances.hs

@@ -25,6 +25,7 @@ import Test.QuickCheck (Arbitrary(..), elements,  oneof)
 import Types
 import qualified Data.DList as DList
 import qualified Data.HashMap.Strict as HM
+import qualified Data.UUID.Types as UUID
 
 #if !MIN_VERSION_QuickCheck(2,9,0)
 import Control.Applicative (Const(..))
@@ -218,3 +219,10 @@ makeVersion b = Version b []
 instance Arbitrary a => Arbitrary (Identity a) where
     arbitrary = Identity <$> arbitrary
 #endif
+
+instance Arbitrary UUID.UUID where
+    arbitrary = UUID.fromWords
+        <$> arbitrary
+        <*> arbitrary
+        <*> arbitrary
+        <*> arbitrary

tests/Properties.hs

@@ -41,6 +41,7 @@ import qualified Data.HashMap.Strict as H
 import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
+import qualified Data.UUID.Types as UUID
 import qualified Data.Vector as V
 
 encodeDouble :: Double -> Double -> Property
@@ -217,6 +218,7 @@ tests = testGroup "properties" [
     , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)
     , testProperty "Rational" $ roundTripEq (undefined :: Rational)
     , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
+    , testProperty "UUID" $ roundTripEq UUID.nil
     , testGroup "functors"
       [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)
 
@@ -278,6 +280,7 @@ tests = testGroup "properties" [
 #endif
     , testProperty "Version" $ roundTripKey (undefined :: Version)
     , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
+    , testProperty "UUID" $ roundTripKey UUID.nil
     ]
   , testGroup "toFromJSON" [
       testProperty "Integer" (toFromJSON :: Integer -> Property)

tests/UnitTests.hs

@@ -76,6 +76,7 @@ import qualified Data.Text.Lazy.Builder as TLB
 import qualified Data.Text.Lazy.Encoding as LT
 import qualified Data.Text.Lazy.Encoding as TLE
 import qualified Data.Tree as Tree
+import qualified Data.UUID.Types as UUID
 import qualified Data.Vector as Vector
 
 tests :: Test
@@ -369,6 +370,9 @@ jsonExamples =
   , Example "Pico" "3.14" (3.14 :: Pico)
   , Example "Scientific" "3.14" (3.14 :: Scientific)
 
+  , Example "UUID" "\"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"" $ UUID.fromWords
+      0xc2cc10e1 0x57d64b6f 0x989938d9 0x72112d8c
+
   , Example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)
   , Example "IntSet"  "[1,2,3]" (IntSet.fromList [3, 2, 1])
   , Example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)