haskell-works · AlexeyRaga · Feb 17, 2020 · Feb 13, 2020
diff --git a/README.md b/README.md
@@ -26,6 +26,7 @@ This library provides the following conversions between Haskell types and Avro t
 | ByteString        | "bytes"                         |
 | Maybe a           | ["null", "a"]                   |
 | Either a b        | ["a", "b"]                      |
+| Identity a        | ["a"]                           |
 | Map Text a        | {"type": "map", "value": "a"}   |
 | Map String a      | {"type": "map", "value": "a"}   |
 | HashMap Text a    | {"type": "map", "value": "a"}   |

diff --git a/src/Data/Avro/Decode/Lazy/FromLazyAvro.hs b/src/Data/Avro/Decode/Lazy/FromLazyAvro.hs
@@ -6,6 +6,7 @@ module Data.Avro.Decode.Lazy.FromLazyAvro
 
 where
 
+import           Control.Monad.Identity          (Identity(..))
 import           Control.Arrow                   (first)
 import           Data.Avro.Decode.Lazy.LazyValue as T
 import qualified Data.Avro.Encode                as E
@@ -44,6 +45,13 @@ class HasAvroSchema a => FromLazyAvro a where
     Nothing -> fail $ "Requested field not available: " <> show key
     Just v  -> fromLazyAvro v
 
+instance (FromLazyAvro a) => FromLazyAvro (Identity a) where
+  fromLazyAvro e@(T.Union _ branch x)
+    | S.matches branch sch = Identity  <$> fromLazyAvro x
+    | otherwise            = badValue e "Identity"
+    where Tagged sch = schema :: Tagged a Schema
+  fromLazyAvro x = badValue x "Identity"
+
 instance (FromLazyAvro a, FromLazyAvro b) => FromLazyAvro (Either a b) where
   fromLazyAvro e@(T.Union _ branch x)
     | S.matches branch schemaA = Left  <$> fromLazyAvro x

diff --git a/src/Data/Avro/Deriving.hs b/src/Data/Avro/Deriving.hs
@@ -33,15 +33,16 @@ module Data.Avro.Deriving
 )
 where
 
-import           Control.Monad      (join)
-import           Data.Aeson         (eitherDecode)
-import qualified Data.Aeson         as J
-import           Data.Avro          hiding (decode, encode)
-import           Data.Avro.Schema   as S
-import qualified Data.Avro.Types    as AT
-import           Data.ByteString    (ByteString)
-import qualified Data.ByteString    as B
-import           Data.Char          (isAlphaNum)
+import           Control.Monad          (join)
+import           Control.Monad.Identity (Identity)
+import           Data.Aeson             (eitherDecode)
+import qualified Data.Aeson             as J
+import           Data.Avro              hiding (decode, encode)
+import           Data.Avro.Schema       as S
+import qualified Data.Avro.Types        as AT
+import           Data.ByteString        (ByteString)
+import qualified Data.ByteString        as B
+import           Data.Char              (isAlphaNum)
 import           Data.Int
 import           Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty as NE
@@ -515,14 +516,17 @@ mkFieldTypeName namespaceBehavior = \case
   t                  -> error $ "Avro type is not supported: " <> show t
   where go = mkFieldTypeName namespaceBehavior
         union = \case
+          []              ->
+            error "Empty union types are not supported"
+          [x]             -> [t| Identity $(go x) |]
           [Null, x]       -> [t| Maybe $(go x) |]
           [x, Null]       -> [t| Maybe $(go x) |]
           [x, y]          -> [t| Either $(go x) $(go y) |]
           [a, b, c]       -> [t| Either3 $(go a) $(go b) $(go c) |]
           [a, b, c, d]    -> [t| Either4 $(go a) $(go b) $(go c) $(go d) |]
           [a, b, c, d, e] -> [t| Either5 $(go a) $(go b) $(go c) $(go d) $(go e) |]
-          _               ->
-            error "Unions with more than 5 elements are not yet supported"
+          ls              ->
+            error $ "Unions with more than 5 elements are not yet supported: Union has " <> (show . length) ls <> " elements"
 
 updateFirst :: (Text -> Text) -> Text -> Text
 updateFirst f t =

diff --git a/src/Data/Avro/FromAvro.hs b/src/Data/Avro/FromAvro.hs
@@ -8,6 +8,7 @@ module Data.Avro.FromAvro
 where
 
 import           Control.Arrow           (first)
+import           Control.Monad.Identity  (Identity(..))
 import qualified Data.Avro.Encode        as E
 import           Data.Avro.HasAvroSchema
 import           Data.Avro.Schema        as S
@@ -43,6 +44,13 @@ class HasAvroSchema a => FromAvro a where
     Nothing -> fail $ "Requested field not available: " <> show key
     Just v  -> fromAvro v
 
+instance (FromAvro a) => FromAvro (Identity a) where
+  fromAvro e@(T.Union _ branch x)
+    | S.matches branch sch = Identity <$> fromAvro x
+    | otherwise            = badValue e "Identity"
+    where Tagged sch = schema :: Tagged a Schema
+  fromAvro x = badValue x "Identity"
+
 instance (FromAvro a, FromAvro b) => FromAvro (Either a b) where
   fromAvro e@(T.Union _ branch x)
     | S.matches branch schemaA = Left  <$> fromAvro x
@@ -146,4 +154,3 @@ instance (FromAvro a) => FromAvro (HashMap.HashMap Text a) where
   fromAvro (T.Record _ mp) = mapM fromAvro mp
   fromAvro (T.Map mp)      = mapM fromAvro mp
   fromAvro v               = badValue v "HashMap Text a"
-
diff --git a/src/Data/Avro/HasAvroSchema.hs b/src/Data/Avro/HasAvroSchema.hs
@@ -3,21 +3,22 @@
 {-# LANGUAGE ScopedTypeVariables  #-}
 module Data.Avro.HasAvroSchema where
 
-import qualified Data.Array           as Ar
-import           Data.Avro.Schema     as S
-import           Data.Avro.Types      as T
+import           Control.Monad.Identity  (Identity)
+import qualified Data.Array              as Ar
+import           Data.Avro.Schema        as S
+import           Data.Avro.Types         as T
 import           Data.Avro.Types.Decimal as D
-import qualified Data.ByteString      as B
-import           Data.ByteString.Lazy (ByteString)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.HashMap.Strict  as HashMap
+import qualified Data.ByteString         as B
+import           Data.ByteString.Lazy    (ByteString)
+import qualified Data.ByteString.Lazy    as BL
+import qualified Data.HashMap.Strict     as HashMap
 import           Data.Int
-import           Data.Ix              (Ix)
-import           Data.List.NonEmpty   (NonEmpty (..))
-import qualified Data.Map             as Map
-import           Data.Monoid          ((<>))
+import           Data.Ix                (Ix)
+import           Data.List.NonEmpty     (NonEmpty (..))
+import qualified Data.Map               as Map
+import           Data.Monoid            ((<>))
 import           Data.Proxy
-import qualified Data.Set             as S
+import qualified Data.Set               as S
 import           Data.Tagged
 import           Data.Text            (Text)
 import qualified Data.Text            as Text
@@ -103,6 +104,9 @@ instance HasAvroSchema Time.DiffTime where
 instance HasAvroSchema Time.UTCTime where
   schema = Tagged $ S.Long (Just TimestampMicros)
 
+instance (HasAvroSchema a) => HasAvroSchema (Identity a) where
+  schema = Tagged $ S.Union $ V.fromListN 1 [untag (schema :: Tagged a Schema)]
+
 instance (HasAvroSchema a, HasAvroSchema b) => HasAvroSchema (Either a b) where
   schema = Tagged $ S.Union $ V.fromListN 2 [untag (schema :: Tagged a Schema), untag (schema :: Tagged b Schema)]
 

diff --git a/src/Data/Avro/ToAvro.hs b/src/Data/Avro/ToAvro.hs
@@ -5,6 +5,7 @@ module Data.Avro.ToAvro
 
 where
 
+import           Control.Monad.Identity  (Identity(..))
 import           Control.Arrow           (first)
 import           Data.Avro.HasAvroSchema
 import           Data.Avro.Schema        as S
@@ -81,6 +82,12 @@ instance ToAvro Time.Day where
 instance ToAvro Time.DiffTime where
   toAvro = T.Long . fromIntegral . diffTimeToMicros
 
+instance (ToAvro a) => ToAvro (Identity a) where
+  toAvro e@(Identity a) =
+    let sch = options (schemaOf e)
+    in
+      T.Union sch (schemaOf a) (toAvro a)
+
 instance (ToAvro a, ToAvro b) => ToAvro (Either a b) where
   toAvro e =
     let sch = options (schemaOf e)

diff --git a/test/Avro/JSONSpec.hs b/test/Avro/JSONSpec.hs
@@ -6,9 +6,10 @@ module Avro.JSONSpec where
 
 import Control.Monad (forM_)
 
-import qualified Data.Aeson           as Aeson
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Map             as Map
+import           Control.Monad.Identity (Identity (..))
+import qualified Data.Aeson             as Aeson
+import qualified Data.ByteString.Lazy   as LBS
+import qualified Data.Map               as Map
 
 import Data.Avro.Deriving
 import Data.Avro.EitherN
@@ -75,6 +76,7 @@ spec = describe "Avro.JSONSpec: JSON serialization/parsing" $ do
         , unionsRecords     = Left $ Foo { fooStuff = "stuff" }
         , unionsSameFields  = Left $ Foo { fooStuff = "foo stuff" }
         , unionsArrayAndMap = Left ["foo"]
+        , unionsOne         = Identity 42
         , unionsThree       = E3_1 37
         , unionsFour        = E4_2 "foo"
         , unionsFive        = E5_4 $ Foo { fooStuff = "foo stuff" }
@@ -87,6 +89,7 @@ spec = describe "Avro.JSONSpec: JSON serialization/parsing" $ do
                                           }
         , unionsSameFields  = Right $ NotFoo { notFooStuff = "not foo stuff" }
         , unionsArrayAndMap = Right $ Map.fromList [("a", 5)]
+        , unionsOne         = Identity 42
         , unionsThree       = E3_3 37
         , unionsFour        = E4_4 $ Foo { fooStuff = "foo stuff" }
         , unionsFive        = E5_5 $ NotFoo { notFooStuff = "not foo stuff" }

diff --git a/test/Avro/THUnionSpec.hs b/test/Avro/THUnionSpec.hs
@@ -7,15 +7,17 @@ where
 
 import qualified Data.List.NonEmpty as NE
 
-import qualified Data.Aeson           as Aeson
+
+import           Control.Monad.Identity (Identity (..))
+import qualified Data.Aeson             as Aeson
 import           Data.Avro
 import           Data.Avro.Deriving
 import           Data.Avro.EitherN
-import qualified Data.Avro.Schema     as Schema
-import qualified Data.Avro.Types      as Avro
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Map             as Map
-import qualified Data.Vector          as V
+import qualified Data.Avro.Schema       as Schema
+import qualified Data.Avro.Types        as Avro
+import qualified Data.ByteString.Lazy   as LBS
+import qualified Data.Map               as Map
+import qualified Data.Vector            as V
 
 import System.Directory (doesFileExist)
 
@@ -33,6 +35,7 @@ spec = describe "Avro.THUnionSpec: Schema with unions." $ do
         , unionsRecords     = Left $ Foo { fooStuff = "stuff" }
         , unionsSameFields  = Left $ Foo { fooStuff = "more stuff" }
         , unionsArrayAndMap = Left ["foo"]
+        , unionsOne         = Identity 42
         , unionsThree       = E3_1 37
         , unionsFour        = E4_2 "foo"
         , unionsFive        = E5_4 $ Foo { fooStuff = "foo stuff" }
@@ -45,6 +48,7 @@ spec = describe "Avro.THUnionSpec: Schema with unions." $ do
                                           }
         , unionsSameFields  = Right $ NotFoo { notFooStuff = "different from Foo" }
         , unionsArrayAndMap = Right $ Map.fromList [("a", 5)]
+        , unionsOne         = Identity 42
         , unionsThree       = E3_3 37
         , unionsFour        = E4_4 $ Foo { fooStuff = "foo stuff" }
         , unionsFive        = E5_5 $ NotFoo { notFooStuff = "not foo stuff" }
@@ -64,6 +68,7 @@ spec = describe "Avro.THUnionSpec: Schema with unions." $ do
         , field "sameFields"  (Schema.mkUnion (NE.fromList [foo, notFooSchema]))          Nothing
         , field "arrayAndMap" (Schema.mkUnion (NE.fromList [array, map]))                 Nothing
 
+        , field "one"   (Schema.mkUnion (NE.fromList [Schema.Int']))                                          Nothing
         , field "three" (Schema.mkUnion (NE.fromList [Schema.Int', Schema.String', Schema.Long']))              Nothing
         , field "four"  (Schema.mkUnion (NE.fromList [Schema.Int', Schema.String', Schema.Long', foo]))         Nothing
         , field "five"  (Schema.mkUnion (NE.fromList [Schema.Int', Schema.String', Schema.Long', foo, notFoo])) Nothing

diff --git a/test/data/unions-object-a.json b/test/data/unions-object-a.json
@@ -16,6 +16,7 @@
   "arrayAndMap" : {
     "array" : ["foo"]
   },
+  "one": { "int": 42 },
   "three": { "int": 37 },
   "four": { "string": "foo" },
   "five": {

diff --git a/test/data/unions-object-b.json b/test/data/unions-object-b.json
@@ -21,6 +21,7 @@
   "arrayAndMap" : {
     "map" : { "a" : 5 }
   },
+  "one": { "int": 42 },
   "three": { "long": 37 },
   "four": {
     "haskell.avro.example.Foo": { "stuff" : "foo stuff" }

diff --git a/test/data/unions.avsc b/test/data/unions.avsc
@@ -54,6 +54,7 @@
         }
       ]
     },
+    { "name" : "one", "type" : ["int"] },
     { "name" : "three", "type" : ["int", "string", "long"] },
     { "name" : "four", "type" : ["int", "string", "long", "Foo"] },
     { "name" : "five", "type" : ["int", "string", "long", "Foo", "NotFoo"] }