avro 0.3.0.2 → 0.3.0.3
raw patch · 4 files changed
+68/−41 lines, 4 files
Files
- avro.cabal +3/−2
- src/Data/Avro/Deriving.hs +1/−1
- src/Data/Avro/Deriving/NormSchema.hs +43/−38
- test/Avro/NormSchemaSpec.hs +21/−0
avro.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d00924760f916aaff838af8858aa0535e6b78f32409c94cd4ca2258f7b68f921+-- hash: 759fe76ae3c64abc46a255c2a85695fd7860adbf99c1d5d0190e76189fc0f949 name: avro-version: 0.3.0.2+version: 0.3.0.3 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell category: Data@@ -116,6 +116,7 @@ Avro.DefaultsSpec Avro.EncodeRawSpec Avro.JSONSpec+ Avro.NormSchemaSpec Avro.THEncodeContainerSpec Avro.THEnumSpec Avro.THReusedSpec
src/Data/Avro/Deriving.hs view
@@ -19,7 +19,7 @@ import Data.Avro.Schema as S import qualified Data.Avro.Types as AT import Data.ByteString (ByteString)-import qualified Data.ByteString as B+import qualified Data.ByteString as B import Data.Char (isAlphaNum) import Data.Int import Data.List.NonEmpty (NonEmpty ((:|)))
src/Data/Avro/Deriving/NormSchema.hs view
@@ -1,16 +1,18 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} module Data.Avro.Deriving.NormSchema where -import Data.Avro.Schema-import qualified Data.Set as S-import Data.List.NonEmpty (NonEmpty( (:|) )) import Control.Monad.State.Strict-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.List as L-import Data.Maybe (catMaybes, fromMaybe)-import Data.Semigroup ((<>))+import Data.Avro.Schema+import qualified Data.List as L+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.Map.Strict as M+import Data.Maybe (catMaybes, fromMaybe)+import Data.Semigroup ((<>))+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T -- | Extracts all the records from the schema (flattens the schema) -- Named types get resolved when needed to include at least one "inlined"@@ -19,46 +21,49 @@ -- namespaces (including inlined into full names) will be ignored -- during names resolution. extractDerivables :: Schema -> [Schema]-extractDerivables s = flip evalState S.empty . normSchema rawRecs <$> rawRecs+extractDerivables s = flip evalState state . normSchema . snd <$> rawRecs where rawRecs = getTypes s- getTypes rec = case rec of- r@(Record _ _ _ _ _ fs) -> r : (fs >>= (getTypes . fldType))- Array t -> getTypes t- Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts- Map t -> getTypes t- e@Enum{} -> [e]- f@Fixed{} -> [f]- _ -> []+ state = M.fromList rawRecs --- TODO: Currently ensures normalisation: only in one way--- that is needed for "extractRecord".--- it ensures that an "extracted" record is self-contained and+getTypes :: Type -> [(TypeName, Type)]+getTypes rec = case rec of+ r@Record{name, fields} -> (name,r) : (fields >>= (getTypes . fldType))+ Array t -> getTypes t+ Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts+ Map t -> getTypes t+ e@Enum{name} -> [(name, e)]+ f@Fixed{name} -> [(name, f)]+ _ -> []++-- Ensures normalisation: "extracted" record is self-contained and -- all the named types are resolvable within the scope of the schema.--- The other way around (to each record is inlined only once and is referenced--- as a named type after that) is not implemented.-normSchema :: [Schema] -- ^ List of all possible records- -> Schema -- ^ Schema to normalise- -> State (S.Set TypeName) Schema-normSchema rs r = case r of+-- TODO: Improve story with namespaces+normSchema :: Schema -> State (M.Map TypeName Schema) Schema+normSchema r = case r of t@(NamedType tn) -> do let sn = shortName tn resolved <- get- if S.member sn resolved- then pure t- else do- modify' (S.insert sn)- pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn)- Array s -> Array <$> normSchema rs s- Map s -> Map <$> normSchema rs s- Record{name = tn} -> do+ case M.lookup sn resolved of+ Just rs ->+ -- use the looked up schema (which might be a full record) and replace+ -- it in the state with NamedType for future resolves+ -- because only one full definition per schema is needed+ modify' (M.insert sn t) >> pure rs++ -- NamedType but no corresponding record?! Baaad!+ Nothing ->+ error $ "Unable to resolve schema: " <> show (typeName t)++ Array s -> Array <$> normSchema s+ Map s -> Map <$> normSchema s+ r@Record{name = tn} -> do let sn = shortName tn- modify' (S.insert sn)- flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r)+ modify' (M.insert sn r)+ flds <- mapM (\fld -> setType fld <$> normSchema (fldType fld)) (fields r) pure $ r { fields = flds } s -> pure s where shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn) setType fld t = fld { fldType = t} fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s)- findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs
+ test/Avro/NormSchemaSpec.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+module Avro.NormSchemaSpec+where++import Data.Avro+import Data.Avro.Deriving+import Data.Avro.Schema (Type (..), fields, fldType)+import qualified Data.Set as S++import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++deriveAvro "test/data/reused.avsc"++spec :: Spec+spec = describe "Avro.NormSchemaSpec" $ do+ it "should have one full inner schema for each type" $+ (fldType <$> fields schema'ContainerChild) `shouldBe` [schema'ReusedChild, NamedType "ReusedChild"]