Copyright | (c) 2019-2020 Oleg Grenrus |
---|---|
Safe Haskell | Safe |
Language | Haskell2010 |
Structurally tag data.
See binary-tagged
package taking use of this.
Useful when most Binary
instances are Generic
derived.
Say you have a data type
data Record = Record
{ _recordFields :: HM.HashMap Text (Integer, ByteString)
, _recordEnabled :: Bool
}
deriving (Eq, Show, Generic)
instance Binary Record
instance Structured
Record
then you can serialise and deserialise Record
values with a structure tag by simply
structuredEncode
record :: LBS.ByteStringstructuredDecode
lbs :: Either String Record
If structure of Record
changes in between, deserialisation will fail early.
Technically, Structured
is not related to Binary
, and may
be useful in other ways.
Synopsis
- class Typeable a => Structured a where
- structureHash :: forall a. Structured a => Proxy a -> MD5
- structureBuilder :: Structure -> Builder
- genericStructure :: forall a. (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure
- class GStructured (f :: Type -> Type)
- nominalStructure :: Typeable a => Proxy a -> Structure
- containerStructure :: forall f a. (Typeable f, Structured a) => Proxy (f a) -> Structure
- data Structure
- type TypeName = String
- type ConstructorName = String
- type TypeVersion = Word32
- type SopStructure = [(ConstructorName, [Structure])]
- hashStructure :: Structure -> MD5
- typeVersion :: Functor f => (TypeVersion -> f TypeVersion) -> Structure -> f Structure
- typeName :: Functor f => (TypeName -> f TypeName) -> Structure -> f Structure
- type MD5 = Fingerprint
- showMD5 :: MD5 -> String
- md5 :: ByteString -> MD5
- md5FromInteger :: Integer -> MD5
Structured class
class Typeable a => Structured a where Source #
Class of types with a known Structure
.
For regular data types Structured
can be derived generically.
data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic
) instanceStructured
Record
Since: 3.2.0.0
Nothing
structure :: Proxy a -> Structure Source #
structure :: (Generic a, GStructured (Rep a)) => Proxy a -> Structure Source #
Instances
structureHash :: forall a. Structured a => Proxy a -> MD5 Source #
Semantically
.hashStructure
. structure
structureBuilder :: Structure -> Builder Source #
genericStructure :: forall a. (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure Source #
Derive structure
genrically.
class GStructured (f :: Type -> Type) Source #
Used to implement genericStructure
.
Instances
(i ~ D, Datatype c, GStructuredSum f) => GStructured (M1 i c f) Source # | |
Defined in Data.Structured.Internal gstructured :: TypeRep -> Proxy (M1 i c f) -> TypeVersion -> Structure Source # |
containerStructure :: forall f a. (Typeable f, Structured a) => Proxy (f a) -> Structure Source #
Structure type
Structure of a datatype.
It can be infinite, as far as TypeRep
s involved are finite.
(e.g. polymorphic recursion might cause troubles).
Nominal !TypeRep !TypeVersion TypeName [Structure] | nominal, yet can be parametrised by other structures. |
Newtype !TypeRep !TypeVersion TypeName Structure | a newtype wrapper |
Structure !TypeRep !TypeVersion TypeName SopStructure | sum-of-products structure |
Instances
type ConstructorName = String Source #
type TypeVersion = Word32 Source #
A sematic version of a data type. Usually 0.
type SopStructure = [(ConstructorName, [Structure])] Source #
typeVersion :: Functor f => (TypeVersion -> f TypeVersion) -> Structure -> f Structure Source #
A van-Laarhoven lens into TypeVersion
of Structure
typeVersion
:: Lens'Structure
TypeVersion
MD5
type MD5 = Fingerprint Source #
showMD5 :: MD5 -> String Source #
Show MD5
in human readable form
>>>
showMD5 (Fingerprint 123 456)
"000000000000007b00000000000001c8"
>>>
showMD5 $ md5 $ BS.pack [0..127]
"37eff01866ba3f538421b30b7cbefcac"
@since 3.2.0.0
md5 :: ByteString -> MD5 Source #
@since 3.2.0.0
md5FromInteger :: Integer -> MD5 Source #
>>>
showMD5 $ md5FromInteger 0x37eff01866ba3f538421b30b7cbefcac
"37eff01866ba3f538421b30b7cbefcac"
Note: the input is truncated:
>>>
showMD5 $ md5FromInteger 0x1230000037eff01866ba3f538421b30b7cbefcac
"37eff01866ba3f538421b30b7cbefcac"
Yet, negative numbers are not a problem...
>>>
showMD5 $ md5FromInteger (-1)
"ffffffffffffffffffffffffffffffff"
Since: 3.4.0.0