mu-schema 0.3.0.0 → 0.3.1.0
raw patch · 4 files changed
+66/−12 lines, 4 filesdep +uuiddep ~aesondep ~bytestringdep ~containers
Dependencies added: uuid
Dependency ranges changed: aeson, bytestring, containers, sop-core, template-haskell, text, th-abstraction, unordered-containers, vector
Files
- mu-schema.cabal +12/−11
- src/Mu/Schema.hs +1/−0
- src/Mu/Schema/Class.hs +52/−0
- src/Mu/Schema/Interpretation/Schemaless.hs +1/−1
mu-schema.cabal view
@@ -1,5 +1,5 @@ name: mu-schema-version: 0.3.0.0+version: 0.3.1.0 synopsis: Format-independent schemas for serialization description: With @mu-schema@ you can describe schemas using type-level constructs, and derive serializers from those. See @mu-avro@, @mu-protobuf@ for the actual adapters.@@ -38,16 +38,17 @@ -- other-modules: -- other-extensions: build-depends:- aeson- , base >=4.12 && <5- , bytestring- , containers- , sop-core- , template-haskell >=2.12- , text- , th-abstraction- , unordered-containers- , vector+ aeson >=1.4 && <2+ , base >=4.12 && <5+ , bytestring >=0.10 && <0.11+ , containers >=0.6 && <0.7+ , sop-core >=0.5 && <0.6+ , template-haskell >=2.14 && <2.16+ , text >=1.2 && <2+ , th-abstraction >=0.3.2 && <0.4+ , unordered-containers >=0.2 && <0.3+ , uuid >=1.3 && <2+ , vector >=0.12 && <0.13 hs-source-dirs: src default-language: Haskell2010
src/Mu/Schema.hs view
@@ -29,6 +29,7 @@ , FromSchema(..), fromSchema' , ToSchema(..), toSchema' , CustomFieldMapping(..)+, Underlying(..), UnderlyingConversion(..) -- ** Mappings between fields , Mapping(..), Mappings, MappingRight, MappingLeft -- ** Field annotations
src/Mu/Schema/Class.hs view
@@ -37,13 +37,19 @@ , ToSchema(..), toSchema' , CustomFieldMapping(..) , Mapping(..), Mappings, MappingRight, MappingLeft+, Underlying(..), UnderlyingConversion(..) -- * Internal use only , GToSchemaRecord(..) ) where +import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL import Data.Kind import Data.Map as M+import Data.Maybe (fromJust) import Data.SOP+import qualified Data.Text as T+import qualified Data.UUID as U import GHC.Generics import GHC.TypeLits @@ -140,6 +146,33 @@ => FromSchema sch sty (CustomFieldMapping sty fmap t) where fromSchema x = CustomFieldMapping $ to (fromSchemaTypeDef (Proxy @fmap) x) +-- | This 'newtype' is used to wrap types for which+-- we want a "logical" representation as a Haskell+-- type, but the underlying representation is+-- lower level, like 'UUID's as 'ByteString's.+newtype Underlying basic logical+ = Underlying { unUnderlying :: logical }+ deriving (Show, Eq)++-- | This class defines the actual conversion between+-- a "logical" type and its low-level representation.+class UnderlyingConversion basic logical where+ toUnderlying :: logical -> basic+ fromUnderlying :: basic -> logical++instance UnderlyingConversion String U.UUID where+ toUnderlying = U.toString+ fromUnderlying = fromJust . U.fromString+instance UnderlyingConversion T.Text U.UUID where+ toUnderlying = U.toText+ fromUnderlying = fromJust . U.fromText+instance UnderlyingConversion BL.ByteString U.UUID where+ toUnderlying = U.toByteString+ fromUnderlying = fromJust . U.fromByteString+instance UnderlyingConversion BS.ByteString U.UUID where+ toUnderlying = BL.toStrict . U.toByteString+ fromUnderlying = fromJust . U.fromByteString . BL.fromStrict+ -- ====================== -- CRAZY GENERICS SECTION -- ======================@@ -245,6 +278,12 @@ toSchemaFieldType _ = FNull instance GFromSchemaFieldType sch 'TNull () where fromSchemaFieldType _ = ()+instance (UnderlyingConversion t l)+ => GToSchemaFieldType sch ('TPrimitive t) (Underlying t l) where+ toSchemaFieldType = FPrimitive . toUnderlying . unUnderlying+instance (UnderlyingConversion t l)+ => GFromSchemaFieldType sch ('TPrimitive t) (Underlying t l) where+ fromSchemaFieldType (FPrimitive x) = Underlying (fromUnderlying x) instance GToSchemaFieldType sch ('TPrimitive t) t where toSchemaFieldType = FPrimitive instance GFromSchemaFieldType sch ('TPrimitive t) t where@@ -311,6 +350,10 @@ toSchemaFieldTypeUnion U1 = error "this should never happen" instance {-# OVERLAPS #-} GFromSchemaFieldTypeUnion sch '[] U1 where fromSchemaFieldTypeUnion _ = U1+instance {-# OVERLAPS #-} GToSchemaFieldTypeUnion sch '[] (M1 i t U1) where+ toSchemaFieldTypeUnion (M1 U1) = error "this should never happen"+instance {-# OVERLAPS #-} GFromSchemaFieldTypeUnion sch '[] (M1 i t U1) where+ fromSchemaFieldTypeUnion _ = M1 U1 instance {-# OVERLAPPABLE #-} TypeError ('Text "the type does not match the union") => GToSchemaFieldTypeUnion sch '[] f where@@ -327,6 +370,15 @@ => GFromSchemaFieldTypeUnion sch '[t] v where fromSchemaFieldTypeUnion (Z x) = fromSchemaFieldTypeW x fromSchemaFieldTypeUnion (S _) = error "this should never happen"++-- remove M1 from thing with more than one element+instance {-# OVERLAPS #-} (GToSchemaFieldTypeUnion sch (a ': b ': rest) v)+ => GToSchemaFieldTypeUnion sch (a ': b ': rest) (M1 i t v) where+ toSchemaFieldTypeUnion (M1 x) = toSchemaFieldTypeUnion x+instance {-# OVERLAPS #-} (GFromSchemaFieldTypeUnion sch (a ': b ': rest) v)+ => GFromSchemaFieldTypeUnion sch (a ': b ': rest) (M1 i t v) where+ fromSchemaFieldTypeUnion x = M1 (fromSchemaFieldTypeUnion x)+ instance (GToSchemaFieldTypeWrap sch t v, GToSchemaFieldTypeUnion sch ts vs) => GToSchemaFieldTypeUnion sch (t ': ts) (v :+: vs) where toSchemaFieldTypeUnion (L1 x) = Z (toSchemaFieldTypeW x)
src/Mu/Schema/Interpretation/Schemaless.hs view
@@ -81,7 +81,7 @@ -- Use this function to check a schemaless terms -- at the "borders" of your application. checkSchema- :: forall (s :: Schema tn fn) (t :: tn).+ :: forall tn fn (s :: Schema tn fn) (t :: tn). (CheckSchema s (s :/: t)) => Proxy t -> Term -> Maybe (S.Term s (s :/: t)) checkSchema _ = checkSchema'